[flang-commits] [flang] [flang] Allow assumed-shape element pass to dummy arg with ignore_tkr (PR #78196)

[Tom Eccles via flang-commits]

https://github.com/tblah created https://github.com/llvm/llvm-project/pull/78196

This is allowed by gfortran and ifort with `![GCC|DEC]$ ATTRIBUTES NO_ARG_CHECK`

>From ee28f45482b1478eff70b2a2e3149d1ea6e75145 Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Mon, 15 Jan 2024 17:47:27 +0000
Subject: [PATCH] [flang] Allow assumed-shape element pass to dummy arg with
 ignore_tkr

This is allowed by gfortran and ifort with
![GCC|DEC]$ ATTRIBUTES NO_ARG_CHECK

I'm not sure if 'r' is the right specifier for this, maybe there should
be a new one?
---
 flang/lib/Semantics/check-call.cpp    |  3 ++-
 flang/test/Semantics/ignore_tkr03.f90 | 18 ++++++++++++++++++
 2 files changed, 20 insertions(+), 1 deletion(-)
 create mode 100644 flang/test/Semantics/ignore_tkr03.f90

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index ec8f99ca6bf48e..ba8903089f836d 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -535,7 +535,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
             messages.Say(
                 "Element of pointer array may not be associated with a %s array"_err_en_US,
                 dummyName);
-          } else if (IsAssumedShape(*actualLastSymbol)) {
+          } else if (IsAssumedShape(*actualLastSymbol) &&
+              !dummy.ignoreTKR.test(common::IgnoreTKR::Rank)) {
             basicError = true;
             messages.Say(
                 "Element of assumed-shape array may not be associated with a %s array"_err_en_US,
diff --git a/flang/test/Semantics/ignore_tkr03.f90 b/flang/test/Semantics/ignore_tkr03.f90
new file mode 100644
index 00000000000000..25182d879e1097
--- /dev/null
+++ b/flang/test/Semantics/ignore_tkr03.f90
@@ -0,0 +1,18 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+module library
+contains
+  subroutine lib_sub(buf)
+!dir$ ignore_tkr(r) buf
+    real :: buf(1:*)
+  end subroutine
+end module
+
+module user
+  use library
+contains
+  subroutine sub(var)
+    real :: var(:,:,:)
+! CHECK: CALL lib_sub
+    call lib_sub(var(1, 2, 3))
+  end subroutine
+end module