gcc/testsuite/gfortran.dg/c_ptr_tests_19.f90

   1 ! { dg-do run }
   2
   3 ! PR 71544 - this failed with some optimization options due to a
   4 ! pointer not being marked as escaping.
   5
   6 module store_cptr
   7     use, intrinsic :: iso_c_binding
   8     implicit none
   9     public
  10     type(c_ptr), save :: cptr
  11 end module store_cptr
  12
  13 subroutine init()
  14     use, intrinsic :: iso_c_binding
  15     implicit none
  16     integer(c_int), pointer :: a
  17     allocate(a)
  18     call save_cptr(c_loc(a))
  19     a = 100
  20 end subroutine init
  21
  22 subroutine save_cptr(cptr_in)
  23     use store_cptr
  24     implicit none
  25     type(c_ptr), intent(in) :: cptr_in
  26     cptr = cptr_in
  27 end subroutine save_cptr
  28
  29 program init_fails
  30     use store_cptr
  31     implicit none
  32     integer(c_int), pointer :: val
  33     call init()
  34     call c_f_pointer(cptr,val)
  35     if (val /= 100) stop 1
  36 end program init_fails