1! { dg-do compile }
2!
3! PR fortran/50612
4! PR fortran/47023
5!
6subroutine 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" }
14contains
15  subroutine bar()
16  end subroutine bar
17end
18
19integer 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
26contains
27  subroutine foo()
28    ptr => foo2 ! { dg-error "Function result 'foo2' is invalid as proc-target in procedure pointer assignment" }
29  end subroutine foo
30end function foo2
31
32module m2
33contains
34integer 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
44contains
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
48end function foo
49end module m2
50