gcc/testsuite/gfortran.dg/c_loc_test_20.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/38829
   4 ! PR fortran/40963
   5 ! PR fortran/38813
   6 !
   7 !
   8 program testcloc
   9     use, intrinsic :: iso_c_binding
  10     implicit none
  11
  12     type obj
  13         real :: array(10,10)
  14         real, allocatable :: array2(:,:)
  15     end type
  16
  17     type(obj), target :: obj1
  18     type(c_ptr) :: cptr
  19     integer :: i
  20     real, pointer :: array(:)
  21
  22     allocate (obj1%array2(10,10))
  23     obj1%array  = reshape ([(i, i=1,100)], shape (obj1%array))
  24     obj1%array2 = reshape ([(i, i=1,100)], shape (obj1%array))
  25
  26     cptr = c_loc (obj1%array)
  27     call c_f_pointer (cptr, array, shape=[100])
  28     if (any (array /= [(i, i=1,100)])) STOP 1
  29
  30     cptr = c_loc (obj1%array2)
  31     call c_f_pointer (cptr, array, shape=[100])
  32     if (any (array /= [(i, i=1,100)])) STOP 2
  33 end program testcloc
  34