re PR fortran/85786 (Segfault in associated intrinsic)

2018-05-25  Steven G. Kargl  <kargl@gcc.gnu.org>

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

From-SVN: r260783

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ab853d00cba78203986136f254865a443fee834f..b8133dd8454bca7052d5671d44018a74399fc665 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-05-25  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/85786
+       * gfortran.dg/pr85786.f90: New test.
+
 2018-05-25  Paul Koning  <ni1d@arrl.net>
 
        * gcc.c-torture/compile/20151204.c: Skip if pdp11.

diff --git a/gcc/testsuite/gfortran.dg/pr85786.f90 b/gcc/testsuite/gfortran.dg/pr85786.f90
new file mode 100644 (file)
index 0000000..e319acf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr85786.f90
@@ -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