Skip to content

Commit 8bcb1ce

Browse files
authored
[flang] Allow PROCEDURE() with explicit type elsewhere (#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 #82006.
1 parent 189d89a commit 8bcb1ce

File tree

3 files changed

+13
-7
lines changed

3 files changed

+13
-7
lines changed

flang/include/flang/Semantics/symbol.h

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -419,7 +419,6 @@ class ProcEntityDetails : public EntityDetails, public WithPassArg {
419419

420420
const Symbol *procInterface() const { return procInterface_; }
421421
void set_procInterface(const Symbol &sym) { procInterface_ = &sym; }
422-
bool IsInterfaceSet() { return procInterface_ || type(); }
423422
inline bool HasExplicitInterface() const;
424423

425424
// Be advised: !init().has_value() => uninitialized pointer,

flang/lib/Semantics/resolve-names.cpp

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -4976,13 +4976,13 @@ Symbol &DeclarationVisitor::DeclareProcEntity(
49764976
const parser::Name &name, Attrs attrs, const Symbol *interface) {
49774977
Symbol &symbol{DeclareEntity<ProcEntityDetails>(name, attrs)};
49784978
if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
4979-
if (details->IsInterfaceSet()) {
4980-
SayWithDecl(name, symbol,
4981-
"The interface for procedure '%s' has already been "
4982-
"declared"_err_en_US);
4983-
context().SetError(symbol);
4979+
if (context().HasError(symbol)) {
49844980
} else if (HasCycle(symbol, interface)) {
49854981
return symbol;
4982+
} else if (interface && (details->procInterface() || details->type())) {
4983+
SayWithDecl(name, symbol,
4984+
"The interface for procedure '%s' has already been declared"_err_en_US);
4985+
context().SetError(symbol);
49864986
} else if (interface) {
49874987
details->set_procInterface(*interface);
49884988
if (interface->test(Symbol::Flag::Function)) {

flang/test/Semantics/resolve91.f90

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ module m
44
procedure(real), pointer :: p
55
!ERROR: EXTERNAL attribute was already specified on 'p'
66
!ERROR: POINTER attribute was already specified on 'p'
7-
!ERROR: The interface for procedure 'p' has already been declared
7+
!ERROR: The type of 'p' has already been declared
88
procedure(integer), pointer :: p
99
end
1010

@@ -82,3 +82,10 @@ module m8
8282
!ERROR: The type of 'pvar' has already been declared
8383
integer, pointer :: pVar => kVar
8484
end module m8
85+
86+
module m9
87+
integer :: p, q
88+
procedure() p ! ok
89+
!ERROR: The type of 'q' has already been declared
90+
procedure(real) q
91+
end module m9

0 commit comments

Comments
 (0)