1! { dg-do compile }
2!
3! Contributed by Reinhold Bader
4!
5program assumed_shape_01
6  use, intrinsic :: iso_c_binding
7  implicit none
8  type, bind(c) :: cstruct
9     integer(c_int) :: i
10     real(c_float) :: r(2)
11  end type cstruct
12  interface
13     subroutine psub(this, that) bind(c, name='Psub')
14       import :: c_float, cstruct
15       real(c_float) :: this(:,:)
16       type(cstruct) :: that(:)
17     end subroutine psub
18  end interface
19
20  real(c_float) :: t(3,7)
21  type(cstruct), pointer :: u(:)
22
23! The following is VALID Fortran 2008 but NOT YET supported
24  allocate(u, source=[cstruct( 4, [1.1,2.2] ) ]) ! { dg-error "Array specification required in ALLOCATE statement" }
25  call psub(t, u)
26  deallocate (u)
27
28end program assumed_shape_01
29