From 71d5a94985c9569467c1ef8a62b8b326ee2036a6 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler@nvidia.com>
Date: Thu, 25 May 2023 16:01:52 -0700
Subject: [PATCH] [flang] Don't fold SIZE()/SHAPE() into expression referencing
 optional dummy arguments

When computing the shape of an expression at compilation time as part of
folding an intrinsic function like SIZE(), don't create an expression that
increases a dependence on the presence of an optional dummy argument.

Differential Revision: https://reviews.llvm.org/D151737
---
 flang/lib/Evaluate/shape.cpp       | 16 +++++++++++++---
 flang/test/Evaluate/elem-shape.f90 | 16 ++++++++++++++++
 2 files changed, 29 insertions(+), 3 deletions(-)
 create mode 100644 flang/test/Evaluate/elem-shape.f90

diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index 6f6baae..c7dcb1c 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -805,9 +805,19 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
   if (call.Rank() == 0) {
     return ScalarShape();
   } else if (call.IsElemental()) {
-    for (const auto &arg : call.arguments()) {
-      if (arg && arg->Rank() > 0) {
-        return (*this)(*arg);
+    // Use the shape of an actual array argument associated with a
+    // non-OPTIONAL dummy object argument.
+    if (context_) {
+      if (auto chars{characteristics::Procedure::FromActuals(
+              call.proc(), call.arguments(), *context_)}) {
+        std::size_t j{0};
+        for (const auto &arg : call.arguments()) {
+          if (arg && arg->Rank() > 0 && j < chars->dummyArguments.size() &&
+              !chars->dummyArguments[j].IsOptional()) {
+            return (*this)(*arg);
+          }
+          ++j;
+        }
       }
     }
     return ScalarShape();
diff --git a/flang/test/Evaluate/elem-shape.f90 b/flang/test/Evaluate/elem-shape.f90
new file mode 100644
index 0000000..623c833
--- /dev/null
+++ b/flang/test/Evaluate/elem-shape.f90
@@ -0,0 +1,16 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+! Ensure that optional arguments aren't used to fold SIZE() or SHAPE()
+module m
+ contains
+  subroutine sub(x,y)
+    real :: x(:), y(:)
+    optional x
+    !CHECK: PRINT *, int(size(y,dim=1,kind=8),kind=4)
+    print *, size(f(x,y))
+  end
+  elemental function f(x,y)
+    real, intent(in) :: x, y
+    optional x
+    f = y
+  end
+end
-- 
2.7.4