From ddf161bd2b4de1c0a9655cb61634d94c857b458b Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sun, 23 Jan 2022 21:55:33 +0100
Subject: [PATCH] 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.
---
 gcc/fortran/expr.cc                           |  3 ++-
 gcc/fortran/target-memory.cc                  |  7 ++---
 .../gfortran.dg/transfer_simplify_14.f90      | 27 +++++++++++++++++++
 3 files changed, 33 insertions(+), 4 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/transfer_simplify_14.f90

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" } }
--
2.31.1