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 --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 279d9b3..ed82a94 100644 (file)
--- 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 361907b..7ce7d73 100644 (file)
--- 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 (file)
index 0000000..dfb997d
--- /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" } }