Skip to content

Commit

Permalink
[flang] Allow PROCEDURE() with explicit type elsewhere (#82835)
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
klausler committed Mar 2, 2024
1 parent 189d89a commit 8bcb1ce
Show file tree
Hide file tree
Showing 3 changed files with 13 additions and 7 deletions.
1 change: 0 additions & 1 deletion flang/include/flang/Semantics/symbol.h
Original file line number Diff line number Diff line change
Expand Up @@ -419,7 +419,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,
Expand Down
10 changes: 5 additions & 5 deletions flang/lib/Semantics/resolve-names.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -4976,13 +4976,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)) {
Expand Down
9 changes: 8 additions & 1 deletion flang/test/Semantics/resolve91.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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

0 comments on commit 8bcb1ce

Please sign in to comment.