https://gcc.gnu.org/g:f2339cefd6985e20014f9b0795fb651a96788246
commit r15-7925-gf2339cefd6985e20014f9b0795fb651a96788246
Author: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Wed Mar 5 15:18:48 2025 +0100
Fortran: Fix gimplification error for pointer remapping in forall [PR107143]
Enhance dependency checking for data pointers to check for same derived
type and not only for a type being a derived type. This prevent
generation of a descriptor for a function call, that is unsuitable in
forall's pointer assignment.
PR fortran/107143
gcc/fortran/ChangeLog:
* dependency.cc (check_data_pointer_types): Do not just compare
for derived type, but for same derived type.
gcc/testsuite/ChangeLog:
* gfortran.dg/forall_20.f90: New test.
Diff:
---
gcc/fortran/dependency.cc | 3 ++-
gcc/testsuite/gfortran.dg/forall_20.f90 | 40 +++++++++++++++++++++++++++++++++
2 files changed, 42 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index 8354b185f347..28b872f66382 100644
--- a/gcc/fortran/dependency.cc
+++ b/gcc/fortran/dependency.cc
@@ -1250,7 +1250,8 @@ check_data_pointer_types (gfc_expr *expr1, gfc_expr
*expr2)
sym2 = expr2->symtree->n.sym;
/* Keep it simple for now. */
- if (sym1->ts.type == BT_DERIVED && sym2->ts.type == BT_DERIVED)
+ if (sym1->ts.type == BT_DERIVED && sym2->ts.type == BT_DERIVED
+ && sym1->ts.u.derived == sym2->ts.u.derived)
return false;
if (sym1->attr.pointer)
diff --git a/gcc/testsuite/gfortran.dg/forall_20.f90
b/gcc/testsuite/gfortran.dg/forall_20.f90
new file mode 100644
index 000000000000..b0bb0dcb62fd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_20.f90
@@ -0,0 +1,40 @@
+!{ dg-do run }
+!
+! Check pointer aliasing is done w/o temp.
+! Contributed by Arseny Solokha <asolo...@gmx.com>
+
+program pr107143
+ type ta
+ integer, POINTER :: ip(:)
+ end type ta
+
+ type tb
+ integer, POINTER :: ip(:,:)
+ end type tb
+
+ integer, parameter :: cnt = 3
+ type(ta) :: a(cnt)
+ type(tb) :: b(cnt)
+ integer, target :: arr(8) = [1,2,3,4,5,6,7,8]
+
+ do i = 1, cnt
+ allocate(a(i)%ip(8), SOURCE=arr * i)
+ end do
+ call s5(b, a, 2, 4)
+
+ do i = 1, cnt
+ if (any(b(i)%ip /= reshape(arr * i, [2, 4]))) stop i
+ end do
+
+contains
+
+subroutine s5(y,z,n1,n2)
+
+ type(tb) :: y(:)
+ type(ta), TARGET :: z(:)
+
+ forall (i=1:cnt)
+ y(i)%ip(1:n1,1:n2) => z(i)%ip
+ end forall
+end subroutine s5
+end program
