Hi Mikael!
Am 04.10.26 um 9:59 PM schrieb Mikael Morin:
From: Mikael Morin <[email protected]>
Fortran-tested on aarch64-unknown-linux-gnu.
OK for mainline?
This is OK.
Potentially also for a backport to 16-branch where the offending code
was introduced.
Thanks for the patch!
Harald
-- >8 --
In the function implementing the simply contiguous property, fix the
conditions governing the forwarding of the query from an associate name to
its target.
The query was forwarded to the associate target for any associate name
reference that was a full array, which included the case of a full array
component. But a component may have different contiguous properties from
the variable it's part of. Supplement the check guarding the forwarding
with an additional condition that the subreference walk before saw no
component reference.
The query was forwarded to the associate target only for a full reference
to the associate name. But a non-full simply-contiguous section reference
of an associate name associated with a non-contiguous target is not simply
contiguous. Remove the condition on the full array reference from the
check guarding the forwarding.
With the condition on the full array reference removed, a non-contiguous
array section of an associate name associated with a simply contiguous
target should continue to return false. Continue checking the array
section even if the query forwarded to the associate target returned
true.
PR fortran/127701
gcc/fortran/ChangeLog:
* expr.cc (gfc_is_simply_contiguous): Only forward to the associate
target if there is no subreference after the associate name. Also
forward to the associate target for a non-full array reference.
Continue checking the array reference even if the associate target
is simply contiguous.
gcc/testsuite/ChangeLog:
* gfortran.dg/contiguous_18.f90: New test.
---
gcc/fortran/expr.cc | 9 ++--
gcc/testsuite/gfortran.dg/contiguous_18.f90 | 46 +++++++++++++++++++++
2 files changed, 51 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/contiguous_18.f90
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index bdd7a200822..68663fe35d1 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -6490,12 +6490,13 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict,
bool permit_element)
return false;
/* An associate variable may point to a non-contiguous target. */
- if (ar && ar->type == AR_FULL
+ if (!part_ref
&& sym->attr.associate_var && !sym->attr.contiguous
&& sym->assoc
- && sym->assoc->target)
- return gfc_is_simply_contiguous (sym->assoc->target, strict,
- permit_element);
+ && sym->assoc->target
+ && !gfc_is_simply_contiguous (sym->assoc->target, strict,
+ permit_element))
+ return false;
if (!ar || ar->type == AR_FULL)
return true;
diff --git a/gcc/testsuite/gfortran.dg/contiguous_18.f90
b/gcc/testsuite/gfortran.dg/contiguous_18.f90
new file mode 100644
index 00000000000..8e35575896a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contiguous_18.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+!
+! PR fortran/127701
+! Check that a simply contiguous reference is correctly recognized as such when
+! it is a subreference of an associate name.
+
+program prog
+ implicit none
+ integer, parameter :: l = 7
+ integer, parameter :: m = 5
+ integer, parameter :: s = 2
+ integer, parameter :: n = (m + s - 1) / s
+ type :: t1
+ integer :: c1(l,l)
+ end type
+ type(t1), target :: x(m)
+ integer, target :: y(m,m)
+ integer :: i, j
+ x = (/ (t1(reshape([ (i+j, j=1,l*l) ], [l,l])), i=1,size(x,1)) /)
+ call sub1(x(::s))
+ y = reshape((/ (i*i, i=1,size(y)) /), shape(y))
+ call sub2(y(::s,:))
+ call sub3(y)
+contains
+ subroutine sub1(a)
+ type(t1), target :: a(:)
+ integer, contiguous, pointer :: p(:)
+ associate(b => a)
+ p(1:l*l) => b(1)%c1 ! no error
+ end associate
+ end subroutine
+ subroutine sub2(a)
+ integer, target :: a(:,:)
+ integer, contiguous, pointer :: p(:)
+ associate(b => a)
+ p(1:n*m) => b(:,:) ! { dg-error "must be rank 1 or simply
contiguous" }
+ end associate
+ end subroutine
+ subroutine sub3(a)
+ integer, target :: a(m,m)
+ integer, contiguous, pointer :: p(:)
+ associate(b => a)
+ p(1:n*m) => b(::s,:) ! { dg-error "must be rank 1 or simply
contiguous" }
+ end associate
+ end subroutine
+end program
