diff mbox series

[Committed] PR fortran/85786 testcase

Message ID 20180525220049.GA46346@troutmask.apl.washington.edu
State New
Headers show
Series [Committed] PR fortran/85786 testcase | expand

Commit Message

Steve Kargl May 25, 2018, 10 p.m. UTC 
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  <kargl@gcc.gnu.org>

	PR fortran/85786
	* gfortran.dg/pr85786.f90: New test.
diff mbox series

Patch

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