gcc/testsuite/gfortran.dg/proc_ptr_8.f90

   1 ! { dg-do run }
   2 ! { dg-additional-sources proc_ptr_8.c }
   3 !
   4 ! PR fortran/32580
   5 ! Original test case
   6 !
   7 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
   8
   9 MODULE X
  10
  11   USE ISO_C_BINDING
  12   INTERFACE
  13     INTEGER(KIND=C_INT) FUNCTION mytype( a ) BIND(C)
  14        USE ISO_C_BINDING
  15        INTEGER(KIND=C_INT), VALUE :: a
  16     END FUNCTION
  17     SUBROUTINE init() BIND(C,name="init")
  18     END SUBROUTINE
  19   END INTERFACE
  20
  21   TYPE(C_FUNPTR), BIND(C,name="funpointer") :: funpointer
  22
  23 END MODULE X
  24
  25 USE X
  26 PROCEDURE(mytype), POINTER :: ptype,ptype2
  27
  28 CALL init()
  29 CALL C_F_PROCPOINTER(funpointer,ptype)
  30 if (ptype(3) /= 9) call abort()
  31
  32 ! the stuff below was added with PR 42072
  33 call setpointer(ptype2)
  34 if (ptype2(4) /= 12) call abort()
  35
  36 contains
  37
  38   subroutine setpointer (p)
  39     PROCEDURE(mytype), POINTER :: p
  40     CALL C_F_PROCPOINTER(funpointer,p)
  41   end subroutine
  42
  43 END