gcc/testsuite/gfortran.dg/iso_c_binding_rename_1.f03

   1 ! { dg-do run }
   2 ! { dg-additional-sources iso_c_binding_rename_1_driver.c }
   3 module iso_c_binding_rename_0
   4   use, intrinsic :: iso_c_binding, only: my_c_ptr_0 => c_ptr, &
   5        c_associated
   6 end module iso_c_binding_rename_0
   7
   8
   9 module iso_c_binding_rename_1
  10   ! rename a couple of the symbols from iso_c_binding.  the compiler
  11   ! needs to be able to recognize the derived types with names different
  12   ! from the one in iso_c_binding because it will look up the derived types
  13   ! to define the args and return values of some of the procedures in
  14   ! iso_c_binding.  this should verify that this functionality works.
  15   use, intrinsic :: iso_c_binding, my_c_int => c_int, my_c_ptr => c_ptr, &
  16        my_c_associated => c_associated, my_c_f_pointer => c_f_pointer
  17
  18 contains
  19   subroutine sub0(my_int) bind(c)
  20     integer(my_c_int), value :: my_int
  21     if(my_int .ne. 1) then
  22        STOP 1
  23     end if
  24   end subroutine sub0
  25
  26   subroutine sub1(my_ptr) bind(c)
  27     type(my_c_ptr), value :: my_ptr
  28
  29     if(.not. my_c_associated(my_ptr)) then
  30        STOP 2
  31     end if
  32   end subroutine sub1
  33
  34   subroutine sub2(my_int, my_long) bind(c)
  35     use, intrinsic :: iso_c_binding, my_c_int_2 => c_int, &
  36          my_c_long_2 => c_long
  37     integer(my_c_int_2), value :: my_int
  38     integer(my_c_long_2), value :: my_long
  39
  40     if(my_int .ne. 1) then
  41        STOP 3
  42     end if
  43     if(my_long .ne. 1) then
  44        STOP 4
  45     end if
  46   end subroutine sub2
  47
  48   subroutine sub3(cptr1, cptr2) bind(c)
  49     type(my_c_ptr), value :: cptr1
  50     type(my_c_ptr), value :: cptr2
  51     integer(my_c_int), pointer :: my_f90_c_ptr
  52
  53     if(.not. my_c_associated(cptr1)) then
  54        STOP 5
  55     end if
  56
  57     if(.not. my_c_associated(cptr1, cptr2)) then
  58        STOP 6
  59     end if
  60
  61     call my_c_f_pointer(cptr1, my_f90_c_ptr)
  62   end subroutine sub3
  63
  64   subroutine sub4(cptr1, cptr2) bind(c)
  65     ! rename the my_c_ptr_0 from iso_c_binding_rename_0 just to further test
  66     ! both are actually aliases to c_ptr
  67     use iso_c_binding_rename_0, my_c_ptr_local => my_c_ptr_0, &
  68          my_c_associated_2 => c_associated
  69
  70     implicit none
  71     type(my_c_ptr_local), value :: cptr1
  72     type(my_c_ptr_local), value :: cptr2
  73
  74     if(.not. my_c_associated_2(cptr1)) then
  75        STOP 7
  76     end if
  77
  78     if(.not. my_c_associated_2(cptr2)) then
  79        STOP 8
  80     end if
  81   end subroutine sub4
  82 end module iso_c_binding_rename_1