Skip to content

Commit

Permalink
[flang1] Fix the issue with contiguous dummy argument arrays (#1426)
Browse files Browse the repository at this point in the history
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.