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