[flang] Fix for 'wrong constant folding of assumed-rank array' (flang-compiler/f18#1010)

https://github.com/flang-compiler/f18/issues/990

Original-commit: flang-compiler/f18@d971333025
Reviewed-on: https://github.com/flang-compiler/f18/pull/1010

flang/include/flang/Semantics/tools.h

@@ -158,6 +158,10 @@ inline bool IsAssumedSizeArray(const Symbol &symbol) {
   const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
   return details && details->IsAssumedSize();
 }
+inline bool IsAssumedRankArray(const Symbol &symbol) {
+  const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
+  return details && details->IsAssumedRank();
+}
 bool IsAssumedLengthCharacter(const Symbol &);
 bool IsAssumedLengthExternalCharacterFunction(const Symbol &);
 // Is the symbol modifiable in this scope

flang/lib/Evaluate/fold-integer.cpp

@@ -509,7 +509,19 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
           cx->u)};
     }
   } else if (name == "rank") {
-    // TODO assumed-rank dummy argument
+    if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
+      if (auto named{ExtractNamedEntity(*array)}) {
+        const Symbol &symbol{named->GetLastSymbol()};
+        if (semantics::IsAssumedRankArray(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}});
+        }
+      }
+      return Expr<T>{args[0].value().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])}) {

flang/lib/Semantics/expression.cpp

@@ -2502,7 +2502,7 @@ bool ExpressionAnalyzer::EnforceTypeConstraint(parser::CharBlock at,
     const MaybeExpr &result, TypeCategory category, bool defaultKind) {
   if (result) {
     if (auto type{result->GetType()}) {
-      if (type->category() != category) {  // C885
+      if (type->category() != category) { // C885
         Say(at, "Must have %s type, but is %s"_err_en_US,
             ToUpperCase(EnumToString(category)),
             ToUpperCase(type->AsFortran()));

flang/test/Semantics/assign03.f90

@@ -191,5 +191,11 @@ contains
     !ERROR: Must be a constant value
     logical, parameter :: l5 = is_contiguous(y(v,1)%a(1,1))
   end
+  subroutine test3(b)
+    integer, intent(inout) :: b(..)
+    !ERROR: Must be a constant value
+    integer, parameter :: i = rank(b)
+  end subroutine
+
 
 end