[flang-commits] [flang] [flang] Error out when assumed rank variable in used as selector in SELECT TYPE statement (PR #74286)

[via flang-commits]

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

>From d1456b7b6c6cde5d2ec41a45dd18ecbc8405a087 Mon Sep 17 00:00:00 2001
From: Nimish Mishra <neelam.nimish at gmail.com>
Date: Wed, 3 Jan 2024 18:37:00 +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 | 3 +++
 flang/test/Semantics/selecttype01.f90     | 7 +++++++
 2 files changed, 10 insertions(+)

diff --git a/flang/lib/Semantics/check-select-type.cpp b/flang/lib/Semantics/check-select-type.cpp
index c67248ba62407f..6515cf25e0d7df 100644
--- a/flang/lib/Semantics/check-select-type.cpp
+++ b/flang/lib/Semantics/check-select-type.cpp
@@ -258,6 +258,9 @@ 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