1! { dg-do run { target c99_runtime } }
2! { dg-additional-sources ISO_Fortran_binding_8.c }
3!
4! Test the fix for PR89842.
5!
6! Contributed by Reinhold Bader  <Bader@lrz.de>
7!
8module mod_alloc_01
9  use, intrinsic :: iso_c_binding
10  implicit none
11
12  interface
13     subroutine globalp(this) bind(c)
14       import :: c_float
15       real(c_float), allocatable :: this(:)
16     end subroutine globalp
17  end interface
18end module mod_alloc_01
19
20program alloc_01
21  use mod_alloc_01
22  implicit none
23
24  real(c_float), allocatable :: myp(:)
25  integer :: status
26
27  status = 0
28  call globalp(myp)
29
30!  write(*,*) 'globalp done'
31  if (.not. allocated(myp)) then
32     write(*,*) 'FAIL 1'
33     stop 1
34  end if
35  if (lbound(myp,1) /= 3 .or. size(myp,1) /= 4) then
36     write(*,*) 'FAIL 2: ', lbound(myp), size(myp,1)
37     status = status + 1
38  else
39!     write(*,*) 'Now checking data', myp(3)
40     if (maxval(abs(myp - [1.1, 2.3, 5.1, 4.2])) > 1.0e-6) then
41        write(*,*) 'FAIL 3: ', myp
42        status = status + 1
43     end if
44  end if
45
46  if (status .ne. 0) then
47     stop status
48  end if
49end program alloc_01
50
51