[flang-commits] [flang] [flang] Enforce F'2023 C1520 correctly (PR #82842)

[Peter Klausler via flang-commits]

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

When a procedure declaration statement has a binding label, it must declare no more than one procedure.

Fixes https://github.com/llvm/llvm-project/issues/82528.

>From 39e4644e8a7feff025cb16fc2c18e3472723a016 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 23 Feb 2024 15:20:11 -0800
Subject: [PATCH] [flang] Enforce F'2023 C1520 correctly

When a procedure declaration statement has a binding label,
it must declare no more than one procedure.

Fixes https://github.com/llvm/llvm-project/issues/82528.
---
 flang/lib/Semantics/resolve-names.cpp | 7 ++++---
 flang/test/Semantics/bind-c04.f90     | 2 +-
 2 files changed, 5 insertions(+), 4 deletions(-)

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 36deab969456d0..013588e3884424 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1118,7 +1118,6 @@ class DeclarationVisitor : public ArraySpecVisitor,
   // Set when walking DATA & array constructor implied DO loop bounds
   // to warn about use of the implied DO intex therein.
   std::optional<SourceName> checkIndexUseInOwnBounds_;
-  bool hasBindCName_{false};
   bool isVectorType_{false};
   UnorderedSymbolSet mustBeScalar_;
 
@@ -5578,7 +5577,10 @@ bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &x) {
   for (const parser::ProcAttrSpec &procAttr : procAttrSpec) {
     if (auto *bindC{std::get_if<parser::LanguageBindingSpec>(&procAttr.u)}) {
       if (bindC->v.has_value()) {
-        hasBindCName_ = true;
+        if (std::get<std::list<parser::ProcDecl>>(x.t).size() > 1) {
+          Say(context().location().value(),
+              "A procedure declaration statement with a binding name may not declare multiple procedures"_err_en_US);
+        }
         break;
       }
     }
@@ -5587,7 +5589,6 @@ bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &x) {
 }
 void DeclarationVisitor::Post(const parser::ProcedureDeclarationStmt &) {
   interfaceName_ = nullptr;
-  hasBindCName_ = false;
   EndDecl();
 }
 bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) {
diff --git a/flang/test/Semantics/bind-c04.f90 b/flang/test/Semantics/bind-c04.f90
index a4aaffb239fde2..27119e375ce057 100644
--- a/flang/test/Semantics/bind-c04.f90
+++ b/flang/test/Semantics/bind-c04.f90
@@ -19,7 +19,7 @@ subroutine aproc2() bind(c) ! ok
     end
   end interface
 
-  !Acceptable (as an extension)
+  !ERROR: A procedure declaration statement with a binding name may not declare multiple procedures
   procedure(proc), bind(c, name="aaa") :: pc1, pc2
 
   !ERROR: A procedure pointer may not have a BIND attribute with a name