pault accidently committed in r260414 the 2-line patchr
from comment #5 of
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=85786
which fixes the PR. I have converted the code in comment #3
into a testcase and committed to ensure that the bug
does not re-appear. Code attached.
2018-05-25 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/85786
* gfortran.dg/pr85786.f90: New test.
--
Steve
Index: gcc/testsuite/gfortran.dg/pr85786.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr85786.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr85786.f90 (working copy)
@@ -0,0 +1,46 @@
+! { dg-do run }
+! PR fortran/85786
+program test
+
+ implicit none
+
+ type :: p2d
+ real, pointer :: p(:,:) => null()
+ end type p2d
+
+ type :: test_cs
+ type(p2d), pointer :: v(:) => null()
+ end type test_cs
+
+ type(test_cs), pointer :: cs
+ real, allocatable, target :: e(:,:)
+
+ allocate(cs)
+ if (associated(cs) .neqv. .true.) stop 1
+
+ allocate(cs%v(2))
+ if (associated(cs%v) .neqv. .true.) stop 2
+
+ allocate(e(2,2))
+ e = 42
+
+ if (query_ptr(e, cs) .neqv. .true.) stop 3
+
+ contains
+
+ logical function query_ptr(f_ptr, cs)
+
+ real, target, intent(in) :: f_ptr(:,:)
+ type(test_cs), pointer, intent(inout) :: cs
+
+ if (associated(cs)) then
+ if (associated(cs%v) .neqv. .true.) stop 4
+ cs%v(2)%p => f_ptr
+ if (associated(cs%v(2)%p) .neqv. .true.) stop 5
+ query_ptr = associated(cs%v(2)%p, f_ptr)
+ else
+ query_ptr = .false.
+ end if
+ end function query_ptr
+
+end program test
