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

[via flang-commits]

Author: NimishMishra
Date: 2024-01-03T05:46:02-08:00
New Revision: 6023e2476b5cb2fd84dcb74d805ae2e322160111

URL: https://github.com/llvm/llvm-project/commit/6023e2476b5cb2fd84dcb74d805ae2e322160111
DIFF: https://github.com/llvm/llvm-project/commit/6023e2476b5cb2fd84dcb74d805ae2e322160111.diff

LOG: [flang] Error out when assumed rank variable in used as selector in SELECT TYPE statement (#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

Added: 
    

Modified: 
    flang/lib/Semantics/check-select-type.cpp
    flang/test/Semantics/selecttype01.f90

Removed: 
    


################################################################################
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