gcc/testsuite/gfortran.dg/proc_ptr_comp_11.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 40427: Procedure Pointer Components with OPTIONAL arguments
   4 !
   5 ! Original test case by John McFarland <john.mcfarland@swri.org>
   6 ! Modified by Janus Weil <janus@gcc.gnu.org>
   7
   8 PROGRAM prog
   9
  10  ABSTRACT INTERFACE
  11  SUBROUTINE sub_template(i,j,o)
  12    INTEGER, INTENT(in) :: i
  13    INTEGER, INTENT(in), OPTIONAL :: j, o
  14  END SUBROUTINE sub_template
  15  END INTERFACE
  16
  17  TYPE container
  18    PROCEDURE(sub_template), POINTER, NOPASS :: s
  19  END TYPE container
  20
  21  PROCEDURE(sub_template), POINTER :: f
  22  TYPE (container) :: c
  23
  24  c%s => sub
  25  f => sub
  26
  27  CALL f(2,o=4)
  28  CALL c%s(3,o=6)
  29
  30 CONTAINS
  31
  32  SUBROUTINE sub(i,arg2,arg3)
  33    INTEGER, INTENT(in) :: i
  34    INTEGER, INTENT(in), OPTIONAL :: arg2, arg3
  35    if (present(arg2)) call abort()
  36    if (.not. present(arg3)) call abort()
  37    if (2*i/=arg3) call abort()
  38  END SUBROUTINE sub
  39
  40 END PROGRAM prog
  41