diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2023-10-12 07:26:59 +0100 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2023-10-12 07:26:59 +0100 |
| commit | 701363d827d45d3e3601735fa42f95644fda8b64 (patch) | |
| tree | f13643a2af2b57f53e1f6786c251bebd72d4ec9e | |
| parent | 530babc2058be5f2b06b1541384e7b730c368b93 (diff) | |
| download | gcc-701363d827d45d3e3601735fa42f95644fda8b64.zip gcc-701363d827d45d3e3601735fa42f95644fda8b64.tar.gz gcc-701363d827d45d3e3601735fa42f95644fda8b64.tar.bz2 | |
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
| -rw-r--r-- | gcc/fortran/trans-expr.cc | 33 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr67740.f90 | 32 |
2 files changed, 61 insertions, 4 deletions
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 860b73c..7beefa2 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 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 |