Skip to content

Commit

Permalink
[flang1] Fix the issue with contiguous dummy argument arrays (flang-c…
Browse files Browse the repository at this point in the history
…ompiler#1426)

When array dummy arguments are marked as contiguous,compiler need to generate
and pass sequential copy of formal arguments.

This issue is fixed as part of this commit.
  • Loading branch information
shivaramaarao authored and pawosm-arm committed Nov 15, 2023
1 parent 2693fba commit 4df6dac
Show file tree
Hide file tree
Showing 5 changed files with 86 additions and 0 deletions.
13 changes: 13 additions & 0 deletions test/f90_correct/inc/cont01.mk
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
# See https://llvm.org/LICENSE.txt for license information.
# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception

build:
@echo ------------------------------------- building test $(TEST)
$(FC) $(FFLAGS) $(SRC)/$(TEST).f90 $(SRC)/c_$(TEST).c $(SRC)/check.c -o $(TEST).$(EXESUFFIX)

run:
@echo ------------------------------------ executing test $(TEST)
./$(TEST).$(EXESUFFIX)

verify: ;
9 changes: 9 additions & 0 deletions test/f90_correct/lit/cont01.sh
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
#
# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
# See https://llvm.org/LICENSE.txt for license information.
# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception

# Shared lit script for each tests. Run bash commands that run tests with make.

# RUN: env KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%/s MAKE_FILE_DIR=%/S/.. bash %/S/runmake | tee %/t
# RUN: cat %t | FileCheck %S/runmake
15 changes: 15 additions & 0 deletions test/f90_correct/src/c_cont01.c
Original file line number Diff line number Diff line change
@@ -0,0 +1,15 @@
/*
* Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
* See https://llvm.org/LICENSE.txt for license information.
* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
*/

int pass_contiguous_array_c(const void *data, int m, int n, int *res) {
const int *data_i = (const int *)data;
for(int i = 0; i < m; i++) {
for(int j = 0; j < n; j++) {
res[i * n + j ] = data_i[i * n + j];
}
}
return 0;
}
47 changes: 47 additions & 0 deletions test/f90_correct/src/cont01.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,47 @@

!** Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
!** See https://llvm.org/LICENSE.txt for license information.
!** SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
!
! testing if contiguous arrays passed as argument are really contiguous

program main
integer, parameter :: m=6,n=4,h=2
integer :: i,j

integer(kind=4), allocatable :: big_array(:, :)
integer(kind=4) :: expected(n-h, m-h)
integer(kind=4) :: res(n-h, m-h)
allocate(big_array(n, m))
do i=1,n
do j=1,m
big_array(i,j) = i
enddo
enddo
expected = big_array(1:n-h,1:m-h)
call pass_contiguous_array(big_array(1:n-h,1:m-h), m, n, h, res)
call check(res,expected,(n-h)*(m-h));

contains
subroutine pass_contiguous_array(arr, m, n, h, res)
use iso_c_binding
implicit none
integer(kind=4), target, contiguous, intent(in) :: arr(:,:)
integer(kind=4), target, intent(inout) :: res(n-h,m-h)
integer, intent(in) :: m, n, h
integer :: err

interface
function pass_contiguous_array_c(data, m, n,res) result(error_code) BIND(c)
import c_int, c_float, c_double, c_ptr
integer(c_int), VALUE, intent(in) :: m
integer(c_int), VALUE, intent(in) :: n
type(c_ptr), VALUE, intent(in) :: data
type(c_ptr), VALUE, intent(in) :: res
integer(c_int) :: error_code
end function pass_contiguous_array_c
end interface

err = pass_contiguous_array_c(c_loc(arr), m-h, n-h,c_loc(res))
end subroutine pass_contiguous_array
end program
2 changes: 2 additions & 0 deletions tools/flang1/flang1exe/rest.c
Original file line number Diff line number Diff line change
Expand Up @@ -2385,6 +2385,8 @@ is_seq_dummy(int entry, int arr, int loc)
dummy_sptr = aux.dpdsc_base[dscptr + loc];
if (SEQG(dummy_sptr))
return TRUE;
if (CONTIGATTRG(dummy_sptr))
return TRUE;
if (ASSUMSHPG(dummy_sptr))
return FALSE;
return TRUE;
Expand Down

0 comments on commit 4df6dac

Please sign in to comment.