Hello Mikael, This looks good to me and does what it says on the wrapper. Note the wrong PR number in the title line :-)
OK for mainline. Thanks for the patch. Paul On Mon, 26 Oct 2026 at 10:43, Mikael Morin <[email protected]> wrote: > > From: Mikael Morin <[email protected]> > > This requires the PR128033 patch [1] to prevent a regression with > class_array_20.f03. > Fortran-tested on aarch64-unknown-linux-gnu. > OK for mainline? > > [1] > https://inbox.sourceware.org/fortran/[email protected]/ > > -- >8 -- > > Index polymorphic dummy arrays having the TARGET attribute using the span > from the array descriptor instead of the size from the class container. > > A previous change by Jerry (r17-3342) introduced the infrastructure to > suport span indexing for non-polymorphic target dummy arguments. The > testcase provided in the PR and added here shows that it has to be extended > to support the polymorphic case, as done by this change. > > The main change amends the existing function gfc_dummy_requires_direct_arg > to allow polymorphic entities. It is more complex that just removing the > condition excluding BT_CLASS type, because the DIMENSION, ALLOCATABLE and > POINTER attributes are stored differently on polymorphic entities than on > non-polymorphic ones, and the same goes for the array spec. So a mostly > rewritten copy of the existing conditions is added for the CLASS case. > > Allowing polymorphic entities in gfc_dummy_requires_direct_arg enables the > creation of a span variable by gfc_build_dummy_array_decl, stored in the > GFC_DECL_SPAN of the local array decl, and whose presence is sufficient to > enable span indexing in the non-polymorphic case. But it is not sufficient > for polymorphic entities, because the function gfc_maybe_dereference_var > generates a dereference for them around the local array decl reference, and > GFC_DECL_GET_SPAN of a dereference returns NULL_TREE. So a preliminary step > is added in gfc_get_array_span to unwrap the pointer dereference, making the > value present in GFC_DECL_SPAN visible, which activates span indexing. > > PR fortran/127827 > > gcc/fortran/ChangeLog: > > * symbol.cc (gfc_dummy_requires_direct_arg): Allow CLASS type. > * trans-array.cc (get_main_decl): New function. > (gfc_get_array_span): If the array decl is not passed as input > directly, get it first before querying the span on it. > > gcc/testsuite/ChangeLog: > > * gfortran.dg/target_dummy_span_4.f90: New test. > --- > gcc/fortran/symbol.cc | 22 +++++--- > gcc/fortran/trans-array.cc | 27 +++++++++- > .../gfortran.dg/target_dummy_span_4.f90 | 50 +++++++++++++++++++ > 3 files changed, 91 insertions(+), 8 deletions(-) > create mode 100644 gcc/testsuite/gfortran.dg/target_dummy_span_4.f90 > > diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc > index 73f0280645d..653ad06f28b 100644 > --- a/gcc/fortran/symbol.cc > +++ b/gcc/fortran/symbol.cc > @@ -5715,16 +5715,24 @@ gfc_dummy_requires_direct_arg (gfc_symbol *sym) > { > return sym->attr.dummy > && sym->attr.target > - && sym->attr.dimension > && !sym->attr.value > && !sym->attr.contiguous > - && !sym->attr.pointer > - && !sym->attr.allocatable > - && sym->ts.type != BT_CLASS > + && !IS_POINTER (sym) > && sym->ts.type != BT_ASSUMED > - && sym->as > - && (sym->as->type == AS_ASSUMED_SHAPE > - || sym->as->type == AS_ASSUMED_RANK); > + && ((sym->ts.type == BT_CLASS > + && sym->ts.u.derived->attr.is_class > + && CLASS_DATA (sym)->attr.dimension > + && !CLASS_DATA (sym)->attr.allocatable > + && CLASS_DATA (sym)->as > + && (CLASS_DATA (sym)->as->type == AS_ASSUMED_SHAPE > + || CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)) > + || (!(sym->ts.type == BT_CLASS > + && sym->ts.u.derived->attr.is_class) > + && sym->attr.dimension > + && !sym->attr.allocatable > + && sym->as > + && (sym->as->type == AS_ASSUMED_SHAPE > + || sym->as->type == AS_ASSUMED_RANK))); > } > > > diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc > index 97d68caa190..d1045ccfb19 100644 > --- a/gcc/fortran/trans-array.cc > +++ b/gcc/fortran/trans-array.cc > @@ -668,6 +668,29 @@ class_array_element_size (tree decl, bool unlimited) > } > > > +/* Given a data reference EXPR, return the main underlying declaration > + (variable, parameter, etc) if there is one, otherwise return NULL_TREE. > + Having the declaration gives access to the additional metadata stored in > + its lang-specific node. */ > + > +static tree > +get_main_decl (tree expr) > +{ > + tree decl = expr; > + while (decl && !DECL_P (decl)) > + { > + if (TREE_CODE (decl) == ADDR_EXPR > + || INDIRECT_REF_P (decl) > + || CONVERT_EXPR_P (decl)) > + decl = TREE_OPERAND (decl, 0); > + else > + decl = NULL_TREE; > + } > + > + return decl; > +} > + > + > /* Return the span of an array. */ > > tree > @@ -677,7 +700,9 @@ gfc_get_array_span (tree desc, gfc_expr *expr) > gfc_symbol *sym = (expr && expr->expr_type == EXPR_VARIABLE) ? > expr->symtree->n.sym : NULL; > > - if (tree span = GFC_DECL_GET_SPAN (desc)) > + tree decl = get_main_decl (desc); > + > + if (tree span = GFC_DECL_GET_SPAN (decl ? decl : desc)) > /* A span addressed dummy loaded its span on entry. */ > tmp = span; > else if (is_span_addressed_array (desc) > diff --git a/gcc/testsuite/gfortran.dg/target_dummy_span_4.f90 > b/gcc/testsuite/gfortran.dg/target_dummy_span_4.f90 > new file mode 100644 > index 00000000000..8537ca4c084 > --- /dev/null > +++ b/gcc/testsuite/gfortran.dg/target_dummy_span_4.f90 > @@ -0,0 +1,50 @@ > +! { dg-do run } > +! > +! PR fortran/127827 > +! Check that array access correctly uses the span from the descriptor, > +! including for polymorphic dummy arguments. > + > +program prog > + implicit none > + integer, parameter :: n = 5 > + type :: t1 > + integer :: c1, c2 > + end type > + type, extends(t1) :: t2 > + integer :: c3 > + end type > + type(t2), target :: a(n) > + integer :: i > + a = [ (t2(3*i*i+2, i*i+1, 5*i+3), i=1,size(a)) ] > + call check_all(a%t1, 1) > + call type_wrapper(a%t1, 2, 3) > + call class_wrapper(a%t1, 4) > +contains > + subroutine type_wrapper(x, e1, e2) > + type(t1), target, intent(in) :: x(:) > + integer, intent(in) :: e1, e2 > + call check_all(x, e1) > + call class_wrapper(x, e2) > + end subroutine > + subroutine class_wrapper(x, e) > + class(t1), target, intent(in) :: x(:) > + integer, intent(in) :: e > + call check_all(x, e) > + end subroutine > + subroutine check_all(x, e) > + type(t1), target, intent(in) :: x(:) > + integer, intent(in) :: e > + call check(x%c1, [ 5, 14, 29, 50, 77 ], e*10+1) > + call check(x%c2, [ 2, 5, 10, 17, 26 ], e*10+2) > + end subroutine > + subroutine check(a, v, e) > + integer, intent(in), dimension(:) :: a, v > + integer, intent(in) :: e > + integer :: i > + if (size(a) /= size(v)) error stop e*10 > + !do i = 1, size(a) > + ! print *, e*10+i, (a(i) == v(i) ? "PASS" : "FAIL"), a(i), v(i) > + !end do > + if (any(a /= v)) error stop e*10+9 > + end subroutine > +end program > > base-commit: cada5a5bcdc4ec5e1d8e56fed922330e8b95887c > prerequisite-patch-id: 2d4e8d778e9fd6eb88a199e4b9f95f687f957a85 > -- > 2.53.0 >
