From 4df6dac6654f5249d7b8328fbaf4bf787c469b57 Mon Sep 17 00:00:00 2001
From: Shivarama Rao <shivarama.rao@amd.com>
Date: Sat, 4 Nov 2023 09:23:03 +0530
Subject: [PATCH] [flang1] Fix the issue with contiguous dummy argument arrays
 (#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.
---
 test/f90_correct/inc/cont01.mk  | 13 +++++++++
 test/f90_correct/lit/cont01.sh  |  9 +++++++
 test/f90_correct/src/c_cont01.c | 15 +++++++++++
 test/f90_correct/src/cont01.f90 | 47 +++++++++++++++++++++++++++++++++
 tools/flang1/flang1exe/rest.c   |  2 ++
 5 files changed, 86 insertions(+)
 create mode 100644 test/f90_correct/inc/cont01.mk
 create mode 100644 test/f90_correct/lit/cont01.sh
 create mode 100644 test/f90_correct/src/c_cont01.c
 create mode 100644 test/f90_correct/src/cont01.f90

diff --git a/test/f90_correct/inc/cont01.mk b/test/f90_correct/inc/cont01.mk
new file mode 100644
index 00000000000..aef99e5824a
--- /dev/null
+++ b/test/f90_correct/inc/cont01.mk
@@ -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: ;
diff --git a/test/f90_correct/lit/cont01.sh b/test/f90_correct/lit/cont01.sh
new file mode 100644
index 00000000000..13668bde209
--- /dev/null
+++ b/test/f90_correct/lit/cont01.sh
@@ -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
diff --git a/test/f90_correct/src/c_cont01.c b/test/f90_correct/src/c_cont01.c
new file mode 100644
index 00000000000..f3a0a35d538
--- /dev/null
+++ b/test/f90_correct/src/c_cont01.c
@@ -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;
+}
diff --git a/test/f90_correct/src/cont01.f90 b/test/f90_correct/src/cont01.f90
new file mode 100644
index 00000000000..ac9b1d37a9e
--- /dev/null
+++ b/test/f90_correct/src/cont01.f90
@@ -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
diff --git a/tools/flang1/flang1exe/rest.c b/tools/flang1/flang1exe/rest.c
index 88ed2c2868f..0b27952f4a9 100644
--- a/tools/flang1/flang1exe/rest.c
+++ b/tools/flang1/flang1exe/rest.c
@@ -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;