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
10MODULE 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
17END MODULE NAG_J_TYPES
18program 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)
33end program cfpointerstress
34