From c0e8f02b27afc1a07f30a7597f8ae34094821f9d Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Fri, 25 May 2018 21:57:24 +0000 Subject: [PATCH] re PR fortran/85786 (Segfault in associated intrinsic) 2018-05-25 Steven G. Kargl PR fortran/85786 * gfortran.dg/pr85786.f90: New test. From-SVN: r260783 --- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/pr85786.f90 | 46 +++++++++++++++++++++++++++++++++++ 2 files changed, 51 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/pr85786.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ab853d0..b8133dd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-05-25 Steven G. Kargl + + PR fortran/85786 + * gfortran.dg/pr85786.f90: New test. + 2018-05-25 Paul Koning * 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 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 -- 2.7.4