re PR fortran/37025 (ICE with TRANSFER to non-default-kind character: transfer(int...

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 67c1facb17af92b0c38c14d36e1bee32def82472..30ec837bea7b742b335e7f3029b7ff3399decfd7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index 40e595ba4043973143cd9e5ad6f2c443be443d29..b1029dfa5dc6d77159d376e187eba91934865d3a 100644 (file)
--- a/gcc/fortran/target-memory.c
+++ b/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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 38b9dab478992e8169dd7b74f6cf8e2b8ed81d6f..a87e47d2a217d7db539d4a252f09185828ff3a48 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/widechar_8.f90 b/gcc/testsuite/gfortran.dg/widechar_8.f90
new file mode 100644 (file)
index 0000000..e611294
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_8.f90
@@ -0,0 +1,28 @@
+! { 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