[flang-commits] [PATCH] D123727: [flang] Fix Symbol::Rank for ProcEntityDetails

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: vdonaldson.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a project: All.
klausler requested review of this revision.

When a procedure pointer or procedure dummy argument has a
defined interface, the rank of the pointer (or dummy) is the
rank of the interface.

Also tweak code discovered in shape analysis when investigating
this problam so that it returns a vector of emptied extents rather
than std::nullopt when the extents are not scope-invariant, so that
the rank can at least be known.


https://reviews.llvm.org/D123727

Files:
  flang/include/flang/Semantics/symbol.h
  flang/lib/Evaluate/shape.cpp
  flang/test/Evaluate/rewrite01.f90


Index: flang/test/Evaluate/rewrite01.f90
===================================================================
--- flang/test/Evaluate/rewrite01.f90
+++ flang/test/Evaluate/rewrite01.f90
@@ -57,6 +57,13 @@
 end subroutine
 
 subroutine shape_test(x, n, m)
+  abstract interface
+    function foo(n)
+      integer, intent(in) :: n
+      real, pointer :: foo(:,:)
+    end function
+  end interface
+  procedure(foo), pointer :: pf
   integer :: x(n, m)
   !CHECK: PRINT *, [INTEGER(4)::int(size(x,dim=1,kind=8),kind=4),int(size(x,dim=2,kind=8),kind=4)]
   print *, shape(x)
@@ -66,6 +73,8 @@
   print *, shape(returns_array_2(m))
   !CHECK: PRINT *, [INTEGER(8)::42_8]
   print *, shape(returns_array_3(), kind=8)
+  !CHECK: PRINT *, 2_4
+  print *, rank(pf(1))
 end subroutine
 
 subroutine lbound_test(x, n, m)
Index: flang/lib/Evaluate/shape.cpp
===================================================================
--- flang/lib/Evaluate/shape.cpp
+++ flang/lib/Evaluate/shape.cpp
@@ -690,9 +690,9 @@
                 // to symbols that belong to the subroutine scope and are
                 // meaningless on the caller side without the related call
                 // expression.
-                for (auto extent : *resultShape) {
-                  if (extent && !IsConstantExpr(*extent)) {
-                    return std::nullopt;
+                for (auto &extent : *resultShape) {
+                  if (extent && !IsActuallyConstant(*extent)) {
+                    extent.reset();
                   }
                 }
               }
Index: flang/include/flang/Semantics/symbol.h
===================================================================
--- flang/include/flang/Semantics/symbol.h
+++ flang/include/flang/Semantics/symbol.h
@@ -639,6 +639,10 @@
             [](const UseDetails &x) { return x.symbol().Rank(); },
             [](const HostAssocDetails &x) { return x.symbol().Rank(); },
             [](const ObjectEntityDetails &oed) { return oed.shape().Rank(); },
+            [](const ProcEntityDetails &ped) {
+              const Symbol *iface{ped.interface().symbol()};
+              return iface ? iface->Rank() : 0;
+            },
             [](const AssocEntityDetails &aed) {
               if (const auto &expr{aed.expr()}) {
                 if (auto assocRank{aed.rank()}) {


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D123727.422628.patch
Type: text/x-patch
Size: 2321 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20220413/f97001c6/attachment.bin>