From 62bb8ff260409586389e8bdf09033b976c3a65e7 Mon Sep 17 00:00:00 2001 From: Peter Klausler 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 4535a92ce3dd8..342af51d6e405 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 36deab969456d..389a986d056ec 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(name, attrs)}; if (auto *details{symbol.detailsIf()}) { - 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 9873c5a351a40..2b0c4b6aa57e9 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