https://gcc.gnu.org/g:7978efd69e923732726e8ed1e517fe3a2e34c3dd
commit r15-10590-g7978efd69e923732726e8ed1e517fe3a2e34c3dd Author: Harald Anlauf <[email protected]> Date: Thu Dec 4 22:16:10 2025 +0100 Fortran: associate to a contiguous pointer or target [PR122977] PR fortran/122977 gcc/fortran/ChangeLog: * expr.cc (gfc_is_simply_contiguous): For an associate variable check whether the associate target is contiguous. * resolve.cc (resolve_symbol): Skip array type check for an associate variable when the target has the contiguous attribute. gcc/testsuite/ChangeLog: * gfortran.dg/contiguous_16.f90: New test. (cherry picked from commit ee9ded19244ab887759eb3faef452ee70316835e) Diff: --- gcc/fortran/expr.cc | 8 +++++ gcc/fortran/resolve.cc | 1 + gcc/testsuite/gfortran.dg/contiguous_16.f90 | 51 +++++++++++++++++++++++++++++ 3 files changed, 60 insertions(+) diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index aea77260859c..4d6ea8a0ca6e 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -6232,6 +6232,14 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element) || (sym->as && sym->as->type == AS_ASSUMED_SHAPE)))) return false; + /* An associate variable may point to a non-contiguous target. */ + if (ar && ar->type == AR_FULL + && sym->attr.associate_var && !sym->attr.contiguous + && sym->assoc + && sym->assoc->target) + return gfc_is_simply_contiguous (sym->assoc->target, strict, + permit_element); + if (!ar || ar->type == AR_FULL) return true; diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 3e26551522d2..5c072499aa80 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -17349,6 +17349,7 @@ skip_interfaces: /* F2008, C530. */ if (sym->attr.contiguous + && !sym->attr.associate_var && (!class_attr.dimension || (as->type != AS_ASSUMED_SHAPE && as->type != AS_ASSUMED_RANK && !class_attr.pointer))) diff --git a/gcc/testsuite/gfortran.dg/contiguous_16.f90 b/gcc/testsuite/gfortran.dg/contiguous_16.f90 new file mode 100644 index 000000000000..ae1ba26135d9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/contiguous_16.f90 @@ -0,0 +1,51 @@ +! { dg-do run } +! { dg-options "-O2 -fdump-tree-original" } +! +! PR fortran/122977 - associate to a contiguous pointer + +program foo + integer, dimension(:), pointer, contiguous :: a + integer, dimension(:), allocatable :: u + allocate (a(4), u(4)) + if (.not. is_contiguous(a)) error stop 1 ! optimized + if (.not. is_contiguous(u)) error stop 2 ! optimized + + associate (b => a) + if (.not. is_contiguous(b)) error stop 3 ! optimized + associate (c => b) + if (.not. is_contiguous(c)) error stop 4 ! optimized + end associate + associate (c => b(1::2)) + if (is_contiguous(c)) stop 11 ! runtime check + end associate + end associate + + associate (v => u) + if (.not. is_contiguous(v)) error stop 5 ! optimized + associate (w => v) + if (.not. is_contiguous(w)) error stop 6 ! optimized + end associate + associate (w => v(1::2)) + if (is_contiguous(w)) stop 12 ! runtime check + end associate + end associate + + associate (b => a(1::2)) + if (is_contiguous(b)) stop 13 ! runtime check + associate (c => b) + if (is_contiguous(c)) stop 14 ! runtime check + end associate + end associate + + associate (v => u(1::2)) + if (is_contiguous(v)) stop 15 ! runtime check + associate (w => v) + if (is_contiguous(w)) stop 16 ! runtime check + end associate + end associate + + deallocate (a, u) +end program foo + +! { dg-final { scan-tree-dump-not "_gfortran_error_stop_numeric" "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_stop_numeric" 6 "original" } }
