[flang-commits] [flang] [flang] Catch whole assumed-size array passed to elemental (PR #108239)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/108239

A whole assumed-size array is not a valid argument to an elemental procedure (intrinsic or otherwise).

>From 0670fdcdbdd2a46407b3c51dc6bc23d1006efd77 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 11 Sep 2024 08:30:07 -0700
Subject: [PATCH] [flang] Catch whole assumed-size array passed to elemental

A whole assumed-size array is not a valid argument to an elemental
procedure (intrinsic or otherwise).
---
 flang/lib/Semantics/check-call.cpp   |  8 ++++++++
 flang/test/Semantics/elemental02.f90 | 13 +++++++++++++
 2 files changed, 21 insertions(+)
 create mode 100644 flang/test/Semantics/elemental02.f90

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index c7ec8733655648..05f82626f3d52f 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -1363,6 +1363,14 @@ static bool CheckElementalConformance(parser::ContextualMessages &messages,
     const auto &dummy{proc.dummyArguments.at(index++)};
     if (arg) {
       if (const auto *expr{arg->UnwrapExpr()}) {
+        if (const auto *actualLastSymbol{evaluate::GetLastSymbol(arg)}) {
+          actualLastSymbol = &ResolveAssociations(*actualLastSymbol);
+          if (IsAssumedSizeArray(*actualLastSymbol)) {
+            evaluate::SayWithDeclaration(messages, *actualLastSymbol,
+                "Whole assumed-size array '%s' may not be used as an argument to an elemental procedure"_err_en_US,
+                actualLastSymbol->name());
+          }
+        }
         if (auto argShape{evaluate::GetShape(context, *expr)}) {
           if (GetRank(*argShape) > 0) {
             std::string argName{"actual argument ("s + expr->AsFortran() +
diff --git a/flang/test/Semantics/elemental02.f90 b/flang/test/Semantics/elemental02.f90
new file mode 100644
index 00000000000000..7f8fb4a378b7eb
--- /dev/null
+++ b/flang/test/Semantics/elemental02.f90
@@ -0,0 +1,13 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+subroutine s(a)
+  real a(*)
+  interface
+    elemental function ef(efarg)
+      real, intent(in) :: efarg
+    end
+  end interface
+!ERROR: Whole assumed-size array 'a' may not be used as an argument to an elemental procedure
+  print *, sqrt(a)
+!ERROR: Whole assumed-size array 'a' may not be used as an argument to an elemental procedure
+  print *, ef(a)
+end