gcc/testsuite/gfortran.dg/c_funloc_tests_8.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR fortran/50612
   4 ! PR fortran/47023
   5 !
   6 subroutine test
   7   use iso_c_binding
   8   implicit none
   9   external foo
  10   procedure(), pointer :: pp
  11   print *, c_sizeof(pp) ! { dg-error "Procedure unexpected as argument" }
  12   print *, c_sizeof(foo) ! { dg-error "Procedure unexpected as argument" }
  13   print *, c_sizeof(bar) ! { dg-error "Procedure unexpected as argument" }
  14 contains
  15   subroutine bar()
  16   end subroutine bar
  17 end
  18
  19 integer function foo2()
  20   procedure(), pointer :: ptr
  21   ptr => foo2 ! { dg-error "Function result 'foo2' is invalid as proc-target in procedure pointer assignment" }
  22   foo2 = 7
  23   block
  24     ptr => foo2 ! { dg-error "Function result 'foo2' is invalid as proc-target in procedure pointer assignment" }
  25   end block
  26 contains
  27   subroutine foo()
  28     ptr => foo2 ! { dg-error "Function result 'foo2' is invalid as proc-target in procedure pointer assignment" }
  29   end subroutine foo
  30 end function foo2
  31
  32 module m2
  33 contains
  34 integer function foo(i, fptr) bind(C)
  35   use iso_c_binding
  36   implicit none
  37   integer :: i
  38   type(c_funptr) :: fptr
  39   fptr = c_funloc(foo) ! { dg-error "Function result 'foo' at .1. is invalid as X argument to C_FUNLOC" }
  40   block
  41     fptr = c_funloc(foo) ! { dg-error "Function result 'foo' at .1. is invalid as X argument to C_FUNLOC" }
  42   end block
  43   foo = 42*i
  44 contains
  45   subroutine bar()
  46     fptr = c_funloc(foo) ! { dg-error "Function result 'foo' at .1. is invalid as X argument to C_FUNLOC" }
  47   end subroutine bar
  48 end function foo
  49 end module m2