[flang-commits] [flang] [flang] Allow PROCEDURE() with explicit type elsewhere (PR #82835)

[Peter Klausler via flang-commits]

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

Fortran allows a procedure declaration statement with no interface or type, with an explicit type declaration statement elsewhere being used to define a function's result.

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

>From 62bb8ff260409586389e8bdf09033b976c3a65e7 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 23 Feb 2024 13:40:38 -0800
Subject: [PATCH] [flang] Allow PROCEDURE() with explicit type elsewhere

Fortran allows a procedure declaration statement with no interface
or type, with an explicit type declaration statement elsewhere
being used to define a function's result.

Fixes https://github.com/llvm/llvm-project/issues/82006.
---
 flang/include/flang/Semantics/symbol.h |  1 -
 flang/lib/Semantics/resolve-names.cpp  | 10 +++++-----
 flang/test/Semantics/resolve91.f90     |  9 ++++++++-
 3 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 4535a92ce3dd8e..342af51d6e4058 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -413,7 +413,6 @@ class ProcEntityDetails : public EntityDetails, public WithPassArg {
 
   const Symbol *procInterface() const { return procInterface_; }
   void set_procInterface(const Symbol &sym) { procInterface_ = &sym; }
-  bool IsInterfaceSet() { return procInterface_ || type(); }
   inline bool HasExplicitInterface() const;
 
   // Be advised: !init().has_value() => uninitialized pointer,
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 36deab969456d0..389a986d056ec0 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -4965,13 +4965,13 @@ Symbol &DeclarationVisitor::DeclareProcEntity(
     const parser::Name &name, Attrs attrs, const Symbol *interface) {
   Symbol &symbol{DeclareEntity<ProcEntityDetails>(name, attrs)};
   if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
-    if (details->IsInterfaceSet()) {
-      SayWithDecl(name, symbol,
-          "The interface for procedure '%s' has already been "
-          "declared"_err_en_US);
-      context().SetError(symbol);
+    if (context().HasError(symbol)) {
     } else if (HasCycle(symbol, interface)) {
       return symbol;
+    } else if (interface && (details->procInterface() || details->type())) {
+      SayWithDecl(name, symbol,
+          "The interface for procedure '%s' has already been declared"_err_en_US);
+      context().SetError(symbol);
     } else if (interface) {
       details->set_procInterface(*interface);
       if (interface->test(Symbol::Flag::Function)) {
diff --git a/flang/test/Semantics/resolve91.f90 b/flang/test/Semantics/resolve91.f90
index 9873c5a351a409..2b0c4b6aa57e98 100644
--- a/flang/test/Semantics/resolve91.f90
+++ b/flang/test/Semantics/resolve91.f90
@@ -4,7 +4,7 @@ module m
   procedure(real), pointer :: p
   !ERROR: EXTERNAL attribute was already specified on 'p'
   !ERROR: POINTER attribute was already specified on 'p'
-  !ERROR: The interface for procedure 'p' has already been declared
+  !ERROR: The type of 'p' has already been declared
   procedure(integer), pointer :: p
 end
 
@@ -82,3 +82,10 @@ module m8
   !ERROR: The type of 'pvar' has already been declared
   integer, pointer :: pVar => kVar
 end module m8
+
+module m9
+  integer :: p, q
+  procedure() p ! ok
+  !ERROR: The type of 'q' has already been declared
+  procedure(real) q
+end module m9