|
| 1 | + |
| 2 | +!** Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
| 3 | +!** See https://llvm.org/LICENSE.txt for license information. |
| 4 | +!** SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
| 5 | +! |
| 6 | +! testing if contiguous arrays passed as argument are really contiguous |
| 7 | + |
| 8 | +program main |
| 9 | + integer, parameter :: m=6,n=4,h=2 |
| 10 | + integer :: i,j |
| 11 | + |
| 12 | + integer(kind=4), allocatable :: big_array(:, :) |
| 13 | + integer(kind=4) :: expected(n-h, m-h) |
| 14 | + integer(kind=4) :: res(n-h, m-h) |
| 15 | + allocate(big_array(n, m)) |
| 16 | + do i=1,n |
| 17 | + do j=1,m |
| 18 | + big_array(i,j) = i |
| 19 | + enddo |
| 20 | + enddo |
| 21 | + expected = big_array(1:n-h,1:m-h) |
| 22 | + call pass_contiguous_array(big_array(1:n-h,1:m-h), m, n, h, res) |
| 23 | + call check(res,expected,(n-h)*(m-h)); |
| 24 | + |
| 25 | +contains |
| 26 | + subroutine pass_contiguous_array(arr, m, n, h, res) |
| 27 | + use iso_c_binding |
| 28 | + implicit none |
| 29 | + integer(kind=4), target, contiguous, intent(in) :: arr(:,:) |
| 30 | + integer(kind=4), target, intent(inout) :: res(n-h,m-h) |
| 31 | + integer, intent(in) :: m, n, h |
| 32 | + integer :: err |
| 33 | + |
| 34 | + interface |
| 35 | + function pass_contiguous_array_c(data, m, n,res) result(error_code) BIND(c) |
| 36 | + import c_int, c_float, c_double, c_ptr |
| 37 | + integer(c_int), VALUE, intent(in) :: m |
| 38 | + integer(c_int), VALUE, intent(in) :: n |
| 39 | + type(c_ptr), VALUE, intent(in) :: data |
| 40 | + type(c_ptr), VALUE, intent(in) :: res |
| 41 | + integer(c_int) :: error_code |
| 42 | + end function pass_contiguous_array_c |
| 43 | + end interface |
| 44 | + |
| 45 | + err = pass_contiguous_array_c(c_loc(arr), m-h, n-h,c_loc(res)) |
| 46 | + end subroutine pass_contiguous_array |
| 47 | +end program |
0 commit comments