aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/trans-intrinsic.c
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2022-01-11 22:06:10 +0100
committerHarald Anlauf <anlauf@gmx.de>2022-01-15 22:33:00 +0100
commit29401b7b4581e9131e7057e263dcea8b40a6b5ab (patch)
tree917d638c4ccbbc5954b59edb18a6967f74d49ba2 /gcc/fortran/trans-intrinsic.c
parent52d28210389ff3d4af8f20db4db1f0d58b0f8eff (diff)
downloadgcc-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/trans-intrinsic.c')
-rw-r--r--gcc/fortran/trans-intrinsic.c17
1 files changed, 14 insertions, 3 deletions
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
{