gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR fortran/38894
   4 !
   5 !
   6
   7 subroutine test2
   8 use iso_c_binding
   9 type(c_funptr) :: fun
  10 type(c_ptr) :: fptr
  11 procedure(), pointer :: bar
  12 integer, pointer :: bari
  13 call c_f_procpointer(fptr,bar) ! { dg-error "Argument CPTR at .1. to C_F_PROCPOINTER shall have the type TYPE.C_FUNPTR." }
  14 call c_f_pointer(fun,bari) ! { dg-error "Argument CPTR at .1. to C_F_POINTER shall have the type TYPE.C_PTR." }
  15 fun = fptr ! { dg-error "Cannot convert TYPE.c_ptr. to TYPE.c_funptr." }
  16 end
  17
  18 subroutine test()
  19 use iso_c_binding, c_ptr2 => c_ptr
  20 type(c_ptr2) :: fun
  21 procedure(), pointer :: bar
  22 integer, pointer :: foo
  23 call c_f_procpointer(fun,bar) ! { dg-error "Argument CPTR at .1. to C_F_PROCPOINTER shall have the type TYPE.C_FUNPTR." }
  24 call c_f_pointer(fun,foo)  ! OK
  25 end
  26
  27 module rename
  28   use, intrinsic :: iso_c_binding, only: my_c_ptr_0 => c_ptr
  29 end module rename
  30
  31 program 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)
  35 contains
  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
  43 end