gcc/testsuite/gfortran.dg/c_ptr_tests_18.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR fortran/37829
   4 ! PR fortran/45190
   5 !
   6 ! Contributed by Mat Cross
   7 !
   8 ! Fix derived-type loading with ISO_BIND_C's C_PTR/C_FUNPTR.
   9
  10 MODULE NAG_J_TYPES
  11   USE ISO_C_BINDING, ONLY : C_PTR
  12   IMPLICIT NONE
  13   TYPE                            :: NAG_IMAGE
  14      INTEGER                      :: WIDTH, HEIGHT, PXFMT, NCHAN
  15      TYPE (C_PTR)                 :: PIXELS
  16   END TYPE NAG_IMAGE
  17 END MODULE NAG_J_TYPES
  18 program cfpointerstress
  19   use nag_j_types
  20   use iso_c_binding
  21   implicit none
  22   type(nag_image),pointer :: img
  23   type(C_PTR)             :: ptr
  24   real, pointer           :: r
  25   allocate(r)
  26   allocate(img)
  27   r = 12
  28   ptr = c_loc(img)
  29   write(*,*) 'C_ASSOCIATED =', C_ASSOCIATED(ptr)
  30   call c_f_pointer(ptr, img)
  31   write(*,*) 'ASSOCIATED =', associated(img)
  32   deallocate(r)
  33 end program cfpointerstress