gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-O2 -fdump-tree-original" }
   3 !
   4 ! PR fortran/32600 c_f_pointer w/o shape
   5 ! PR fortran/32580 c_f_procpointer
   6 !
   7 ! Verify that c_f_prointer [w/o shape] and c_f_procpointer generate
   8 ! the right code - and no library call
   9
  10 program test
  11   use iso_c_binding
  12   implicit none
  13   type(c_ptr)    :: cptr
  14   type(c_funptr) :: cfunptr
  15   integer(4), pointer :: fptr
  16   integer(4), pointer :: fptr_array(:)
  17   procedure(integer(4)), pointer :: fprocptr
  18
  19   call c_f_pointer(cptr, fptr)
  20   call c_f_pointer(cptr, fptr_array, [ 1 ])
  21   call c_f_procpointer(cfunptr, fprocptr)
  22 end program test
  23
  24 ! Make sure there is no function call:
  25 ! { dg-final { scan-tree-dump-times "c_f" 0 "original" } }
  26 ! { dg-final { scan-tree-dump-times "c_f_pointer" 0 "original" } }
  27 ! { dg-final { scan-tree-dump-times "c_f_pointer_i4" 0 "original" } }
  28 !
  29 ! Check scalar c_f_pointer
  30 ! { dg-final { scan-tree-dump-times "  fptr = .integer.kind=4. .. cptr" 1 "original" } }
  31 !
  32 ! Array c_f_pointer:
  33 !
  34 ! { dg-final { scan-tree-dump-times " fptr_array.data = cptr;" 1 "original" } }
  35 ! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].lbound = 1;" 1 "original" } }
  36 ! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].ubound = " 1 "original" } }
  37 ! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].stride = " 1 "original" } }
  38 !
  39 ! Check c_f_procpointer
  40 ! { dg-final { scan-tree-dump-times "  fprocptr = .integer.kind=4. .\\*<.*>. ... cfunptr;" 1 "original" } }
  41 !