[PATCH] D109909: [flang] Enforce array conformance in actual arguments to ELEMENTALs

[Peter Klausler via Phabricator via llvm-commits]

This revision was automatically updated to reflect the committed changes.
Closed by commit rG19afc495dc27: [flang] Enforce array conformance in actual arguments to ELEMENTALs (authored by klausler).
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.

Repository:
  rG LLVM Github Monorepo

CHANGES SINCE LAST ACTION
  https://reviews.llvm.org/D109909/new/

https://reviews.llvm.org/D109909

Files:
  flang/lib/Semantics/check-call.cpp
  flang/test/Semantics/call22.f90


Index: flang/test/Semantics/call22.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/call22.f90
@@ -0,0 +1,18 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Enforce array conformance across actual arguments to ELEMENTAL
+module m
+ contains
+  real elemental function f(a, b)
+    real, intent(in) :: a, b
+    f = a + b
+  end function
+  real function g(n)
+    integer, value :: n
+    g = sqrt(real(n))
+  end function
+  subroutine test
+    real :: a(3) = [1, 2, 3]
+    !ERROR: Dimension 1 of actual argument (a) corresponding to dummy argument #1 ('a') has extent 3, but actual argument ([REAL(4)::(g(int(j,kind=4)),INTEGER(8)::j=1_8,2_8,1_8)]) corresponding to dummy argument #2 ('b') has extent 2
+    print *, f(a, [(g(j), j=1, 2)])
+  end subroutine
+end
Index: flang/lib/Semantics/check-call.cpp
===================================================================
--- flang/lib/Semantics/check-call.cpp
+++ flang/lib/Semantics/check-call.cpp
@@ -722,6 +722,41 @@
   }
 }
 
+// The actual argument arrays 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};
+  for (const auto &arg : actuals) {
+    const auto &dummy{proc.dummyArguments.at(index++)};
+    if (arg) {
+      if (const auto *expr{arg->UnwrapExpr()}) {
+        if (auto argShape{evaluate::GetShape(context, *expr)}) {
+          if (GetRank(*argShape) > 0) {
+            std::string argName{"actual argument ("s + expr->AsFortran() +
+                ") corresponding to dummy argument #" + std::to_string(index) +
+                " ('" + dummy.name + "')"};
+            if (shape) {
+              auto tristate{evaluate::CheckConformance(messages, *shape,
+                  *argShape, evaluate::CheckConformanceFlags::None,
+                  shapeName.c_str(), argName.c_str())};
+              if (tristate && !*tristate) {
+                return false;
+              }
+            } else {
+              shape = std::move(argShape);
+              shapeName = argName;
+            }
+          }
+        }
+      }
+    }
+  }
+  return true;
+}
+
 static parser::Messages CheckExplicitInterface(
     const characteristics::Procedure &proc, evaluate::ActualArguments &actuals,
     const evaluate::FoldingContext &context, const Scope *scope,
@@ -751,6 +786,9 @@
         }
       }
     }
+    if (proc.IsElemental() && !buffer.AnyFatalError()) {
+      CheckElementalConformance(messages, proc, actuals, localContext);
+    }
   }
   return buffer;
 }


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D109909.373101.patch
Type: text/x-patch
Size: 2787 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20210916/83d48abc/attachment.bin>