[flang-commits] [flang] [flang] Error out when assumed rank variable is used as dummy argument (PR #74286)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: None (NimishMishra)

<details>
<summary>Changes</summary>

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

Fixes https://github.com/llvm/llvm-project/issues/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
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

``````````

</details>


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