Dear Fortranners,
conversions between different character kinds using TRANSFER exhibit
inconsistencies that can occur between expr->representation.string
(which is char*) on the one hand, and expr->->value.character.string.
One issue (in target-memory.cc) is easily fixed by simply passing
a conversion flag that was likely forgotten in the past.
The other issue happens in gfc_copy_expr. Before we unconditionally
converted an existing representation.string to wide char, which is
definitely wrong. Restricting that code path to default character
kind fixed the problems I could find and produces dumps that looked
fine to me. Maybe some expert here can find a better fix.
Regtested on x86_64-pc-linux-gnu. OK for mainline? Maybe 11-branch?
Thanks,
Harald
From ddf161bd2b4de1c0a9655cb61634d94c857b458b Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Sun, 23 Jan 2022 21:55:33 +0100
Subject: [PATCH] Fortran: fix issues with internal conversion between default
and wide char
gcc/fortran/ChangeLog:
PR fortran/104128
* expr.cc (gfc_copy_expr): Convert internal representation of
string to wide char in value only for default character kind.
* target-memory.cc (interpret_array): Pass flag for conversion of
wide chars.
(gfc_target_interpret_expr): Likewise.
gcc/testsuite/ChangeLog:
PR fortran/104128
* gfortran.dg/transfer_simplify_14.f90: New test.
---
gcc/fortran/expr.cc | 3 ++-
gcc/fortran/target-memory.cc | 7 ++---
.../gfortran.dg/transfer_simplify_14.f90 | 27 +++
3 files changed, 33 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/transfer_simplify_14.f90
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 279d9b30991..ed82a94022f 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -312,7 +312,8 @@ gfc_copy_expr (gfc_expr *p)
break;
case BT_CHARACTER:
- if (p->representation.string)
+ if (p->representation.string
+ && p->ts.kind == gfc_default_character_kind)
q->value.character.string
= gfc_char_to_widechar (q->representation.string);
else
diff --git a/gcc/fortran/target-memory.cc b/gcc/fortran/target-memory.cc
index 361907b0e51..7ce7d736629 100644
--- a/gcc/fortran/target-memory.cc
+++ b/gcc/fortran/target-memory.cc
@@ -365,7 +365,8 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
static size_t
-interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
+interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result,
+ bool convert_widechar)
{
gfc_constructor_base base = NULL;
size_t array_size = 1;
@@ -390,7 +391,7 @@ interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
gfc_constructor_append_expr (&base, e, &result->where);
ptr += gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e,
- true);
+ convert_widechar);
}
result->value.constructor = base;
@@ -580,7 +581,7 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
gfc_expr *result, bool convert_widechar)
{
if (result->expr_type == EXPR_ARRAY)
-return interpret_array (buffer, buffer_size, result);
+return interpret_array (buffer, buffer_size, result, convert_widechar);
switch (result->ts.type)
{
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_14.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_14.f90
new file mode 100644
index 000..dfb997d81b2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_14.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+! PR fortran/104128 - ICE in gfc_widechar_to_char
+! Contributed by G.Steinmetz
+
+program p
+ implicit none
+ integer, parameter :: k = 4
+ character(*), parameter :: a = 'abc'
+ character(*,kind=4), parameter :: b = 'abc'
+ character(2,kind=k), parameter :: s = k_"FG"
+ character(*,kind=1), parameter :: x = transfer (s, 'abcdefgh')
+ character(2,kind=k), parameter :: t = transfer (x, s)
+ character(2,kind=k):: u = transfer (x, s)
+ logical, parameter :: l = (s == t)
+ print *, transfer (a , 4_'xy', size=2)
+ print *, transfer ('xyz', [b], size=2)
+ print *, s
+ print *, t
+ print *, u
+ if (.not. l) stop 1
+ if (t /= s) stop 2
+ if (u /= s) stop 3 ! not optimized away
+end
+
+! { dg-final { scan-tree-dump-times "_gfortran_stop_numeric" 1 "original" } }
+! { dg-final { scan-tree-dump "_gfortran_stop_numeric \\(3, 0\\);" "original" } }
--
2.31.1
