[flang] Fold IS_CONTIGUOUS for TYPE(*) when possible

[jeanPerier]

Summary

TYPE(*) arguments fell through in IS_CONTIGUOUS folding
because they are not Expr<SomeType>. Expose entry point for
symbols in IsContiguous and use that.

The added test revealed that IS_CONTIGUOUS was folded to
false for assumed rank arguments. Fix this: the contiguity of
assumed rank without the CONTIGUOUS argument can only be
verified at runtime.

[PeteSteinfeld]

Please make the change to fix the build error.

flang/lib/Evaluate/check-expression.cpp

772–774

I'm seeing compilation errors here because the variable details is not used, and my build has -Werror=unused-variable defined.

I'm using GCC 9.3.0.

If I change line 773 to just check against nullptr, everything builds and tests correctly.

[klausler]

flang/lib/Evaluate/check-expression.cpp

772–774

I suggest recoding as else if (ultimate.has<...>()) {.

[jeanPerier]

Fix warning. Thanks for noticing it and for the suggestion.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Evaluate/check-expression.h

 extern template std::optional<bool> IsContiguous(
     const Substring &, FoldingContext &);
 extern template std::optional<bool> IsContiguous(
     const Component &, FoldingContext &);
 extern template std::optional<bool> IsContiguous(
     const ComplexPart &, FoldingContext &);
 extern template std::optional<bool> IsContiguous(
     const CoarrayRef &, FoldingContext &);
+extern template std::optional<bool> IsContiguous(
+    const Symbol &, FoldingContext &);
 template <typename A>
 bool IsSimplyContiguous(const A &x, FoldingContext &context) {
   return IsContiguous(x, context).value_or(false);
 }
 
 template <typename A> bool IsErrorExpr(const A &);
 extern template bool IsErrorExpr(const Expr<SomeType> &);
 
 std::optional<parser::Message> CheckStatementFunction(
     const Symbol &, const Expr<SomeType> &, FoldingContext &);
 
 } // namespace Fortran::evaluate
 #endif

flang/lib/Evaluate/check-expression.cpp

Result operator()(const semantics::Symbol &symbol) const {
     } else if (ultimate.Rank() == 0) {
       // Extension: accept scalars as a degenerate case of
       // simple contiguity to allow their use in contexts like
       // data targets in pointer assignments with remapping.
       return true;
     } else if (ultimate.has<semantics::AssocEntityDetails>()) {
       return Base::operator()(ultimate); // use expr
     } else if (semantics::IsPointer(ultimate) ||
-        semantics::IsAssumedShape(ultimate)) {
+        semantics::IsAssumedShape(ultimate) || IsAssumedRank(ultimate)) {
       return std::nullopt;
-    } else if (const auto *details{
-                   ultimate.detailsIf<semantics::ObjectEntityDetails>()}) {
-      return !details->IsAssumedRank();
+    } else if (ultimate.has<semantics::ObjectEntityDetails>()) {
+      return true;
     } else {
       return Base::operator()(ultimate);
     }
   }
 
   Result operator()(const ArrayRef &x) const {
     if (x.Rank() == 0) {
       return true; // scalars considered contiguous

 template std::optional<bool> IsContiguous(
     const Expr<SomeType> &, FoldingContext &);
 template std::optional<bool> IsContiguous(const ArrayRef &, FoldingContext &);
 template std::optional<bool> IsContiguous(const Substring &, FoldingContext &);
 template std::optional<bool> IsContiguous(const Component &, FoldingContext &);
 template std::optional<bool> IsContiguous(
     const ComplexPart &, FoldingContext &);
 template std::optional<bool> IsContiguous(const CoarrayRef &, FoldingContext &);
+template std::optional<bool> IsContiguous(const Symbol &, FoldingContext &);
 
 // IsErrorExpr()
 struct IsErrorExprHelper : public AnyTraverse<IsErrorExprHelper, bool> {
   using Result = bool;
   using Base = AnyTraverse<IsErrorExprHelper, Result>;
   IsErrorExprHelper() : Base{*this} {}
   using Base::operator();
 

flang/lib/Evaluate/fold-logical.cpp

if (args[0] && args[0]->UnwrapExpr() &&
           }));
     }
   } else if (name == "is_contiguous") {
     if (args.at(0)) {
       if (auto *expr{args[0]->UnwrapExpr()}) {
         if (auto contiguous{IsContiguous(*expr, context)}) {
           return Expr<T>{*contiguous};
         }
+      } else if (auto *assumedType{args[0]->GetAssumedTypeDummy()}) {
+        if (auto contiguous{IsContiguous(*assumedType, context)}) {
+          return Expr<T>{*contiguous};
+        }
       }
     }
   } else if (name == "lge" || name == "lgt" || name == "lle" || name == "llt") {
     // Rewrite LGE/LGT/LLE/LLT into ASCII character relations
     auto *cx0{UnwrapExpr<Expr<SomeCharacter>>(args[0])};
     auto *cx1{UnwrapExpr<Expr<SomeCharacter>>(args[1])};
     if (cx0 && cx1) {
       return Fold(context,

flang/lib/Semantics/check-declarations.cpp

if (!IsDummy(symbol)) {
             symbol.name());
       }
       if (evaluate::IsCoarray(symbol)) {
         messages_.Say(
             "Assumed-type argument '%s' cannot be a coarray"_err_en_US,
             symbol.name());
       }
       if (details.IsArray() && details.shape().IsExplicitShape()) {
-        messages_.Say(
-            "Assumed-type array argument 'arg8' must be assumed shape,"
+        messages_.Say("Assumed-type array argument '%s' must be assumed shape,"
                       " assumed size, or assumed rank"_err_en_US,
             symbol.name());
       }
     }
   }
 }
 
 void CheckHelper::CheckObjectEntity(
     const Symbol &symbol, const ObjectEntityDetails &details) {

flang/test/Evaluate/rewrite03.f90

+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+! Tests rewrite of IS_CONTIGUOUS with TYPE(*) arguments.
+
+subroutine test_is_contiguous(assumed_size, assumed_shape, &
+      & assumed_shape_contiguous, assumed_rank, assumed_rank_contiguous)
+  type(*) :: assumed_size(*), assumed_shape(:), assumed_shape_contiguous(:)
+  type(*) :: assumed_rank(..), assumed_rank_contiguous(..)
+  contiguous :: assumed_shape_contiguous, assumed_rank_contiguous
+! CHECK: PRINT *, .true._4
+  print *, is_contiguous(assumed_size)
+! CHECK: PRINT *, .true._4
+  print *, is_contiguous(assumed_shape_contiguous)
+! CHECK: PRINT *, .true._4
+  print *, is_contiguous(assumed_rank_contiguous)
+! CHECK: PRINT *, is_contiguous(assumed_shape)
+  print *, is_contiguous(assumed_shape)
+! CHECK: PRINT *, is_contiguous(assumed_rank)
+  print *, is_contiguous(assumed_rank)
+end subroutine