diff options
| author | Tobias Burnus <burnus@net-b.de> | 2008-08-23 20:12:30 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2008-08-23 20:12:30 +0200 |
| commit | 12ba225d76f5e210fe59c3d5f8fd6615fef2d118 (patch) | |
| tree | 273b66f99e74c0b500509ce36f63ef0c4928f48d /gcc | |
| parent | 8b7b9d66fe761fb42a55d016c90a4790f301f6c0 (diff) | |
| download | gcc-12ba225d76f5e210fe59c3d5f8fd6615fef2d118.zip gcc-12ba225d76f5e210fe59c3d5f8fd6615fef2d118.tar.gz gcc-12ba225d76f5e210fe59c3d5f8fd6615fef2d118.tar.bz2 | |
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
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/target-memory.c | 25 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/widechar_8.f90 | 28 |
4 files changed, 61 insertions, 3 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 67c1fac..30ec837 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 40e595b..b1029df 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 38b9dab..a87e47d 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 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 |