[flang-commits] [flang] [flang] Accept whole assumed-size arrays as variable selectors (PR #82806)

[Peter Klausler via flang-commits]

https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/82806

>From 3b1164a047279a19281dd83d3d938b23447b5bf1 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 23 Feb 2024 10:08:18 -0800
Subject: [PATCH] [flang] Accept whole assumed-size arrays as variable
 selectors

Include variable selectors ("select type (x => y)") as a context
in which a whole assumed-size array may legitimately appear.

Fixes https://github.com/llvm/llvm-project/issues/81910.
---
 flang/lib/Evaluate/tools.cpp       |  6 ++++--
 flang/lib/Semantics/expression.cpp | 11 ++++++++---
 flang/test/Semantics/assign04.f90  |  7 +++++++
 3 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 131bbd97ce1632..a4b2d273263603 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1400,8 +1400,10 @@ static const Symbol *GetAssociatedVariable(const AssocEntityDetails &details) {
 const Symbol &GetAssociationRoot(const Symbol &original) {
   const Symbol &symbol{ResolveAssociations(original)};
   if (const auto *details{symbol.detailsIf<AssocEntityDetails>()}) {
-    if (const Symbol * root{GetAssociatedVariable(*details)}) {
-      return *root;
+    if (!details->rank()) {
+      if (const Symbol * root{GetAssociatedVariable(*details)}) {
+        return *root;
+      }
     }
   }
   return symbol;
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 8d817f077880b9..53968e0723ef3e 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -973,7 +973,8 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Name &n) {
         }
       }
       if (!isWholeAssumedSizeArrayOk_ &&
-          semantics::IsAssumedSizeArray(*n.symbol)) { // C1002, C1014, C1231
+          semantics::IsAssumedSizeArray(
+              GetAssociationRoot(*n.symbol))) { // C1002, C1014, C1231
         AttachDeclaration(
             SayAt(n,
                 "Whole assumed-size array '%s' may not appear here without subscripts"_err_en_US,
@@ -3741,9 +3742,12 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Selector &selector) {
         }
       }
     }
+    // Not a Variable -> FunctionReference
+    auto restorer{AllowWholeAssumedSizeArray()};
+    return Analyze(selector.u);
+  } else { // Expr
+    return Analyze(selector.u);
   }
-  // Not a Variable -> FunctionReference; handle normally as Variable or Expr
-  return Analyze(selector.u);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::DataStmtConstant &x) {
@@ -3999,6 +4003,7 @@ void ArgumentAnalyzer::Analyze(
     const parser::ActualArgSpec &arg, bool isSubroutine) {
   // TODO: C1534: Don't allow a "restricted" specific intrinsic to be passed.
   std::optional<ActualArgument> actual;
+  auto restorer{context_.AllowWholeAssumedSizeArray()};
   common::visit(
       common::visitors{
           [&](const common::Indirection<parser::Expr> &x) {
diff --git a/flang/test/Semantics/assign04.f90 b/flang/test/Semantics/assign04.f90
index a00ca5213a7aae..14d90a8d5a2244 100644
--- a/flang/test/Semantics/assign04.f90
+++ b/flang/test/Semantics/assign04.f90
@@ -105,6 +105,13 @@ subroutine s6(x)
   x(:) = [1, 2, 3]
   !ERROR: Whole assumed-size array 'x' may not appear here without subscripts
   x = [1, 2, 3]
+  associate (y => x) ! ok
+    !ERROR: Whole assumed-size array 'y' may not appear here without subscripts
+    y = [1, 2, 3]
+  end associate
+  !ERROR: Whole assumed-size array 'x' may not appear here without subscripts
+  associate (y => (x))
+  end associate
 end
 
 module m7