gcc/testsuite/gfortran.dg/pr71764.f90

   1 ! { dg-do run }
   2 ! PR71764
   3 program p
   4    use iso_c_binding, only: c_ptr, c_null_ptr, c_ptr, c_associated, c_loc
   5    logical, target :: rls
   6    real, target :: t = 3.14
   7    type(c_ptr) :: nullptr,c
   8    real, pointer :: k
   9    nullptr = c_null_ptr
  10    c = nullptr
  11    rls = c_associated(c)
  12    if (rls) call abort
  13    if (c_associated(c)) call abort
  14    c = c_loc(rls)
  15    if (.not. c_associated(c)) call abort
  16    c = nullptr
  17    if (c_associated(c)) call abort
  18    c = c_loc(t)
  19    k => t
  20    call association_test(k, c)
  21 contains
  22   subroutine association_test(a,b)
  23     use iso_c_binding, only: c_associated, c_loc, c_ptr
  24     implicit none
  25     real, pointer :: a
  26     type(c_ptr) :: b
  27     if(c_associated(b, c_loc(a))) then
  28        return
  29     else
  30        call abort
  31     end if
  32   end subroutine association_test
  33 end
  34