From: Steven G. Kargl <kargl@gcc.gnu.org>
Date: Fri, 25 May 2018 21:57:24 +0000 (+0000)
Subject: re PR fortran/85786 (Segfault in associated intrinsic)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c0e8f02b27afc1a07f30a7597f8ae34094821f9d;p=gcc.git

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 ab853d00cba..b8133dd8454 100644
--- 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
index 00000000000..e319acfaa07
--- /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