[flang] Semantic checks for SELECT RANK

[sameeranjoshi]

Summary

Added SELECT RANK implementation.
Previous review- https://github.com/flang-compiler/f18/pull/895

[DavidTruby]

LGTM but I'm not an expert on this code so wait for approval from someone else

flang/lib/Semantics/resolve-names.cpp

5111

Why does this need de-referencing and then referencing again?

[tskeith]

flang/include/flang/Semantics/symbol.h

149

I think rank and rank_ are better names than associationRank and associationRank_.
You know it's the rank of an association because it is in an AssocEntityDetails, and that would be consistent with set_rank.

flang/lib/Evaluate/shape.cpp

461

Can you extract all of the copies of this code into a single function?

flang/lib/Semantics/check-select-rank.cpp

70

You could show where the previous DEFAULT is.

79

Same here.

116

I think GetExpr is a better name for this function. Nothing is being resolved.

124

You should be able to write this as:
std::visit([](const auto &x) { return GetExpr(x); }, selector.u);

Or maybe change GetExpr to operate on any union class as it does on wrapper classes.

flang/lib/Semantics/resolve-names.cpp

5147

Why do you need this Walk? Didn't it just get visited?

flang/lib/Semantics/symbol.cpp

290

I don't think this belongs in Symbol. It is only called in one place and it's not consistent with GetRank. You can get the rank of all kinds of symbols but you can set it on only one particular kind.

292

Details should be details.
Even better, use get<AssocEntityDetails>() and the check will be done automatically.

flang/test/Semantics/select-rank.f90

76

"default" -> "DEFAULT"

93

This message could say what the bad value is. If it's an expression it may not be obvious.

[sameeranjoshi]

Review comments addressed.

[tskeith]

Please mark comments as done when you have done something in response, and indicate what you did if it's not obvious.

flang/include/flang/Evaluate/shape.h

131

How about CreateShape?

flang/lib/Semantics/check-select-rank.cpp

114

Can you print *val instead of fetching and formatting expr?

[sameeranjoshi]

In D78623#2022508, @sameeranjoshi wrote:

Review comments addressed.

@peterklauslar @timkeith is there still anything which needs to be addressed to merge this PR?

flang/lib/Semantics/check-select-rank.cpp

114

Updated revision using *val.
The kind value vanishes when using *val. Only the rank value would be displayed.

116

Two same names were causing confusion, hence added a different name GetExprFromSelector.

[sameeranjoshi]

@tskeith
Is that a green signal so that I can commit it, or do I still need to wait for some more reviewers to comment and accept?
Is @klausler ok with it?

[klausler]

In D78623#2025582, @sameeranjoshi wrote:

@tskeith
Is that a green signal so that I can commit it, or do I still need to wait for some more reviewers to comment and accept?
Is @klausler ok with it?

It's approved, you can commit it. I'll clean it up here.

[klausler]

flang/lib/Semantics/resolve-names.cpp

5111

Because it's not a pointer.

[DavidTruby]

flang/lib/Semantics/resolve-names.cpp

5111

No.. and neither is the thing it is being assigned to? I don't understand how it not being a pointer is relevant.

[klausler]

flang/lib/Semantics/resolve-names.cpp

5111

name is a reference to a std::optional<parser::Name>.

*name is a reference to a parser::Name.

&*name is an rvalue pointer to a parser::Name.

association.name is an lvalue whose type is pointer to a const parser::Name.

association.name = &*name; assigns a pointer rvalue to a pointer lvalue.

[sameeranjoshi]

Closed by https://reviews.llvm.org/rG332e6aea37a2777c06eb7d0960edf33b5869b0de

flang/include/flang/Evaluate/shape.h

if (operation.right().Rank() > 0) {
       return (*this)(operation.right());
     } else {
       return (*this)(operation.left());
     }
   }
 
 private:
   static Result Scalar() { return Shape{}; }
-
+  Shape ReturnShape(int rank, NamedEntity &base) const {
+    Shape shape;
+    for (int dimension{0}; dimension < rank; ++dimension) {
+      shape.emplace_back(GetExtent(context_, base, dimension));
+    }
+    return shape;
+  }
   template <typename T>
   MaybeExtentExpr GetArrayConstructorValueExtent(
       const ArrayConstructorValue<T> &value) const {
     return std::visit(
         common::visitors{
             [&](const Expr<T> &x) -> MaybeExtentExpr {
               if (std::optional<Shape> xShape{GetShape(context_, x)}) {
                 // Array values in array constructors get linearized.

flang/include/flang/Semantics/symbol.h

 public:
   AssocEntityDetails() {}
   explicit AssocEntityDetails(SomeExpr &&expr) : expr_{std::move(expr)} {}
   AssocEntityDetails(const AssocEntityDetails &) = default;
   AssocEntityDetails(AssocEntityDetails &&) = default;
   AssocEntityDetails &operator=(const AssocEntityDetails &) = default;
   AssocEntityDetails &operator=(AssocEntityDetails &&) = default;
   const MaybeExpr &expr() const { return expr_; }
+  void set_rank(int rank);
+  std::optional<int> rank() const { return rank_; }
 
 private:
   MaybeExpr expr_;
+  std::optional<int> rank_;
 };
 
 // An entity known to be an object.
 class ObjectEntityDetails : public EntityDetails {
 public:
   explicit ObjectEntityDetails(EntityDetails &&);
   ObjectEntityDetails(const ObjectEntityDetails &) = default;
   ObjectEntityDetails &operator=(const ObjectEntityDetails &) = default;
private:
   MaybeExpr bindName_;
 };
 
 class FinalProcDetails {}; // TODO
 
 class MiscDetails {
 public:
   ENUM_CLASS(Kind, None, ConstructName, ScopeName, PassName, ComplexPartRe,
-      ComplexPartIm, KindParamInquiry, LenParamInquiry, SelectTypeAssociateName,
-      TypeBoundDefinedOp);
+      ComplexPartIm, KindParamInquiry, LenParamInquiry, SelectRankAssociateName,
+      SelectTypeAssociateName, TypeBoundDefinedOp);
   MiscDetails(Kind kind) : kind_{kind} {}
   Kind kind() const { return kind_; }
 
 private:
   Kind kind_;
 };
 
 class TypeParamDetails {
return std::visit(
             [](const UseDetails &x) { return x.symbol().GetType(); },
             [](const HostAssocDetails &x) { return x.symbol().GetType(); },
             [](const auto &) -> const DeclTypeSpec * { return nullptr; },
         },
         details_);
   }
 
   void SetType(const DeclTypeSpec &);
-
   bool IsDummy() const;
   bool IsFuncResult() const;
   bool IsObjectArray() const;
   bool IsSubprogram() const;
   bool IsFromModFile() const;
   bool HasExplicitInterface() const {
     return std::visit(common::visitors{
                           [](const SubprogramDetails &) { return true; },
return std::visit(
               return 0; /*TODO*/
             },
             [](const ProcBindingDetails &x) { return x.symbol().Rank(); },
             [](const UseDetails &x) { return x.symbol().Rank(); },
             [](const HostAssocDetails &x) { return x.symbol().Rank(); },
             [](const ObjectEntityDetails &oed) { return oed.shape().Rank(); },
             [](const AssocEntityDetails &aed) {
               if (const auto &expr{aed.expr()}) {
+                if (auto assocRank{aed.rank()}) {
+                  return *assocRank;
+                } else {
                   return expr->Rank();
+                }
               } else {
                 return 0;
               }
             },
             [](const auto &) { return 0; },
         },
         details_);
   }

flang/lib/Evaluate/shape.cpp

 
 auto GetShapeHelper::operator()(const Symbol &symbol) const -> Result {
   return std::visit(
       common::visitors{
           [&](const semantics::ObjectEntityDetails &object) {
             if (IsImpliedShape(symbol)) {
               return (*this)(object.init());
             } else {
-              Shape shape;
               int n{object.shape().Rank()};
               NamedEntity base{symbol};
-              for (int dimension{0}; dimension < n; ++dimension) {
-                shape.emplace_back(GetExtent(context_, base, dimension));
-              }
-              return Result{shape};
+              return Result{ReturnShape(n, base)};
             }
           },
           [](const semantics::EntityDetails &) {
             return Scalar(); // no dimensions seen
           },
           [&](const semantics::ProcEntityDetails &proc) {
             if (const Symbol * interface{proc.interface().symbol()}) {
               return (*this)(*interface);
             } else {
               return Scalar();
             }
           },
           [&](const semantics::AssocEntityDetails &assoc) {
+            if (!assoc.rank()) {
               return (*this)(assoc.expr());
+            } else {
+              int n{assoc.rank().value()};
+              NamedEntity base{symbol};
+              return Result{ReturnShape(n, base)};
+            }
           },
           [&](const semantics::SubprogramDetails &subp) {
             if (subp.isFunction()) {
               return (*this)(subp.result());
             } else {
               return Result{};
             }
           },

 }
 
 auto GetShapeHelper::operator()(const Component &component) const -> Result {
   const Symbol &symbol{component.GetLastSymbol()};
   int rank{symbol.Rank()};
   if (rank == 0) {
     return (*this)(component.base());
   } else if (symbol.has<semantics::ObjectEntityDetails>()) {
-    Shape shape;
     NamedEntity base{Component{component}};
-    for (int dimension{0}; dimension < rank; ++dimension) {
-      shape.emplace_back(GetExtent(context_, base, dimension));
-    }
-    return shape;
+    return ReturnShape(rank, base);
+  } else if (symbol.has<semantics::AssocEntityDetails>()) {
+    NamedEntity base{Component{component}};
+    return Result{ReturnShape(rank, base)};
   } else {
     return (*this)(symbol);
   }
 }
 
 auto GetShapeHelper::operator()(const ArrayRef &arrayRef) const -> Result {
   Shape shape;
   int dimension{0};
   const NamedEntity &base{arrayRef.base()};
   for (const Subscript &ss : arrayRef.subscript()) {
     if (ss.Rank() > 0) {
       shape.emplace_back(GetExtent(context_, ss, base, dimension));

flang/lib/Semantics/CMakeLists.txt

add_flang_library(FortranSemantics
   check-do-forall.cpp
   check-if-stmt.cpp
   check-io.cpp
   check-namelist.cpp
   check-nullify.cpp
   check-omp-structure.cpp
   check-purity.cpp
   check-return.cpp
+  check-select-rank.cpp
   check-stop.cpp
   expression.cpp
   mod-file.cpp
   pointer-assignment.cpp
   program-tree.cpp
   resolve-labels.cpp
   resolve-names.cpp
   resolve-names-utils.cpp

flang/lib/Semantics/check-select-rank.h

+//===-- lib/Semantics/check-select-rank.h -----------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_SEMANTICS_CHECK_SELECT_STMT_H_
+#define FORTRAN_SEMANTICS_CHECK_SELECT_STMT_H_
+
+#include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/semantics.h"
+
+namespace Fortran::semantics {
+class SelectRankConstructChecker : public virtual BaseChecker {
+public:
+  SelectRankConstructChecker(SemanticsContext &context) : context_{context} {}
+  void Leave(const parser::SelectRankConstruct &);
+
+private:
+  const SomeExpr *GetExprFromSelector(const parser::Selector &);
+  SemanticsContext &context_;
+};
+} // namespace Fortran::semantics
+#endif // FORTRAN_SEMANTICS_CHECK_SELECT_STMT_H_

flang/lib/Semantics/check-select-rank.cpp

+//===-- lib/Semantics/check-select-rank.cpp -------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "check-select-rank.h"
+#include "flang/Common/Fortran.h"
+#include "flang/Common/idioms.h"
+#include "flang/Parser/message.h"
+#include "flang/Parser/tools.h"
+#include "flang/Semantics/tools.h"
+#include <list>
+#include <optional>
+#include <set>
+#include <tuple>
+#include <variant>
+
+namespace Fortran::semantics {
+
+void SelectRankConstructChecker::Leave(
+    const parser::SelectRankConstruct &selectRankConstruct) {
+  const auto &selectRankStmt{
+      std::get<parser::Statement<parser::SelectRankStmt>>(
+          selectRankConstruct.t)};
+  const auto &selectRankStmtSel{
+      std::get<parser::Selector>(selectRankStmt.statement.t)};
+
+  // R1149 select-rank-stmt checks
+  const Symbol *saveSelSymbol{nullptr};
+  if (const auto selExpr{GetExprFromSelector(selectRankStmtSel)}) {
+    if (const Symbol * sel{evaluate::UnwrapWholeSymbolDataRef(*selExpr)}) {
+      if (!IsAssumedRankArray(*sel)) { // C1150
+        context_.Say(parser::FindSourceLocation(selectRankStmtSel),
+            "Selector '%s' is not an assumed-rank array variable"_err_en_US,
+            sel->name().ToString());
+      } else {
+        saveSelSymbol = sel;
+      }
+    } else {
+      context_.Say(parser::FindSourceLocation(selectRankStmtSel),
+          "Selector '%s' is not an assumed-rank array variable"_err_en_US,
+          parser::FindSourceLocation(selectRankStmtSel).ToString());
+    }
+  }
+
+  // R1150 select-rank-case-stmt checks
+  auto &rankCaseList{std::get<std::list<parser::SelectRankConstruct::RankCase>>(
+      selectRankConstruct.t)};
+  bool defaultRankFound{false};
+  bool starRankFound{false};
+  parser::CharBlock prevLocDefault;
+  parser::CharBlock prevLocStar;
+  std::optional<parser::CharBlock> caseForRank[common::maxRank + 1];
+
+  for (const auto &rankCase : rankCaseList) {
+    const auto &rankCaseStmt{
+        std::get<parser::Statement<parser::SelectRankCaseStmt>>(rankCase.t)};
+    const auto &rank{
+        std::get<parser::SelectRankCaseStmt::Rank>(rankCaseStmt.statement.t)};
+    std::visit(
+        common::visitors{
+            [&](const parser::Default &) { // C1153
+              if (!defaultRankFound) {
+                defaultRankFound = true;
+                prevLocDefault = rankCaseStmt.source;
+              } else {
+                context_
+                    .Say(rankCaseStmt.source,
+                        "Not more than one of the selectors of SELECT RANK "
+                        "statement may be DEFAULT"_err_en_US)
+                    .Attach(prevLocDefault, "Previous use"_err_en_US);
+              }
+            },
+            [&](const parser::Star &) { // C1153
+              if (!starRankFound) {
+                starRankFound = true;
+                prevLocStar = rankCaseStmt.source;
+              } else {
+                context_
+                    .Say(rankCaseStmt.source,
+                        "Not more than one of the selectors of SELECT RANK "
+                        "statement may be '*'"_err_en_US)
+                    .Attach(prevLocStar, "Previous use"_err_en_US);
+              }
+              if (saveSelSymbol &&
+                  IsAllocatableOrPointer(*saveSelSymbol)) { // C1155
+                context_.Say(parser::FindSourceLocation(selectRankStmtSel),
+                    "RANK (*) cannot be used when selector is "
+                    "POINTER or ALLOCATABLE"_err_en_US);
+              }
+            },
+            [&](const parser::ScalarIntConstantExpr &init) {
+              if (auto val{GetIntValue(init)}) {
+                // If value is in valid range, then only show
+                // value repeat error, else stack smashing occurs
+                if (*val < 0 || *val > common::maxRank) { // C1151
+                  context_.Say(rankCaseStmt.source,
+                      "The value of the selector must be "
+                      "between zero and %d"_err_en_US,
+                      common::maxRank);
+
+                } else {
+                  if (!caseForRank[*val].has_value()) {
+                    caseForRank[*val] = rankCaseStmt.source;
+                  } else {
+                    auto prevloc{caseForRank[*val].value()};
+                    const auto *expr{GetExpr(init)};
+                    context_
+                        .Say(rankCaseStmt.source,
+                            "Same rank value (%s) not allowed more than once"_err_en_US,
+                            expr->AsFortran())
+                        .Attach(prevloc, "Previous use"_err_en_US);
+                  }
+                }
+              }
+            },
+        },
+        rank.u);
+  }
+}
+
+const SomeExpr *SelectRankConstructChecker::GetExprFromSelector(
+    const parser::Selector &selector) {
+  return std::visit([](const auto &x) { return GetExpr(x); }, selector.u);
+}
+
+} // namespace Fortran::semantics

flang/lib/Semantics/resolve-names.cpp

public:
   void Post(const parser::ForallStmt &);
   bool Pre(const parser::BlockStmt &);
   bool Pre(const parser::EndBlockStmt &);
   void Post(const parser::Selector &);
   bool Pre(const parser::AssociateStmt &);
   void Post(const parser::EndAssociateStmt &);
   void Post(const parser::Association &);
   void Post(const parser::SelectTypeStmt &);
+  void Post(const parser::SelectRankStmt &);
   bool Pre(const parser::SelectTypeConstruct &);
   void Post(const parser::SelectTypeConstruct &);
   bool Pre(const parser::SelectTypeConstruct::TypeCase &);
   void Post(const parser::SelectTypeConstruct::TypeCase &);
+  // Creates Block scopes with neither symbol name nor symbol details.
+  bool Pre(const parser::SelectRankConstruct::RankCase &);
+  void Post(const parser::SelectRankConstruct::RankCase &);
   void Post(const parser::TypeGuardStmt::Guard &);
+  void Post(const parser::SelectRankCaseStmt::Rank &);
   bool Pre(const parser::ChangeTeamStmt &);
   void Post(const parser::EndChangeTeamStmt &);
   void Post(const parser::CoarrayAssociation &);
 
   // Definitions of construct names
   bool Pre(const parser::WhereConstructStmt &x) { return CheckDef(x.t); }
   bool Pre(const parser::ForallConstructStmt &x) { return CheckDef(x.t); }
   bool Pre(const parser::CriticalStmt &x) { return CheckDef(x.t); }
if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) {
     } else {
       Say(association.selector.source, // C1157
           "Selector is not a named variable: 'associate-name =>' is required"_err_en_US);
       association = {};
     }
   }
 }
 
+void ConstructVisitor::Post(const parser::SelectRankStmt &x) {
+  auto &association{GetCurrentAssociation()};
+  if (const std::optional<parser::Name> &name{std::get<1>(x.t)}) {
+    // This isn't a name in the current scope, it is in each SelectRankCaseStmt
+    MakePlaceholder(*name, MiscDetails::Kind::SelectRankAssociateName);
+    association.name = &*name;
+  }
+}
+
 bool ConstructVisitor::Pre(const parser::SelectTypeConstruct::TypeCase &) {
   PushScope(Scope::Kind::Block, nullptr);
   return true;
 }
 void ConstructVisitor::Post(const parser::SelectTypeConstruct::TypeCase &) {
   PopScope();
 }
 
+bool ConstructVisitor::Pre(const parser::SelectRankConstruct::RankCase &) {
+  PushScope(Scope::Kind::Block, nullptr);
+  return true;
+}
+void ConstructVisitor::Post(const parser::SelectRankConstruct::RankCase &) {
+  PopScope();
+}
+
 void ConstructVisitor::Post(const parser::TypeGuardStmt::Guard &x) {
   if (auto *symbol{MakeAssocEntity()}) {
     if (std::holds_alternative<parser::Default>(x.u)) {
       SetTypeFromAssociation(*symbol);
     } else if (const auto *type{GetDeclTypeSpec()}) {
       symbol->SetType(*type);
     }
     SetAttrsFromAssociation(*symbol);
   }
 }
 
+void ConstructVisitor::Post(const parser::SelectRankCaseStmt::Rank &x) {
+  if (auto *symbol{MakeAssocEntity()}) {
+    SetTypeFromAssociation(*symbol);
+    SetAttrsFromAssociation(*symbol);
+    if (const auto *init{std::get_if<parser::ScalarIntConstantExpr>(&x.u)}) {
+      MaybeIntExpr expr{EvaluateIntExpr(*init)};
+      if (auto val{evaluate::ToInt64(expr)}) {
+        auto &details{symbol->get<AssocEntityDetails>()};
+        details.set_rank(*val);
+      }
+    }
+  }
+}
+
 bool ConstructVisitor::Pre(const parser::SelectRankConstruct &) {
   PushAssociation();
   return true;
 }
 
 void ConstructVisitor::Post(const parser::SelectRankConstruct &) {
   PopAssociation();
 }

flang/lib/Semantics/semantics.cpp

 #include "check-do-forall.h"
 #include "check-if-stmt.h"
 #include "check-io.h"
 #include "check-namelist.h"
 #include "check-nullify.h"
 #include "check-omp-structure.h"
 #include "check-purity.h"
 #include "check-return.h"
+#include "check-select-rank.h"
 #include "check-stop.h"
 #include "mod-file.h"
 #include "resolve-labels.h"
 #include "resolve-names.h"
 #include "rewrite-parse-tree.h"
 #include "flang/Common/default-kinds.h"
 #include "flang/Parser/parse-tree-visitor.h"
 #include "flang/Parser/tools.h"
private:
   SemanticsContext &context_;
 };
 
 using StatementSemanticsPass1 = ExprChecker;
 using StatementSemanticsPass2 = SemanticsVisitor<AllocateChecker,
     ArithmeticIfStmtChecker, AssignmentChecker, CaseChecker, CoarrayChecker,
     DataChecker, DeallocateChecker, DoForallChecker, IfStmtChecker, IoChecker,
     MiscChecker, NamelistChecker, NullifyChecker, OmpStructureChecker,
-    PurityChecker, ReturnStmtChecker, StopChecker>;
+    PurityChecker, ReturnStmtChecker, SelectRankConstructChecker, StopChecker>;
 
 static bool PerformStatementSemantics(
     SemanticsContext &context, parser::Program &program) {
   ResolveNames(context, program);
   RewriteParseTree(context, program);
   CheckDeclarations(context);
   StatementSemanticsPass1{context}.Walk(program);
   StatementSemanticsPass2{context}.Walk(program);

flang/lib/Semantics/symbol.cpp

llvm::raw_ostream &operator<<(
   return os;
 }
 
 void EntityDetails::set_type(const DeclTypeSpec &type) {
   CHECK(!type_);
   type_ = &type;
 }
 
+void AssocEntityDetails::set_rank(int rank) { rank_ = rank; }
 void EntityDetails::ReplaceType(const DeclTypeSpec &type) { type_ = &type; }
 
 void ObjectEntityDetails::set_shape(const ArraySpec &shape) {
   CHECK(shape_.empty());
   for (const auto &shapeSpec : shape) {
     shape_.push_back(shapeSpec);
   }
 }
std::visit(common::visitors{
                  [&](AssocEntityDetails &x) { x.set_type(type); },
                  [&](ProcEntityDetails &x) { x.interface().set_type(type); },
                  [&](TypeParamDetails &x) { x.set_type(type); },
                  [](auto &) {},
              },
       details_);
 }
 
 bool Symbol::IsDummy() const {
   return std::visit(
       common::visitors{[](const EntityDetails &x) { return x.isDummy(); },
           [](const ObjectEntityDetails &x) { return x.isDummy(); },
           [](const ProcEntityDetails &x) { return x.isDummy(); },
           [](const HostAssocDetails &x) { return x.symbol().IsDummy(); },
           [](const auto &) { return false; }},
       details_);
 }
 
 bool Symbol::IsFuncResult() const {
llvm::raw_ostream &operator<<(
   DumpList(os, "coshape", x.coshape());
   DumpExpr(os, "init", x.init_);
   return os;
 }
 
 llvm::raw_ostream &operator<<(
     llvm::raw_ostream &os, const AssocEntityDetails &x) {
   os << *static_cast<const EntityDetails *>(&x);
+  if (auto assocRank{x.rank()}) {
+    os << " rank: " << *assocRank;
+  }
   DumpExpr(os, "expr", x.expr());
   return os;
 }
 
 llvm::raw_ostream &operator<<(
     llvm::raw_ostream &os, const ProcEntityDetails &x) {
   if (auto *symbol{x.interface_.symbol()}) {
     os << ' ' << symbol->name();

flang/test/Semantics/select-rank.f90

+! RUN: %B/test/Semantics/test_errors.sh %s %flang %t
+!Tests for SELECT RANK Construct(R1148)
+program select_rank
+   implicit none
+   integer, dimension(10:30, 10:20, -1:20) :: x
+   integer, parameter :: y(*) = [1,2,3,4]
+   integer, dimension(5) :: z
+   integer, allocatable :: a(:)
+
+   allocate(a(10:20))
+
+   call CALL_SHAPE(x)
+   call CALL_SHAPE(y)
+   call CALL_SHAPE(z)
+   call CALL_SHAPE(a)
+
+contains
+   !No error expected
+   subroutine CALL_ME(x)
+    implicit none
+    integer :: x(..)
+    SELECT RANK(x)
+    RANK (0)
+      print *, "PRINT RANK 0"
+    RANK (1)
+      print *, "PRINT RANK 1"
+    END SELECT
+   end
+
+   subroutine CALL_ME9(x)
+    implicit none
+    integer :: x(..),j
+    boo: SELECT RANK(x)
+    RANK (1+0)
+      print *, "PRINT RANK 1"
+      j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == (1+0)))
+    END SELECT boo
+   end subroutine
+
+   !Error expected
+   subroutine CALL_ME2(x)
+    implicit none
+    integer :: x(..)
+    integer :: y(3),j
+    !ERROR: Selector 'y' is not an assumed-rank array variable
+    SELECT RANK(y)
+    RANK (0)
+      print *, "PRINT RANK 0"
+    RANK (1)
+      print *, "PRINT RANK 1"
+     END SELECT
+
+    SELECT RANK(x)
+    RANK(0)
+      j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 0)) ! will fail when RANK(x) is not zero here
+    END SELECT
+   end subroutine
+
+   subroutine CALL_ME3(x)
+    implicit none
+    integer :: x(..),j
+    SELECT RANK(x)
+    !ERROR: The value of the selector must be between zero and 15
+    RANK (16)
+      j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 16))
+    END SELECT
+   end subroutine
+
+   subroutine CALL_ME4(x)
+    implicit none
+    integer :: x(..)
+    SELECT RANK(x)
+    RANK DEFAULT
+      print *, "ok "
+    !ERROR: Not more than one of the selectors of SELECT RANK statement may be DEFAULT
+    RANK DEFAULT
+      print *, "not ok"
+    RANK (3)
+      print *, "IT'S 3"
+    END SELECT
+   end subroutine
+
+   subroutine CALL_ME5(x)
+    implicit none
+    integer :: x(..),j
+    SELECT RANK(x)
+    RANK (0)
+      print *, "PRINT RANK 0"
+      j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 0))
+    RANK(1)
+      print *, "PRINT RANK 1"
+    !ERROR: Same rank value (0_4) not allowed more than once
+    RANK(0)
+      print *, "ERROR"
+      j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 0))
+    RANK(1+1)
+    !ERROR: Same rank value (2_4) not allowed more than once
+    RANK(1+1)
+    END SELECT
+   end subroutine
+
+   subroutine CALL_ME6(x)
+    implicit none
+    integer :: x(..),j
+    SELECT RANK(x)
+    RANK (3)
+      print *, "one"
+      j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 3))
+    !ERROR: The value of the selector must be between zero and 15
+    RANK(-1)
+      print *, "rank: -ve"
+      j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == -1))
+    END SELECT
+   end subroutine
+
+   subroutine CALL_ME7(arg)
+   implicit none
+   integer :: i,j
+   integer, dimension(..), pointer :: arg
+   integer, pointer :: arg2
+   !ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE
+   select RANK(arg)
+   RANK (*)
+      print *, arg(1:1)
+   RANK (1)
+      print *, arg
+      j = INT(0, KIND=MERGE(KIND(0), -1, RANK(arg) == 1))
+   end select
+
+   !ERROR: Selector 'arg2' is not an assumed-rank array variable
+   select RANK(arg2)
+   RANK (*)
+      print *,"This would lead to crash when saveSelSymbol has std::nullptr"
+   RANK (1)
+      print *, "Rank is 1"
+   end select
+
+   end subroutine
+
+   subroutine CALL_ME8(x)
+    implicit none
+    integer :: x(..),j
+    SELECT RANK(x)
+    Rank(2)
+      print *, "Now it's rank 2 "
+    RANK (*)
+      print *, "Going for a other rank"
+      j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 1))
+    !ERROR: Not more than one of the selectors of SELECT RANK statement may be '*'
+    RANK (*)
+      print *, "This is Wrong"
+      j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 1))
+    END SELECT
+   end subroutine
+
+   subroutine CALL_ME10(x)
+    implicit none
+    integer:: x(..), a=10,b=20,j
+    integer, dimension(10) :: arr = (/1,2,3,4,5/),brr
+    integer :: const_variable=10
+    integer, pointer :: ptr,nullptr=>NULL()
+    type derived
+         character(len = 50) :: title
+    end type derived
+    type(derived) :: obj1
+
+    SELECT RANK(x)
+    Rank(2)
+      print *, "Now it's rank 2 "
+    RANK (*)
+      print *, "Going for a other rank"
+    !ERROR: Not more than one of the selectors of SELECT RANK statement may be '*'
+    RANK (*)
+      print *, "This is Wrong"
+    END SELECT
+
+    !ERROR: Selector 'brr' is not an assumed-rank array variable
+    SELECT RANK(ptr=>brr)
+    !ERROR: Must be a constant value
+    RANK(const_variable)
+      print *, "PRINT RANK 3"
+      !j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 1))
+    !ERROR: Must be a constant value
+    RANK(nullptr)
+      print *, "PRINT RANK 3"
+    END SELECT
+
+    !ERROR: Selector 'x(1) + x(2)' is not an assumed-rank array variable
+    SELECT RANK (x(1) + x(2))
+
+    END SELECT
+
+    !ERROR: Selector 'x(1)' is not an assumed-rank array variable
+    SELECT RANK(x(1))
+
+    END SELECT
+
+    !ERROR: Selector 'x(1:2)' is not an assumed-rank array variable
+    SELECT RANK(x(1:2))
+
+    END SELECT
+
+    !ERROR: 'x' is not an object of derived type
+    SELECT RANK(x(1)%x(2))
+
+    END SELECT
+
+    !ERROR: Selector 'obj1%title' is not an assumed-rank array variable
+    SELECT RANK(obj1%title)
+
+    END SELECT
+
+    !ERROR: Selector 'arr(1:3)+ arr(4:5)' is not an assumed-rank array variable
+    SELECT RANK(arr(1:3)+ arr(4:5))
+
+    END SELECT
+
+    SELECT RANK(ptr=>x)
+    RANK (3)
+      PRINT *, "PRINT RANK 3"
+      j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 0))
+    RANK (1)
+      PRINT *, "PRINT RANK 1"
+      j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 1))
+    END SELECT
+   end subroutine
+   subroutine CALL_ME_TYPES(x)
+    implicit none
+    integer :: x(..),j
+    SELECT RANK(x)
+    !ERROR: Must have INTEGER type, but is LOGICAL(4)
+        RANK(.TRUE.)
+    !ERROR: Must have INTEGER type, but is REAL(4)
+        RANK(1.0)
+    !ERROR: Must be a constant value
+        RANK(RANK(x))
+    !ERROR: Must have INTEGER type, but is CHARACTER(1)
+        RANK("STRING")
+    END SELECT
+   end subroutine
+   subroutine CALL_SHAPE(x)
+    implicit none
+    integer :: x(..)
+    integer :: j
+    integer, pointer :: ptr
+    SELECT RANK(x)
+     RANK(1)
+       print *, "RANK 1"
+       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 1))
+     RANK (3)
+       print *, "RANK 3"
+       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 3))
+    END SELECT
+    SELECT RANK(ptr => x )
+     RANK(1)
+       print *, "RANK 1"
+       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 1))
+     RANK (3)
+       print *, "RANK 3"
+       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 3))
+    END SELECT
+
+   end subroutine
+
+end program

flang/test/Semantics/select-rank02.f90

+! RUN: %B/test/Semantics/test_errors.sh %s %flang %t
+!Shape analysis related tests for SELECT RANK Construct(R1148)
+program select_rank
+   implicit none
+   integer, dimension(2,3):: arr_pass
+   call check(arr_pass)
+
+contains
+    subroutine check(arr)
+        implicit none
+        integer :: arr(..)
+        INTEGER :: j
+        select rank (arr)
+            rank(2)
+                j = INT(0, KIND=MERGE(KIND(0), -1, SIZE(SHAPE(arr)) == 2)) !arr is dummy
+        end select
+    end subroutine
+    subroutine check2(arr)
+        implicit none
+        integer :: arr(..)
+        INTEGER :: j
+        integer,dimension(-1:10, 20:30) :: brr
+
+        select rank (arr)
+            rank(2)
+                j = INT(0, KIND=MERGE(KIND(0), -1, SIZE(SHAPE(brr)) == 2)) !brr is local to subroutine
+        end select
+    end subroutine
+    subroutine checK3(arr)
+        implicit none
+        integer :: arr(..)
+        INTEGER :: j,I,n=5,m=5
+        integer,dimension(-1:10, 20:30) :: brr
+        integer :: array(2) = [10,20]
+        REAL, DIMENSION(5, 5) :: A
+        select rank (arr)
+            rank(2)
+                FORALL (i=1:n,j=1:m,RANK(arr).EQ.SIZE(SHAPE(brr))) &
+                    A(i,j) = 1/A(i,j)
+        end select
+    end subroutine
+    subroutine check4(arr)
+        implicit none
+        integer :: arr(..)
+        REAL, DIMENSION(2,3) :: A
+        REAL, DIMENSION(0:1,0:2) :: B
+        INTEGER :: j
+        select rank (arr)
+            rank(2)
+                A = B   !will assign to only same shape after analysing in any order.
+        end select
+    end subroutine
+    subroutine check5(arr)
+        implicit none
+        integer :: arr(..)
+        INTEGER :: j
+        select rank (arr)
+            rank(2)
+                j = LOC(arr(1,2))
+        end select
+    end subroutine
+end program