https://gcc.gnu.org/g:35f1e51768d11cc0b5c29d86a3802f2fc06753a9
commit 35f1e51768d11cc0b5c29d86a3802f2fc06753a9 Author: Mikael Morin <[email protected]> Date: Fri Sep 25 15:16:18 2026 +0200 fortran: Fix simply contiguous for polymorphic arrays [PR127613] In the implementation of the simply contiguous predicate, take into account class containers when identifying non-contiguous pointers or assumed-rank or assumed-shape dummies. The implementation was picking the last component reference in the chain to return false if it had the pointer but not the contiguous attribute. This was causing the predicate to return false for a polymorphic contiguous array, because the last component is the _data component of the class container. It has the pointer attribute for a non-allocatable dummy or a pointer, and it hasn't the contiguous attribute which is stored in the parent entity, having class container type. Fixing this requires to keep at the same time access to the contiguous attribute, the pointer attribute and the array type. So this changes omits picking the component reference during the walk, if it is the _data component of a class container. Then the rest needs to discriminate between polymorphic and non-polymorphic references; for pointers we can just use the IS_POINTER macro. PR fortran/127613 gcc/fortran/ChangeLog: * expr.cc (gfc_is_simply_contiguous): Track the current type during the data reference walk and only keep component references that are not the _data component of a class container. Query the array type on the class container for polymorphic variables. * resolve.cc (resolve_assoc_var): Also propagate the contiguous attribute for non-pointers. gcc/testsuite/ChangeLog: * gfortran.dg/contiguous_19.f90: New test. Diff: --- gcc/fortran/expr.cc | 28 +++++++++++++++++++----- gcc/fortran/resolve.cc | 5 +++-- gcc/testsuite/gfortran.dg/contiguous_19.f90 | 34 +++++++++++++++++++++++++++++ 3 files changed, 59 insertions(+), 8 deletions(-) diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index 68663fe35d19..32a79d032569 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -6461,13 +6461,25 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element) if (!permit_element && expr->rank == 0) return false; + sym = expr->symtree->n.sym; + const gfc_typespec *prev_ts = &sym->ts; for (ref = expr->ref; ref; ref = ref->next) { if (ar) return false; /* Array shall be last part-ref. */ if (ref->type == REF_COMPONENT) - part_ref = ref; + { + /* If the reference is to a class container's _data component, keep + part_ref pointing to the class container, so that the attributes of + both the class container and its _data component can be queried + from part_ref. */ + if (!(prev_ts->type == BT_CLASS + && prev_ts->u.derived->attr.is_class + && strcmp (ref->u.c.component->name, "_data") == 0)) + part_ref = ref; + prev_ts = &ref->u.c.component->ts; + } else if (ref->type == REF_SUBSTRING) return false; else if (ref->type == REF_INQUIRY) @@ -6476,17 +6488,21 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element) ar = &ref->u.ar; } - sym = expr->symtree->n.sym; if ((part_ref && part_ref->u.c.component && !part_ref->u.c.component->attr.contiguous && IS_POINTER (part_ref->u.c.component)) || (!part_ref - && expr->ts.type != BT_CLASS && !sym->attr.contiguous - && (sym->attr.pointer - || (sym->as && sym->as->type == AS_ASSUMED_RANK) - || (sym->as && sym->as->type == AS_ASSUMED_SHAPE)))) + && (IS_POINTER (sym) + || (sym->ts.type == BT_CLASS + && sym->ts.u.derived->attr.is_class + && CLASS_DATA (sym)->as + && (CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK + || CLASS_DATA (sym)->as->type == AS_ASSUMED_SHAPE)) + || (sym->as + && (sym->as->type == AS_ASSUMED_RANK + || sym->as->type == AS_ASSUMED_SHAPE))))) return false; /* An associate variable may point to a non-contiguous target. */ diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 67eaea64c9bc..c19bc14cf1fc 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -11091,8 +11091,9 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) if (sym->ts.type == BT_CLASS && gfc_expr_attr (target).class_ok) sym->attr.class_ok = 1; - /* If the target is a contiguous pointer, so is the associate variable. */ - if (gfc_expr_attr (target).pointer && gfc_expr_attr (target).contiguous) + /* If the target has the contiguous attribute, so has the associate + variable. */ + if (gfc_expr_attr (target).contiguous) sym->attr.contiguous = 1; } diff --git a/gcc/testsuite/gfortran.dg/contiguous_19.f90 b/gcc/testsuite/gfortran.dg/contiguous_19.f90 new file mode 100644 index 000000000000..b2d540fab918 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/contiguous_19.f90 @@ -0,0 +1,34 @@ +! { dg-do compile } +! +! PR fortran/127613 +! Check that simply contiguous polymorphic arrays are correctly recognized as +! such, and that the information correctly propagates to associate names. +! The associate names used as pointer association target below used to not be +! recognized as simply contiguous. + +program prog + implicit none + integer, parameter :: n = 3 + type :: t + integer :: c + end type + type(t), allocatable, target :: x(:,:) + integer :: i + x = reshape([ (t(i*i), i=1,n*n) ], [n,n]) + call sub(x) +contains + subroutine sub(y) + class(t), contiguous, target :: y(:,:) + class(t), contiguous, pointer :: p(:,:) + class(t), pointer :: q(:) + q(1:n*n) => y + associate (a => y) + q(1:n*n) => a + end associate + p => y + q(1:n*n) => p + associate (b => p) + q(1:n*n) => b + end associate + end subroutine +end program
