From: Tobias Burnus <burnus@net-b.de>
Date: Sat, 23 Aug 2008 18:12:30 +0000 (+0200)
Subject: re PR fortran/37025 (ICE with TRANSFER to non-default-kind character: transfer(int... 
X-Git-Tag: releases/gcc-4.4.0~2908
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=12ba225d76f5e210fe59c3d5f8fd6615fef2d118;p=thirdparty%2Fgcc.git

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
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 67c1facb17af..30ec837bea7b 100644
--- 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 40e595ba4043..b1029dfa5dc6 100644
--- 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 38b9dab47899..a87e47d2a217 100644
--- 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
index 000000000000..e61129416cfa
--- /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