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

[via flang-commits]

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

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

>From 03eb496e94d281d5957447557b2d892dc17a460b Mon Sep 17 00:00:00 2001
From: Nimish Mishra <neelam.nimish at gmail.com>
Date: Mon, 4 Dec 2023 12:12:30 +0530
Subject: [PATCH] [flang] Error out when assumed rank variable is used as dummy
 argument

---
 flang/lib/Semantics/check-select-type.cpp | 26 ++++++++++++++++++++++-
 flang/test/Semantics/selecttype01.f90     |  6 ++++++
 2 files changed, 31 insertions(+), 1 deletion(-)

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