diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2022-01-11 22:06:10 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2022-01-15 22:33:00 +0100 |
| commit | 29401b7b4581e9131e7057e263dcea8b40a6b5ab (patch) | |
| tree | 917d638c4ccbbc5954b59edb18a6967f74d49ba2 /gcc/fortran | |
| parent | 52d28210389ff3d4af8f20db4db1f0d58b0f8eff (diff) | |
| download | gcc-29401b7b4581e9131e7057e263dcea8b40a6b5ab.zip gcc-29401b7b4581e9131e7057e263dcea8b40a6b5ab.tar.gz gcc-29401b7b4581e9131e7057e263dcea8b40a6b5ab.tar.bz2 | |
Fortran: fix ICE and wrong code with TRANSFER and CHARACTER(kind=4)
gcc/fortran/ChangeLog:
PR fortran/83079
* target-memory.c (gfc_interpret_character): Result length is
in bytes and thus depends on the character kind.
* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Compute correct
string length for the result of the TRANSFER intrinsic and for
temporaries for the different character kinds.
gcc/testsuite/ChangeLog:
PR fortran/83079
* gfortran.dg/transfer_char_kind4.f90: New test.
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/target-memory.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 17 |
2 files changed, 15 insertions, 4 deletions
diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index af1c210..9b5af8d 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -485,7 +485,7 @@ gfc_interpret_character (unsigned char *buffer, size_t buffer_size, result->value.character.string[result->value.character.length] = '\0'; - return result->value.character.length; + return size_character (result->value.character.length, result->ts.kind); } diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index dc72d99..a7cbbeb 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -8533,7 +8533,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) { case BT_CHARACTER: tmp = size_of_string_in_bytes (arg->expr->ts.kind, argse.string_length); - mold_type = gfc_get_character_type_len (arg->expr->ts.kind, tmp); + mold_type = gfc_get_character_type_len (arg->expr->ts.kind, + argse.string_length); break; case BT_CLASS: tmp = gfc_class_vtab_size_get (argse.expr); @@ -8635,7 +8636,13 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) se->expr = info->descriptor; if (expr->ts.type == BT_CHARACTER) - se->string_length = fold_convert (gfc_charlen_type_node, dest_word_len); + { + tmp = fold_convert (gfc_charlen_type_node, + TYPE_SIZE_UNIT (gfc_get_char_type (expr->ts.kind))); + se->string_length = fold_build2_loc (input_location, TRUNC_DIV_EXPR, + gfc_charlen_type_node, + dest_word_len, tmp); + } return; @@ -8689,7 +8696,11 @@ scalar_transfer: gfc_add_expr_to_block (&se->post, tmp); se->expr = tmpdecl; - se->string_length = fold_convert (gfc_charlen_type_node, dest_word_len); + tmp = fold_convert (gfc_charlen_type_node, + TYPE_SIZE_UNIT (gfc_get_char_type (expr->ts.kind))); + se->string_length = fold_build2_loc (input_location, TRUNC_DIV_EXPR, + gfc_charlen_type_node, + dest_word_len, tmp); } else { |