[flang-commits] [flang] 5646d82 - [flang] Add one semantic check for elemental call arguments

[via flang-commits]

Author: Peixin-Qiao
Date: 2022-05-17T15:11:46+08:00
New Revision: 5646d82885f64f1f886d84aff5422697f355f6c4

URL: https://github.com/llvm/llvm-project/commit/5646d82885f64f1f886d84aff5422697f355f6c4
DIFF: https://github.com/llvm/llvm-project/commit/5646d82885f64f1f886d84aff5422697f355f6c4.diff

LOG: [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

Added: 
    

Modified: 
    flang/lib/Semantics/check-call.cpp
    flang/test/Semantics/call02.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index fee716248cbfe..e2725f49547db 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 a4ceaf65d1ed5..db10472f1a4e5 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
+