[gcc r12-6902] Fortran: fix issues with internal conversion between default and wide char

[gcc r12-6902] Fortran: fix issues with internal conversion between default and wide char

[Harald Anlauf]

https://gcc.gnu.org/g:b51fb28ed294cdf19087ca9d9ad107c9c52bec42

commit r12-6902-gb51fb28ed294cdf19087ca9d9ad107c9c52bec42
Author: Harald Anlauf <anlauf@gmx.de>
Date:   Sun Jan 23 21:55:33 2022 +0100

    Fortran: fix issues with internal conversion between default and wide char
    
    gcc/fortran/ChangeLog:
    
            PR fortran/104128
            * expr.cc (gfc_copy_expr): Convert internal representation of
            string to wide char in value only for default character kind.
            * target-memory.cc (interpret_array): Pass flag for conversion of
            wide chars.
            (gfc_target_interpret_expr): Likewise.
    
    gcc/testsuite/ChangeLog:
    
            PR fortran/104128
            * gfortran.dg/transfer_simplify_14.f90: New test.

Diff:
---
 gcc/fortran/expr.cc                                |  3 ++-
 gcc/fortran/target-memory.cc                       |  7 +++---
 gcc/testsuite/gfortran.dg/transfer_simplify_14.f90 | 27 ++++++++++++++++++++++
 3 files changed, 33 insertions(+), 4 deletions(-)

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 279d9b30991..ed82a94022f 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -312,7 +312,8 @@ gfc_copy_expr (gfc_expr *p)
 	  break;
 
 	case BT_CHARACTER:
-	  if (p->representation.string)
+	  if (p->representation.string
+	      && p->ts.kind == gfc_default_character_kind)
 	    q->value.character.string
 	      = gfc_char_to_widechar (q->representation.string);
 	  else
diff --git a/gcc/fortran/target-memory.cc b/gcc/fortran/target-memory.cc
index 361907b0e51..7ce7d736629 100644
--- a/gcc/fortran/target-memory.cc
+++ b/gcc/fortran/target-memory.cc
@@ -365,7 +365,8 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
 
 
 static size_t
-interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
+interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result,
+		 bool convert_widechar)
 {
   gfc_constructor_base base = NULL;
   size_t array_size = 1;
@@ -390,7 +391,7 @@ interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
       gfc_constructor_append_expr (&base, e, &result->where);
 
       ptr += gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e,
-					true);
+					convert_widechar);
     }
 
   result->value.constructor = base;
@@ -580,7 +581,7 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
 			   gfc_expr *result, bool convert_widechar)
 {
   if (result->expr_type == EXPR_ARRAY)
-    return interpret_array (buffer, buffer_size, result);
+    return interpret_array (buffer, buffer_size, result, convert_widechar);
 
   switch (result->ts.type)
     {
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_14.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_14.f90
new file mode 100644
index 00000000000..dfb997d81b2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_14.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+! PR fortran/104128 - ICE in gfc_widechar_to_char
+! Contributed by G.Steinmetz
+
+program p
+  implicit none
+  integer,      parameter :: k = 4
+  character(*), parameter :: a = 'abc'
+  character(*,kind=4), parameter :: b = 'abc'
+  character(2,kind=k), parameter :: s = k_"FG"
+  character(*,kind=1), parameter :: x = transfer (s, 'abcdefgh')
+  character(2,kind=k), parameter :: t = transfer (x, s)
+  character(2,kind=k)            :: u = transfer (x, s)
+  logical,             parameter :: l = (s == t)
+  print *, transfer (a , 4_'xy', size=2)
+  print *, transfer ('xyz', [b], size=2)
+  print *, s
+  print *, t
+  print *, u
+  if (.not. l) stop 1
+  if (t /= s)  stop 2
+  if (u /= s)  stop 3  ! not optimized away
+end
+
+! { dg-final { scan-tree-dump-times "_gfortran_stop_numeric" 1 "original" } }
+! { dg-final { scan-tree-dump "_gfortran_stop_numeric \\(3, 0\\);" "original" } }