On Fri, Jan 10, 2025 at 05:19:34PM +0000, Paul Richard Thomas wrote:
>
> As of today, Gerhard Steinmetz has no fewer than 33 regressions to his name
> out of a total of 54 for fortran and libgfortran. It's time that some of
> these bugs are swatted, I think :-)
>
PR 70949 appears to have been fixed at some point
in the past. The following patch converts Gerhard's
code into testcases.
diff --git a/gcc/testsuite/gfortran.dg/pr70949_1.f90
b/gcc/testsuite/gfortran.dg/pr70949_1.f90
new file mode 100644
index 00000000000..91cd18069fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr70949_1.f90
@@ -0,0 +1,27 @@
+!
+! { dg-do run}
+!
+program p
+
+ type t1
+ end type
+
+ type t2
+ type(t1), pointer :: q
+ end type
+
+ type(t1), pointer :: a
+ type(t2) :: c
+
+ allocate(a)
+ c%q => a
+ if (.not. associated(a, f(c))) stop 1
+
+ contains
+
+ function f(x) result (z)
+ type(t2), intent(in) :: x
+ class(t1), pointer :: z
+ z => x%q
+ end function f
+end
diff --git a/gcc/testsuite/gfortran.dg/pr70949_2.f90
b/gcc/testsuite/gfortran.dg/pr70949_2.f90
new file mode 100644
index 00000000000..eb064b6fa80
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr70949_2.f90
@@ -0,0 +1,27 @@
+!
+! { dg-do run}
+!
+program p
+
+ type t1
+ end type
+
+ type t2
+ type(t1), pointer :: q
+ end type
+
+ type(t1), pointer :: a
+ type(t2) :: c
+
+ allocate(a)
+ c%q => a
+ if (.not. associated(a, f(c))) stop 1
+
+ contains
+
+ function f(x) result (z)
+ type(t2), intent(in) :: x
+ type(t1), pointer :: z
+ z => x%q
+ end function f
+end
--
Steve
