gcc/testsuite/gfortran.dg/pr85786.f90

   1 ! { dg-do run }
   2 ! PR fortran/85786
   3 program test
   4
   5    implicit none
   6
   7    type :: p2d
   8       real, pointer :: p(:,:) => null()
   9    end type p2d
  10
  11    type :: test_cs
  12       type(p2d), pointer :: v(:) => null()
  13    end type test_cs
  14
  15    type(test_cs), pointer :: cs
  16    real, allocatable, target :: e(:,:)
  17
  18    allocate(cs)
  19    if (associated(cs) .neqv. .true.) stop 1
  20
  21    allocate(cs%v(2))
  22    if (associated(cs%v) .neqv. .true.) stop 2
  23
  24    allocate(e(2,2))
  25    e = 42
  26
  27    if (query_ptr(e, cs) .neqv. .true.) stop 3
  28
  29    contains
  30
  31       logical function query_ptr(f_ptr, cs)
  32
  33          real, target, intent(in) :: f_ptr(:,:)
  34          type(test_cs), pointer, intent(inout) :: cs
  35
  36          if (associated(cs)) then
  37             if (associated(cs%v) .neqv. .true.) stop 4
  38             cs%v(2)%p => f_ptr
  39             if (associated(cs%v(2)%p) .neqv. .true.) stop 5
  40             query_ptr = associated(cs%v(2)%p, f_ptr)
  41          else
  42             query_ptr = .false.
  43          end if
  44   end function query_ptr
  45
  46 end program test