[flang-commits] [flang] ff567a4 - [flang] Fix folding of RANK(assumed-type assumed-rank) (#101027)

[via flang-commits]

Author: Peter Klausler
Date: 2024-07-30T09:46:26-07:00
New Revision: ff567a4e0457363f1e2e266b09211b709a21899c

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

LOG: [flang] Fix folding of RANK(assumed-type assumed-rank) (#101027)

The code that deals with the special case of RANK(assumed-rank) in
intrinsic function folding wasn't handling the even more special case of
assumed-type assumed-rank dummy arguments.

Added: 
    flang/test/Evaluate/fold-assumed-type-rank.f90

Modified: 
    flang/lib/Evaluate/fold-integer.cpp
    flang/lib/Evaluate/variable.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 39de171dd7a8b..821fa4e5dadfd 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -1212,20 +1212,23 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
           cx->u)};
     }
   } else if (name == "rank") {
-    if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
-      if (auto named{ExtractNamedEntity(*array)}) {
-        const Symbol &symbol{named->GetLastSymbol()};
-        if (IsAssumedRank(symbol)) {
-          // DescriptorInquiry can only be placed in expression of kind
-          // DescriptorInquiry::Result::kind.
-          return ConvertToType<T>(Expr<
-              Type<TypeCategory::Integer, DescriptorInquiry::Result::kind>>{
-              DescriptorInquiry{*named, DescriptorInquiry::Field::Rank}});
-        }
+    if (args[0]) {
+      const Symbol *symbol{nullptr};
+      if (auto dataRef{ExtractDataRef(args[0])}) {
+        symbol = &dataRef->GetLastSymbol();
+      } else {
+        symbol = args[0]->GetAssumedTypeDummy();
+      }
+      if (symbol && IsAssumedRank(*symbol)) {
+        // DescriptorInquiry can only be placed in expression of kind
+        // DescriptorInquiry::Result::kind.
+        return ConvertToType<T>(
+            Expr<Type<TypeCategory::Integer, DescriptorInquiry::Result::kind>>{
+                DescriptorInquiry{
+                    NamedEntity{*symbol}, DescriptorInquiry::Field::Rank}});
       }
-      return Expr<T>{args[0].value().Rank()};
+      return Expr<T>{args[0]->Rank()};
     }
-    return Expr<T>{args[0].value().Rank()};
   } else if (name == "selected_char_kind") {
     if (const auto *chCon{UnwrapExpr<Constant<TypeOf<std::string>>>(args[0])}) {
       if (std::optional<std::string> value{chCon->GetScalarValue()}) {

diff  --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp
index 247386a365de9..b074ae6d811ac 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -250,7 +250,8 @@ DescriptorInquiry::DescriptorInquiry(NamedEntity &&base, Field field, int dim)
   const Symbol &last{base_.GetLastSymbol()};
   CHECK(IsDescriptor(last));
   CHECK((field == Field::Len && dim == 0) ||
-      (field != Field::Len && dim >= 0 && dim < last.Rank()));
+      (field != Field::Len && dim >= 0 &&
+          (dim < last.Rank() || IsAssumedRank(last))));
 }
 
 // LEN()

diff  --git a/flang/test/Evaluate/fold-assumed-type-rank.f90 b/flang/test/Evaluate/fold-assumed-type-rank.f90
new file mode 100644
index 0000000000000..ce296c8e27abf
--- /dev/null
+++ b/flang/test/Evaluate/fold-assumed-type-rank.f90
@@ -0,0 +1,6 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+subroutine sub3(ar_at)
+  type(*) :: ar_at(..)
+!CHECK:  PRINT *, int(int(rank(ar_at),kind=8),kind=4)
+  print *, rank(ar_at)
+end