[flang-commits] [PATCH] D151737: [flang] Don't fold SIZE()/SHAPE() into expression referencing optional dummy arguments

[Peter Klausler via Phabricator via flang-commits]

This revision was automatically updated to reflect the committed changes.
Closed by commit rG71d5a94985c9: [flang] Don't fold SIZE()/SHAPE() into expression referencing optional dummy… (authored by klausler).

Repository:
  rG LLVM Github Monorepo

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

https://reviews.llvm.org/D151737

Files:
  flang/lib/Evaluate/shape.cpp
  flang/test/Evaluate/elem-shape.f90


Index: flang/test/Evaluate/elem-shape.f90
===================================================================
--- /dev/null
+++ 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
Index: flang/lib/Evaluate/shape.cpp
===================================================================
--- flang/lib/Evaluate/shape.cpp
+++ flang/lib/Evaluate/shape.cpp
@@ -805,9 +805,19 @@
   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();


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D151737.527067.patch
Type: text/x-patch
Size: 1566 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230531/ece64e35/attachment-0001.bin>