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

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 860b73c496839b9b50335ce9f12520b1b1d10519..7beefa2e69c2cf014d7e747aa92a171acd278f89 100644 (file)
--- 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 (file)
index 0000000..bf70ff2
--- /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