From f2339cefd6985e20014f9b0795fb651a96788246 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Wed, 5 Mar 2025 15:18:48 +0100
Subject: [PATCH] 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.
---
 gcc/fortran/dependency.cc               |  3 +-
 gcc/testsuite/gfortran.dg/forall_20.f90 | 40 +++++++++++++++++++++++++
 2 files changed, 42 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/forall_20.f90

diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index 8354b185f34..28b872f6638 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 00000000000..b0bb0dcb62f
--- /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  <asolokha@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