re PR fortran/37025 (ICE with TRANSFER to non-default-kind character: transfer(int(z'bde4'),4_'a'))

2008-08-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/37025
        * target-memory.c (gfc_interpret_character): Support
        kind=4 characters.

2008-08-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/37025
        * gfortran.dg/widechar_8.f90: New.

From-SVN: r139520

gcc/fortran/ChangeLog

+2008-08-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/37025
+	* target-memory.c (gfc_interpret_character): Support
+	kind=4 characters.
+
 2008-08-22  Daniel Kraft  <d@domob.eu>
 
 	PR fortran/30239

gcc/fortran/target-memory.c

@@ -399,9 +399,28 @@ gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
   result->value.character.string =
     gfc_get_wide_string (result->value.character.length + 1);
 
-  gcc_assert (result->ts.kind == gfc_default_character_kind);
-  for (i = 0; i < result->value.character.length; i++)
-    result->value.character.string[i] = (gfc_char_t) buffer[i];
+  if (result->ts.kind == gfc_default_character_kind)
+    for (i = 0; i < result->value.character.length; i++)
+      result->value.character.string[i] = (gfc_char_t) buffer[i];
+  else
+    {
+      mpz_t integer;
+      unsigned bytes = size_character (1, result->ts.kind);
+      mpz_init (integer);
+      gcc_assert (bytes <= sizeof (unsigned long));
+
+      for (i = 0; i < result->value.character.length; i++)
+	{
+	  gfc_conv_tree_to_mpz (integer,
+	    native_interpret_expr (gfc_get_char_type (result->ts.kind),
+				   &buffer[bytes*i], buffer_size-bytes*i));
+	  result->value.character.string[i]
+	    = (gfc_char_t) mpz_get_ui (integer);
+	}
+
+      mpz_clear (integer);
+    }
+
   result->value.character.string[result->value.character.length] = '\0';
 
   return result->value.character.length;

gcc/testsuite/ChangeLog

+2008-08-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/37025
+	* gfortran.dg/widechar_8.f90: New.
+
 2008-08-23  Ira Rosen  <irar@il.ibm.com>
 
 	PR tree-optimization/37174

gcc/testsuite/gfortran.dg/widechar_8.f90

+! { dg-do run }
+! { dg-options "-fbackslash" }
+!
+! PR fortran/37025
+!
+! Check whether transferring to character(kind=4) and transferring back works
+!
+implicit none
+character(len=4,kind=4) :: str
+integer(4) :: buffer(4) = [int(z'039f'),int(z'03cd'),int(z'03c7'),  &
+                           int(z'30b8') ], &
+              buffer2(4)
+
+open(6,encoding="UTF-8")
+str = transfer(buffer, str)
+!print *, str
+!print *, 4_'\u039f\u03cd\u03c7\u30b8'
+if (str /= 4_'\u039f\u03cd\u03c7\u30b8') call abort()
+str = transfer([int(z'039f'),int(z'03cd'),int(z'03c7'),  &
+                           int(z'30b8') ], str)
+if (str /= 4_'\u039f\u03cd\u03c7\u30b8') call abort()
+
+buffer2 = transfer(4_'\u039f\u03cd\u03c7\u30b8', buffer2, 4)
+!print *, buffer
+!print *, buffer2
+buffer2 = transfer(str, buffer2, 4)
+if (any(buffer2 /= buffer)) call abort()
+end