From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 4 Dec 2025 21:16:10 +0000 (+0100)
Subject: Fortran: associate to a contiguous pointer or target [PR122977]
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=ee9ded19244ab887759eb3faef452ee70316835e;p=thirdparty%2Fgcc.git

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.
---

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" } }