[flang] Error out when assumed rank variable in used as selector in SELECT TYPE statement

[NimishMishra]

This patch adds a check to error out when an assumed rank variable is used as dummy argument.

Fixes #74285

[llvmbot]

@llvm/pr-subscribers-flang-fir-hlfir
@llvm/pr-subscribers-flang-openmp

@llvm/pr-subscribers-flang-semantics

Author: None (NimishMishra)

Changes

This patch adds a check to error out when an assumed rank variable is used as dummy argument.

Fixes #74285

---

Full diff: https://github.com/llvm/llvm-project/pull/74286.diff

2 Files Affected:

• (modified) flang/lib/Semantics/check-select-type.cpp (+25-1)
• (modified) flang/test/Semantics/selecttype01.f90 (+6)

diff --git a/flang/lib/Semantics/check-select-type.cpp b/flang/lib/Semantics/check-select-type.cpp
index c67248ba62407..69ae30dcd3ae4 100644
--- a/flang/lib/Semantics/check-select-type.cpp
+++ b/flang/lib/Semantics/check-select-type.cpp
@@ -269,6 +269,30 @@ void SelectTypeChecker::Enter(const parser::SelectTypeConstruct &construct) {
 
 const SomeExpr *SelectTypeChecker::GetExprFromSelector(
     const parser::Selector &selector) {
-  return common::visit([](const auto &x) { return GetExpr(x); }, selector.u);
+  return common::visit(
+      common::visitors{
+          [&](const parser::Variable &var) {
+            const auto *designator =
+                std::get_if<common::Indirection<parser::Designator>>(&var.u);
+            if (designator) {
+              const auto *dataRef =
+                  std::get_if<Fortran::parser::DataRef>(&designator->value().u);
+              const Fortran::parser::Name *name = dataRef
+                  ? std::get_if<Fortran::parser::Name>(&dataRef->u)
+                  : nullptr;
+              if (name && name->symbol->has<ObjectEntityDetails>() &&
+                  name->symbol->detailsIf<ObjectEntityDetails>()
+                      ->IsAssumedRank()) {
+                context_.Say(name->source,
+                    "Assumed-rank variable '%s' may only be used"
+                    " as actual argument"_err_en_US,
+                    name->ToString());
+              }
+            }
+            return GetExpr(var);
+          },
+          [](const auto &x) { return GetExpr(x); },
+      },
+      selector.u);
 }
 } // namespace Fortran::semantics
diff --git a/flang/test/Semantics/selecttype01.f90 b/flang/test/Semantics/selecttype01.f90
index e8699f20620ce..ae504d112dcd7 100644
--- a/flang/test/Semantics/selecttype01.f90
+++ b/flang/test/Semantics/selecttype01.f90
@@ -288,4 +288,10 @@ subroutine CheckNotProcedure
   function f() result(res)
     class(shape), allocatable :: res
   end
+subroutine CheckAssumedRankInSelectType(var)
+  class(*), intent(in) :: var(..)
+!ERROR: Assumed-rank variable 'var' may only be used as actual argument
+  select type(var)
+  end select
+end subroutine
 end

[klausler]

The title of this patch refers to dummy arguments, but the code itself seems to be testing the selector of a SELECT TYPE construct to implement a check to ensure that the selector is not assumed-rank. Where in the standard are assumed rank objects precluded from being used in SELECT TYPE?

(Also, evaluate::IsAssumedRank() would be a better implementation of the test, if it were needed. But I need to understand what constraint or requirement in the standard is being enforced here first.)

[NimishMishra]

The title of this patch refers to dummy arguments, but the code itself seems to be testing the selector of a SELECT TYPE construct to implement a check to ensure that the selector is not assumed-rank. Where in the standard are assumed rank objects precluded from being used in SELECT TYPE?

Thank you for the comment. I can change the title of the patch.

The interpretation leading to this patch that I was following was C838 in the "An assumed-rank variable name shall not appear in a designator or expression except as an actual argument that corresponds to a dummy argument that is assumed-rank...". Since SELECT TYPE selectors are either designators or expressions (from parse-tree.h), my understanding was this restriction is transitively applicable in the current context too. Plus, seemed like C838 was also responsible for gfortran's semantic error on this test case.

[klausler]

Thanks for finding that constraint. Please simplify the code by using IsAssumedRank().

[NimishMishra]

@klausler Could you have a relook at this once, if it is okay now?

[klausler]

I recommend that you not split error messages across multiple lines -- that makes it much more difficult to grep the sources to find the code that emits a particular error.

[NimishMishra]

Thanks for the review!