diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg/proc_ptr_36.f90')
| -rw-r--r-- | gcc/testsuite/gfortran.dg/proc_ptr_36.f90 | 46 |
1 files changed, 46 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_36.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_36.f90 new file mode 100644 index 0000000000..7f3525eed2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_36.f90 @@ -0,0 +1,46 @@ +! { dg-do run } +! +! PR fortran/52585 +! +! Test proc-pointer dummies with ASSOCIATE +! +! Contributed by Mat Cross of NAG +! +module m0 + abstract interface + subroutine sub + end subroutine sub + end interface + interface + subroutine s(ss, isassoc) + import sub + logical :: isassoc + procedure(sub), pointer, intent(in) :: ss + end subroutine s + end interface +end module m0 + +use m0, only : sub, s +procedure(sub) :: sub2, pp +pointer :: pp +pp => sub2 +if (.not. associated(pp)) call abort () +if (.not. associated(pp,sub2)) call abort () +call s(pp, .true.) +pp => null() +if (associated(pp)) call abort () +if (associated(pp,sub2)) call abort () +call s(pp, .false.) +end + +subroutine s(ss, isassoc) + use m0, only : sub + logical :: isassoc + procedure(sub), pointer, intent(in) :: ss + procedure(sub) :: sub2 + if (isassoc .neqv. associated(ss)) call abort () + if (isassoc .neqv. associated(ss,sub2)) call abort () +end subroutine s + +subroutine sub2 +end subroutine sub2 |