Dear Fortranners,
when digging into the issue pointed out in the PR by Gerhard it turned
out that there were several issues with the TRANSFER intrinsics in the
case MOLD was CHARACTER(kind=4). Default CHARACTER was fine, though.
- the size of the result was wrongly calculated
- the string length used in temporaries was wrong
- the result characteristics was wrong
Fortunately, the few fixes were very local and needed only fix-ups of
the respective computations.
Since the details of which issue would show up seemed to depend on the
properties of a the arguments to TRANSFER, I wrote an extended testcase
which is a "hull" of what I used in debugging.
(The testcase was and can be cross-checked with the NAG compiler.)
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From cb14e9a1975bc9d9d2f544c314a0820f68b8bdc7 Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Tue, 11 Jan 2022 22:06:10 +0100
Subject: [PATCH] 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.
---
gcc/fortran/target-memory.c | 2 +-
gcc/fortran/trans-intrinsic.c | 17 ++-
.../gfortran.dg/transfer_char_kind4.f90 | 115 ++
3 files changed, 130 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/transfer_char_kind4.f90
diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index af1c21047f6..9b5af8d1482 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 aae34b06948..5821b2264ce 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -8531,7 +8531,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);
@@ -8633,7 +8634,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;
@@ -8687,7 +8694,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
{
diff --git a/gcc/testsuite/gfortran.dg/transfer_char_kind4.f90 b/gcc/testsuite/gfortran.dg/transfer_char_kind4.f90
new file mode 100644
index 000..5f1fe691318
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_char_kind4.f90
@@ -0,0 +1,115 @@
+! { dg-do run }
+! PR fortran/83079 - ICE and wrong code with TRANSFER and character(kind=4)
+! Exercise TRANSFER intrinsic to check character result length and shape
+
+program p
+ implicit none
+ character(len=*,kind=4), parameter :: a = 4_'ABCDEF'
+ character(len=6,kind=4):: b = 4_'abcdef'
+ character(len=*,kind=4), parameter :: c = 4_'XY'
+ character(len=2,kind=4):: d = 4_'xy'
+ integer :: k, l
+ k = len (a)
+ l = len (c)
+
+! print *, transfer(4_'xy', [4_'a'])
+
+ ! TRANSFER with rank-0 result
+ call chk0 (transfer (4_'ABCD', 4_'XY'), 2, 1)
+ call chk0 (transfer (4_'ABCD', c ), l, 2)
+ call chk0 (transfer (4_'ABCD', d ), l, 3)
+ call chk0 (transfer (a , 4_'XY'), 2, 4)
+ call chk0 (transfer (a , c ), l, 5)
+ call chk0 (transfer (a , d ), l, 6)
+ call chk0 (transfer (b , 4_'XY'), 2, 7)
+ call chk0 (transfer (b , c
