gcc/testsuite/gfortran.dg/proc_ptr_result_7.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 54285: [F03] Calling a PPC with proc-ptr result
   4 !
   5 ! Contributed by Janus Weil <janus@gcc.gnu.org>
   6
   7 type :: t
   8   procedure(a), pointer, nopass :: p
   9 end type
  10
  11 type(t) :: x
  12
  13 ! We cannot use "iabs" directly as it is elemental.
  14 abstract interface
  15   pure integer function interf_iabs(x)
  16     integer, intent(in) :: x
  17   end function interf_iabs
  18 end interface
  19 procedure(interf_iabs), pointer :: pp
  20
  21 x%p => a
  22
  23 pp => x%p()
  24
  25 if (pp(-3) /= 3) STOP 1
  26
  27 contains
  28
  29   function a() result (b)
  30     procedure(interf_iabs), pointer :: b
  31     b => iabs
  32   end function
  33
  34 end