From 5646d82885f64f1f886d84aff5422697f355f6c4 Mon Sep 17 00:00:00 2001
From: Peixin-Qiao <qiaopeixin@huawei.com>
Date: Tue, 17 May 2022 15:11:46 +0800
Subject: [PATCH] [flang] Add one semantic check for elemental call arguments

As Fortran 2018 15.8.1(3), in a reference to an elemental procedure, if
any argument is an array, each actual argument that corresponds to an
INTENT (OUT) or INTENT (INOUT) dummy argument shall be an array. Add
this semantic check.

Reviewed By: klausler

Differential Revision: https://reviews.llvm.org/D125685
---
 flang/lib/Semantics/check-call.cpp | 18 +++++++++++++++++-
 flang/test/Semantics/call02.f90    | 17 +++++++++++++++++
 2 files changed, 34 insertions(+), 1 deletion(-)

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index fee716248cbf..e2725f49547d 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -812,13 +812,23 @@ static void RearrangeArguments(const characteristics::Procedure &proc,
   }
 }
 
-// The actual argument arrays to an ELEMENTAL procedure must conform.
+// 15.8.1(3) -- In a reference to an elemental procedure, if any argument is an
+// array, each actual argument that corresponds to an INTENT(OUT) or
+// INTENT(INOUT) dummy argument shall be an array. The actual argument to an
+// ELEMENTAL procedure must conform.
 static bool CheckElementalConformance(parser::ContextualMessages &messages,
     const characteristics::Procedure &proc, evaluate::ActualArguments &actuals,
     evaluate::FoldingContext &context) {
   std::optional<evaluate::Shape> shape;
   std::string shapeName;
   int index{0};
+  bool hasArrayArg{false};
+  for (const auto &arg : actuals) {
+    if (arg && arg.value().Rank() > 0) {
+      hasArrayArg = true;
+      break;
+    }
+  }
   for (const auto &arg : actuals) {
     const auto &dummy{proc.dummyArguments.at(index++)};
     if (arg) {
@@ -839,6 +849,12 @@ static bool CheckElementalConformance(parser::ContextualMessages &messages,
               shape = std::move(argShape);
               shapeName = argName;
             }
+          } else if ((dummy.GetIntent() == common::Intent::Out ||
+                         dummy.GetIntent() == common::Intent::InOut) &&
+              hasArrayArg) {
+            messages.Say(
+                "In an elemental procedure with at least one array arugment, actual argument %s that corresponds to an INTENT(OUT) or INTENT(INOUT) dummay argument must be an array"_err_en_US,
+                expr->AsFortran());
           }
         }
       }
diff --git a/flang/test/Semantics/call02.f90 b/flang/test/Semantics/call02.f90
index a4ceaf65d1ed..db10472f1a4e 100644
--- a/flang/test/Semantics/call02.f90
+++ b/flang/test/Semantics/call02.f90
@@ -123,3 +123,20 @@ subroutine p04
   !ERROR: No explicit type declared for 'index'
   call s1(index)
 end
+
+subroutine p05
+  integer :: a1(2), a2, a3
+
+  !ERROR: In an elemental procedure with at least one array arugment, actual argument a2 that corresponds to an INTENT(OUT) or INTENT(INOUT) dummay argument must be an array
+  !ERROR: In an elemental procedure with at least one array arugment, actual argument a3 that corresponds to an INTENT(OUT) or INTENT(INOUT) dummay argument must be an array
+  call s1(a1, a2, a3)
+contains
+  elemental subroutine s1(a, b, c)
+    integer, intent(in) :: a
+    integer, intent(out) :: b
+    integer, intent(inout) :: c
+    b = a
+    c = a
+  end
+end
+