diff options
author | Steven G. Kargl <kargl@gcc.gnu.org> | 2018-05-25 21:57:24 +0000 |
---|---|---|
committer | Steven G. Kargl <kargl@gcc.gnu.org> | 2018-05-25 21:57:24 +0000 |
commit | c0e8f02b27afc1a07f30a7597f8ae34094821f9d (patch) | |
tree | 620bf656acde3d479f2814ec627e407d651d8400 | |
parent | d9338471b91bbe6e1579088c7d40ab257ac3764d (diff) | |
download | gcc-c0e8f02b27afc1a07f30a7597f8ae34094821f9d.zip gcc-c0e8f02b27afc1a07f30a7597f8ae34094821f9d.tar.gz gcc-c0e8f02b27afc1a07f30a7597f8ae34094821f9d.tar.bz2 |
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
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/pr85786.f90 | 46 |
2 files changed, 51 insertions, 0 deletions
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 <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 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 |