1! { dg-do run { target c99_runtime } }
2! { dg-additional-sources ISO_Fortran_binding_10.c }
3!
4! Test the fix of PR89843.
5!
6! Contributed by Reinhold Bader  <Bader@lrz.de>
7!
8module mod_section_01
9  use, intrinsic :: iso_c_binding
10  implicit none
11  interface
12     subroutine si(this, flag, status) bind(c)
13       import :: c_float, c_int
14       real(c_float) :: this(:,:)
15       integer(c_int), value :: flag
16       integer(c_int) :: status
17     end subroutine si
18  end interface
19contains
20  subroutine sa(this, flag, status) bind(c)
21    real(c_float) :: this(:)
22    integer(c_int), value :: flag
23    integer(c_int) :: status
24
25    status = 0
26
27    select case (flag)
28    case (0)
29       if (is_contiguous(this)) then
30          write(*,*) 'FAIL 1:'
31          status = status + 1
32       end if
33       if (size(this,1) /= 3) then
34          write(*,*) 'FAIL 2:',size(this)
35          status = status + 1
36          goto 10
37       end if
38       if (maxval(abs(this - [ 1.0, 3.0, 5.0 ])) > 1.0e-6) then
39          write(*,*) 'FAIL 3:',abs(this)
40          status = status + 1
41       end if
42  10   continue
43   case (1)
44      if (size(this,1) /= 3) then
45          write(*,*) 'FAIL 4:',size(this)
46          status = status + 1
47          goto 20
48       end if
49       if (maxval(abs(this - [ 11.0, 12.0, 13.0 ])) > 1.0e-6) then
50          write(*,*) 'FAIL 5:',this
51          status = status + 1
52       end if
53  20   continue
54   case (2)
55      if (size(this,1) /= 4) then
56          write(*,*) 'FAIL 6:',size(this)
57          status = status + 1
58          goto 30
59       end if
60      if (maxval(abs(this - [ 2.0, 7.0, 12.0, 17.0 ])) > 1.0e-6) then
61          write(*,*) 'FAIL 7:',this
62          status = status + 1
63       end if
64  30   continue
65    end select
66
67!    if (status == 0) then
68!       write(*,*) 'OK'
69!    end if
70  end subroutine sa
71end module mod_section_01
72
73program section_01
74  use mod_section_01
75  implicit none
76  real(c_float) :: v(5,4)
77  integer :: i
78  integer :: status
79
80  v = reshape( [ (real(i), i = 1, 20) ], [ 5, 4 ] )
81  call si(v, 0, status)
82  if (status .ne. 0) stop 1
83
84  call sa(v(1:5:2, 1), 0, status)
85  if (status .ne. 0) stop 2
86
87  call si(v, 1, status)
88  if (status .ne. 0) stop 3
89
90  call sa(v(1:3, 3), 1, status)
91  if (status .ne. 0) stop 4
92
93  call si(v, 2, status)
94  if (status .ne. 0) stop 5
95
96  call sa(v(2,1:4), 2, status)
97  if (status .ne. 0) stop 6
98
99end program section_01
100