From 12ba225d76f5e210fe59c3d5f8fd6615fef2d118 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sat, 23 Aug 2008 20:12:30 +0200 Subject: [PATCH] re PR fortran/37025 (ICE with TRANSFER to non-default-kind character: transfer(int(z'bde4'),4_'a')) 2008-08-23 Tobias Burnus PR fortran/37025 * target-memory.c (gfc_interpret_character): Support kind=4 characters. 2008-08-23 Tobias Burnus PR fortran/37025 * gfortran.dg/widechar_8.f90: New. From-SVN: r139520 --- gcc/fortran/ChangeLog | 6 +++++ gcc/fortran/target-memory.c | 25 ++++++++++++++++++--- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/widechar_8.f90 | 28 ++++++++++++++++++++++++ 4 files changed, 61 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/widechar_8.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 67c1facb17a..30ec837bea7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2008-08-23 Tobias Burnus + + PR fortran/37025 + * target-memory.c (gfc_interpret_character): Support + kind=4 characters. + 2008-08-22 Daniel Kraft PR fortran/30239 diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index 40e595ba404..b1029dfa5dc 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 38b9dab4789..a87e47d2a21 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-08-23 Tobias Burnus + + PR fortran/37025 + * gfortran.dg/widechar_8.f90: New. + 2008-08-23 Ira Rosen 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 00000000000..e61129416cf --- /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 -- 2.30.2