Dear All, the attached patch fixes a regression when trying to associate to a pointer target with the contiguous attribute.
While trying the obvious fix, I saw that gfc_is_simply_contiguous is not working properly when applied to an associate variable, and even more so for nested associate constructs. So we now also recursively look at the associate target to get this right. See testcase for simple use cases. Regtested on x86_64-pc-linux-gnu. OK for mainline / 15-branch? Thanks, Harald
From 1b097ce01140be7f52401aa4f5a7c7c80464d21f Mon Sep 17 00:00:00 2001 From: Harald Anlauf <[email protected]> Date: Thu, 4 Dec 2025 22:16:10 +0100 Subject: [PATCH] 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. --- gcc/fortran/expr.cc | 8 ++++ gcc/fortran/resolve.cc | 1 + gcc/testsuite/gfortran.dg/contiguous_16.f90 | 51 +++++++++++++++++++++ 3 files changed, 60 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/contiguous_16.f90 diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index 00abd9e8734..054276e86b1 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -6406,6 +6406,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 9f3ce1d2ad6..8e076c66bed 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -18143,6 +18143,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 00000000000..ae1ba26135d --- /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" } } -- 2.51.0
