1! { dg-do run }
2!
3! PR fortran/38829
4! PR fortran/40963
5! PR fortran/38813
6!
7!
8program 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)])) call abort ()
29
30    cptr = c_loc (obj1%array2)
31    call c_f_pointer (cptr, array, shape=[100])
32    if (any (array /= [(i, i=1,100)])) call abort ()
33end program testcloc
34
35