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

[via flang-commits]

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

>From 289356a846dcd417eab5a61d790f5abb6f33770f Mon Sep 17 00:00:00 2001
From: Nimish Mishra <neelam.nimish at gmail.com>
Date: Mon, 11 Dec 2023 09:30:51 +0530
Subject: [PATCH] [flang] Error out when assumed rank variable in used as
 selector in SELECT TYPE statement

---
 flang/lib/Semantics/check-select-type.cpp | 4 ++++
 flang/test/Semantics/selecttype01.f90     | 7 +++++++
 2 files changed, 11 insertions(+)

diff --git a/flang/lib/Semantics/check-select-type.cpp b/flang/lib/Semantics/check-select-type.cpp
index c67248ba62407f..03ddc2a9cd73d5 100644
--- a/flang/lib/Semantics/check-select-type.cpp
+++ b/flang/lib/Semantics/check-select-type.cpp
@@ -258,6 +258,10 @@ void SelectTypeChecker::Enter(const parser::SelectTypeConstruct &construct) {
     if (IsProcedure(*selector)) {
       context_.Say(
           selectTypeStmt.source, "Selector may not be a procedure"_err_en_US);
+    } else if (evaluate::IsAssumedRank(*selector)) {
+      context_.Say(selectTypeStmt.source,
+          "Assumed-rank variable "
+          "may only be used as actual argument"_err_en_US);
     } else if (auto exprType{selector->GetType()}) {
       const auto &typeCaseList{
           std::get<std::list<parser::SelectTypeConstruct::TypeCase>>(
diff --git a/flang/test/Semantics/selecttype01.f90 b/flang/test/Semantics/selecttype01.f90
index e8699f20620cef..93fd1302048861 100644
--- a/flang/test/Semantics/selecttype01.f90
+++ b/flang/test/Semantics/selecttype01.f90
@@ -288,4 +288,11 @@ subroutine CheckNotProcedure
   function f() result(res)
     class(shape), allocatable :: res
   end
+
+subroutine CheckAssumedRankInSelectType(var)
+  class(*), intent(in) :: var(..)
+  !ERROR: Assumed-rank variable may only be used as actual argument
+  select type(var)
+  end select
+ end
 end