[flang-commits] [flang] [flang] Catch ASSOCIATE(x=>assumed_rank) (PR #100626)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/100626

An assumed-rank dummy argument cannot be the variable or expression in the selector of an ASSOCIATE construct.  (SELECT TYPE/RANK are fine.)

>From d068426383dfe220a03004b3d3a986f5a05407bd Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 25 Jul 2024 10:34:18 -0700
Subject: [PATCH] [flang] Catch ASSOCIATE(x=>assumed_rank)

An assumed-rank dummy argument cannot be the variable or expression
in the selector of an ASSOCIATE construct.  (SELECT TYPE/RANK are
fine.)
---
 flang/lib/Semantics/resolve-names.cpp | 6 +++++-
 flang/test/Semantics/associate04.f90  | 7 +++++++
 2 files changed, 12 insertions(+), 1 deletion(-)
 create mode 100644 flang/test/Semantics/associate04.f90

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f761355d0da32..6a4482c51a5f8 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -7118,9 +7118,13 @@ void ConstructVisitor::Post(const parser::AssociateStmt &x) {
   for (auto nthLastAssoc{assocCount}; nthLastAssoc > 0; --nthLastAssoc) {
     SetCurrentAssociation(nthLastAssoc);
     if (auto *symbol{MakeAssocEntity()}) {
-      if (ExtractCoarrayRef(GetCurrentAssociation().selector.expr)) { // C1103
+      const MaybeExpr &expr{GetCurrentAssociation().selector.expr};
+      if (ExtractCoarrayRef(expr)) { // C1103
         Say("Selector must not be a coindexed object"_err_en_US);
       }
+      if (evaluate::IsAssumedRank(expr)) {
+        Say("Selector must not be assumed-rank"_err_en_US);
+      }
       SetTypeFromAssociation(*symbol);
       SetAttrsFromAssociation(*symbol);
     }
diff --git a/flang/test/Semantics/associate04.f90 b/flang/test/Semantics/associate04.f90
new file mode 100644
index 0000000000000..5a73ba419c0a3
--- /dev/null
+++ b/flang/test/Semantics/associate04.f90
@@ -0,0 +1,7 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+subroutine bad(a)
+  real :: a(..)
+  !ERROR: Selector must not be assumed-rank
+  associate(x => a)
+  end associate
+end subroutine