1! { dg-do compile }
2!
3! PR fortran/38894
4!
5!
6
7subroutine test2
8use iso_c_binding
9type(c_funptr) :: fun
10type(c_ptr) :: fptr
11procedure(), pointer :: bar
12integer, pointer :: bari
13call c_f_procpointer(fptr,bar) ! { dg-error "Argument CPTR at .1. to C_F_PROCPOINTER shall have the type TYPE.C_FUNPTR." }
14call c_f_pointer(fun,bari) ! { dg-error "Argument CPTR at .1. to C_F_POINTER shall have the type TYPE.C_PTR." }
15fun = fptr ! { dg-error "Can't convert TYPE.c_ptr. to TYPE.c_funptr." }
16end
17
18subroutine test()
19use iso_c_binding, c_ptr2 => c_ptr
20type(c_ptr2) :: fun
21procedure(), pointer :: bar
22integer, pointer :: foo
23call c_f_procpointer(fun,bar) ! { dg-error "Argument CPTR at .1. to C_F_PROCPOINTER shall have the type TYPE.C_FUNPTR." }
24call c_f_pointer(fun,foo)  ! OK
25end
26
27module rename
28  use, intrinsic :: iso_c_binding, only: my_c_ptr_0 => c_ptr
29end module rename
30
31program p
32  use, intrinsic :: iso_c_binding, my_c_ptr => c_ptr
33  type(my_c_ptr) :: my_ptr
34  print *,c_associated(my_ptr)
35contains
36  subroutine sub()
37    use rename   ! (***)
38    type(my_c_ptr_0) :: my_ptr2
39    type(c_funptr) :: myfun
40    print *,c_associated(my_ptr,my_ptr2)
41    print *,c_associated(my_ptr,myfun) ! { dg-error "Argument C_PTR_2 at .1. to C_ASSOCIATED shall have the same type as C_PTR_1: TYPE.c_ptr. instead of TYPE.c_funptr." }
42  end subroutine
43end
44