From 701363d827d45d3e3601735fa42f95644fda8b64 Mon Sep 17 00:00:00 2001
From: Paul Thomas <pault@gcc.gnu.org>
Date: Thu, 12 Oct 2023 07:26:59 +0100
Subject: [PATCH] Fortran: Set hidden string length for pointer components
[PR67740].
2023-10-11 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran
PR fortran/67740
* trans-expr.cc (gfc_trans_pointer_assignment): Set the hidden
string length component for pointer assignment to character
pointer components.
gcc/testsuite/
PR fortran/67740
* gfortran.dg/pr67740.f90: New test
---
gcc/fortran/trans-expr.cc | 33 +++++++++++++++++++++++----
gcc/testsuite/gfortran.dg/pr67740.f90 | 32 ++++++++++++++++++++++++++
2 files changed, 61 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr67740.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 860b73c49683..7beefa2e69c2 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10403,11 +10403,36 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
}
if (expr1->ts.type == BT_CHARACTER
- && expr1->symtree->n.sym->ts.deferred
- && expr1->symtree->n.sym->ts.u.cl->backend_decl
- && VAR_P (expr1->symtree->n.sym->ts.u.cl->backend_decl))
+ && expr1->ts.deferred)
{
- tmp = expr1->symtree->n.sym->ts.u.cl->backend_decl;
+ gfc_symbol *psym = expr1->symtree->n.sym;
+ tmp = NULL_TREE;
+ if (psym->ts.type == BT_CHARACTER)
+ {
+ gcc_assert (psym->ts.u.cl->backend_decl
+ && VAR_P (psym->ts.u.cl->backend_decl));
+ tmp = psym->ts.u.cl->backend_decl;
+ }
+ else if (expr1->ts.u.cl->backend_decl
+ && VAR_P (expr1->ts.u.cl->backend_decl))
+ tmp = expr1->ts.u.cl->backend_decl;
+ else if (TREE_CODE (lse.expr) == COMPONENT_REF)
+ {
+ gfc_ref *ref = expr1->ref;
+ for (;ref; ref = ref->next)
+ {
+ if (ref->type == REF_COMPONENT
+ && ref->u.c.component->ts.type == BT_CHARACTER
+ && gfc_deferred_strlen (ref->u.c.component, &tmp))
+ tmp = fold_build3_loc (input_location, COMPONENT_REF,
+ TREE_TYPE (tmp),
+ TREE_OPERAND (lse.expr, 0),
+ tmp, NULL_TREE);
+ }
+ }
+
+ gcc_assert (tmp);
+
if (expr2->expr_type != EXPR_NULL)
gfc_add_modify (&block, tmp,
fold_convert (TREE_TYPE (tmp), strlen_rhs));
diff --git a/gcc/testsuite/gfortran.dg/pr67740.f90 b/gcc/testsuite/gfortran.dg/pr67740.f90
new file mode 100644
index 000000000000..bf70ff223632
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr67740.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Check the fix for the testcase in comment 4, where the hidden string length
+! component of the array pointer component was not set.
+!
+! Contributed by Sebastien Bardeau <bardeau@iram.fr>
+!
+program test2
+ implicit none
+ character(len=10), allocatable, target :: s(:)
+ character(len=:), pointer :: sptr(:)
+ type :: pointer_typec0_t
+ character(len=:), pointer :: data0
+ character(len=:), pointer :: data1(:)
+ end type pointer_typec0_t
+ type(pointer_typec0_t) :: co
+ !
+ allocate(s(3))
+ s(1) = '1234567890'
+ s(2) = 'qwertyuio '
+ s(3) = 'asdfghjk '
+ !
+ sptr => s
+ co%data0 => s(1)
+ co%data1 => s
+ !
+ if (any (sptr .ne. s)) stop 1
+ if (co%data0 .ne. s(1)) stop 2
+ if (any (co%data1 .ne. s)) stop 3 ! Hidden string length was not set
+end program test2
+! { dg-final { scan-tree-dump-times "co._data1_length = 10;" 1 "original" } }
\ No newline at end of file
--
GitLab