diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h --- a/flang/include/flang/Evaluate/characteristics.h +++ b/flang/include/flang/Evaluate/characteristics.h @@ -82,8 +82,6 @@ static std::optional Characterize( const semantics::Symbol &, FoldingContext &); - static std::optional Characterize( - const semantics::ProcInterface &, FoldingContext &); static std::optional Characterize( const semantics::DeclTypeSpec &, FoldingContext &); static std::optional Characterize( diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -257,12 +257,9 @@ ProcEntityDetails(ProcEntityDetails &&) = default; ProcEntityDetails &operator=(const ProcEntityDetails &) = default; - const ProcInterface &interface() const { return interface_; } - ProcInterface &interface() { return interface_; } - void set_interface(const ProcInterface &interface) { interface_ = interface; } - bool IsInterfaceSet() { - return interface_.symbol() != nullptr || interface_.type() != nullptr; - } + 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, @@ -272,7 +269,7 @@ void set_init(std::nullptr_t) { init_ = nullptr; } private: - ProcInterface interface_; + const Symbol *procInterface_{nullptr}; std::optional init_; friend llvm::raw_ostream &operator<<( llvm::raw_ostream &, const ProcEntityDetails &); @@ -731,7 +728,7 @@ }, [](const ObjectEntityDetails &oed) { return oed.shape().Rank(); }, [&](const ProcEntityDetails &ped) { - const Symbol *iface{ped.interface().symbol()}; + const Symbol *iface{ped.procInterface()}; return iface ? iface->RankImpl(depth) : 0; }, [](const AssocEntityDetails &aed) { @@ -794,10 +791,7 @@ // between the two shared libraries. inline bool ProcEntityDetails::HasExplicitInterface() const { - if (auto *symbol{interface_.symbol()}) { - return symbol->HasExplicitInterface(); - } - return false; + return procInterface_ && procInterface_->HasExplicitInterface(); } inline Symbol &Symbol::GetUltimate() { @@ -831,8 +825,8 @@ return x.isFunction() ? x.result().GetTypeImpl(depth) : nullptr; }, [&](const ProcEntityDetails &x) { - const Symbol *symbol{x.interface().symbol()}; - return symbol ? symbol->GetTypeImpl(depth) : x.interface().type(); + const Symbol *symbol{x.procInterface()}; + return symbol ? symbol->GetTypeImpl(depth) : x.type(); }, [&](const ProcBindingDetails &x) { return x.symbol().GetTypeImpl(depth); diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h --- a/flang/include/flang/Semantics/type.h +++ b/flang/include/flang/Semantics/type.h @@ -389,21 +389,6 @@ }; llvm::raw_ostream &operator<<(llvm::raw_ostream &, const DeclTypeSpec &); -// This represents a proc-interface in the declaration of a procedure or -// procedure component. It comprises a symbol that represents the specific -// interface or a decl-type-spec that represents the function return type. -class ProcInterface { -public: - const Symbol *symbol() const { return symbol_; } - const DeclTypeSpec *type() const { return type_; } - void set_symbol(const Symbol &symbol); - void set_type(const DeclTypeSpec &type); - -private: - const Symbol *symbol_{nullptr}; - const DeclTypeSpec *type_{nullptr}; -}; - // Define some member functions here in the header so that they can be used by // lib/Evaluate without link-time dependency on Semantics. diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -120,7 +120,7 @@ if (const Symbol * symbol{GetSymbol()}) { const Symbol &ultimate{symbol->GetUltimate()}; if (const auto *proc{ultimate.detailsIf()}) { - return proc->interface().symbol(); + return proc->procInterface(); } else if (const auto *binding{ ultimate.detailsIf()}) { return &binding->symbol(); diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp --- a/flang/lib/Evaluate/characteristics.cpp +++ b/flang/lib/Evaluate/characteristics.cpp @@ -73,11 +73,10 @@ return common::visit( common::visitors{ [&](const semantics::ProcEntityDetails &proc) { - const semantics::ProcInterface &interface { proc.interface() }; - if (interface.type()) { - return Characterize(*interface.type(), context); - } else if (interface.symbol()) { - return Characterize(*interface.symbol(), context); + if (proc.procInterface()) { + return Characterize(*proc.procInterface(), context); + } else if (proc.type()) { + return Characterize(*proc.type(), context); } else { return std::optional{}; } @@ -506,8 +505,8 @@ } return intrinsic; } - const semantics::ProcInterface &interface { proc.interface() }; - if (const semantics::Symbol * interfaceSymbol{interface.symbol()}) { + if (const semantics::Symbol * + interfaceSymbol{proc.procInterface()}) { auto interface { CharacterizeProcedure(*interfaceSymbol, context, seenProcs) }; @@ -517,7 +516,7 @@ return interface; } else { result.attrs.set(Procedure::Attr::ImplicitInterface); - const semantics::DeclTypeSpec *type{interface.type()}; + const semantics::DeclTypeSpec *type{proc.type()}; if (symbol.test(semantics::Symbol::Flag::Subroutine)) { // ignore any implicit typing result.attrs.set(Procedure::Attr::Subroutine); diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp --- a/flang/lib/Evaluate/shape.cpp +++ b/flang/lib/Evaluate/shape.cpp @@ -690,7 +690,7 @@ return ScalarShape(); // no dimensions seen }, [&](const semantics::ProcEntityDetails &proc) { - if (const Symbol * interface{proc.interface().symbol()}) { + if (const Symbol * interface{proc.procInterface()}) { return (*this)(*interface); } else { return ScalarShape(); diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1254,9 +1254,9 @@ // An ENTRY is pure if its containing subprogram is const Symbol &symbol{DEREF(GetMainEntry(&original.GetUltimate()))}; if (const auto *procDetails{symbol.detailsIf()}) { - if (const Symbol * procInterface{procDetails->interface().symbol()}) { + if (procDetails->procInterface()) { // procedure with a pure interface - return IsPureProcedure(*procInterface); + return IsPureProcedure(*procDetails->procInterface()); } } else if (const auto *details{symbol.detailsIf()}) { return IsPureProcedure(details->symbol()); @@ -1295,7 +1295,7 @@ // An ENTRY is elemental if its containing subprogram is const Symbol &symbol{DEREF(GetMainEntry(&original.GetUltimate()))}; if (const auto *procDetails{symbol.detailsIf()}) { - if (const Symbol * procInterface{procDetails->interface().symbol()}) { + if (const Symbol * procInterface{procDetails->procInterface()}) { // procedure with an elemental interface, ignoring the elemental // aspect of intrinsic functions return !procInterface->attrs().test(Attr::INTRINSIC) && @@ -1318,9 +1318,8 @@ common::visitors{ [](const SubprogramDetails &x) { return x.isFunction(); }, [](const ProcEntityDetails &x) { - const auto &ifc{x.interface()}; - return ifc.type() || - (ifc.symbol() && IsFunction(*ifc.symbol())); + const Symbol *ifc{x.procInterface()}; + return x.type() || (ifc && IsFunction(*ifc)); }, [](const ProcBindingDetails &x) { return IsFunction(x.symbol()); @@ -1618,7 +1617,7 @@ return subp.isFunction() ? &subp.result() : nullptr; }, [&](const ProcEntityDetails &proc) { - const Symbol *iface{proc.interface().symbol()}; + const Symbol *iface{proc.procInterface()}; return iface ? FindFunctionResult(*iface, seen) : nullptr; }, [&](const ProcBindingDetails &binding) { diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -823,7 +823,7 @@ "An ELEMENTAL subprogram may not have a dummy procedure"_err_en_US); } const Symbol *interface { - details.interface().symbol() + details.procInterface() }; if (!symbol.attrs().test(Attr::INTRINSIC) && (IsElementalProcedure(symbol) || @@ -852,11 +852,11 @@ "Procedure component '%s' must have POINTER attribute"_err_en_US, name); } - CheckPassArg(symbol, details.interface().symbol(), details); + CheckPassArg(symbol, details.procInterface(), details); } if (symbol.attrs().test(Attr::POINTER)) { CheckPointerInitialization(symbol); - if (const Symbol *interface{details.interface().symbol()}) { + if (const Symbol * interface{details.procInterface()}) { const Symbol &ultimate{interface->GetUltimate()}; if (ultimate.attrs().test(Attr::INTRINSIC)) { if (const auto intrinsic{ @@ -2056,8 +2056,8 @@ } } if (const auto *proc{symbol.detailsIf()}) { - if (!proc->interface().symbol() || - !proc->interface().symbol()->attrs().test(Attr::BIND_C)) { + if (!proc->procInterface() || + !proc->procInterface()->attrs().test(Attr::BIND_C)) { messages_.Say(symbol.name(), "An interface name with BIND attribute must be specified if the BIND attribute is specified in a procedure declaration statement"_err_en_US); context_.SetError(symbol); diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -693,7 +693,6 @@ return; } const auto &details{symbol.get()}; - const ProcInterface &interface { details.interface() }; Attrs attrs{symbol.attrs()}; if (details.passName()) { attrs.reset(Attr::PASS); @@ -702,10 +701,10 @@ os, symbol, [&]() { os << "procedure("; - if (interface.symbol()) { - os << interface.symbol()->name(); - } else if (interface.type()) { - PutType(os, *interface.type()); + if (details.procInterface()) { + os << details.procInterface()->name(); + } else if (details.type()) { + PutType(os, *details.type()); } os << ')'; PutPassName(os, details.passName()); @@ -1135,8 +1134,7 @@ // Is 's' a procedure with interface 'symbol'? if (s) { if (const auto *sDetails{s->detailsIf()}) { - const ProcInterface &sInterface{sDetails->interface()}; - if (sInterface.symbol() == &symbol) { + if (sDetails->procInterface() == &symbol) { return true; } } @@ -1195,10 +1193,11 @@ } }, [this](const ProcEntityDetails &details) { - if (const Symbol * symbol{details.interface().symbol()}) { - DoSymbol(*symbol); + if (details.procInterface()) { + DoSymbol(*details.procInterface()); + } else { + DoType(details.type()); } - DoType(details.interface().type()); }, [](const auto &) {}, }, diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp --- a/flang/lib/Semantics/resolve-names-utils.cpp +++ b/flang/lib/Semantics/resolve-names-utils.cpp @@ -798,34 +798,34 @@ } } } - common::visit(common::visitors{[&](ObjectEntityDetails &object) { - for (ShapeSpec &spec : object.shape()) { - MapShapeSpec(spec); - } - for (ShapeSpec &spec : object.coshape()) { - MapShapeSpec(spec); - } - }, - [&](ProcEntityDetails &proc) { - if (const Symbol *mappedSymbol{ - MapInterface(proc.interface().symbol())}) { - proc.interface().set_symbol(*mappedSymbol); - } else if (const DeclTypeSpec *mappedType{ - MapType(proc.interface().type())}) { - proc.interface().set_type(*mappedType); - } - if (proc.init()) { - if (const Symbol *mapped{MapSymbol(*proc.init())}) { - proc.set_init(*mapped); - } - } - }, - [&](const HostAssocDetails &hostAssoc) { - if (const Symbol *mapped{MapSymbol(hostAssoc.symbol())}) { - symbol.set_details(HostAssocDetails{*mapped}); - } - }, - [](const auto &) {}}, + common::visit( + common::visitors{[&](ObjectEntityDetails &object) { + for (ShapeSpec &spec : object.shape()) { + MapShapeSpec(spec); + } + for (ShapeSpec &spec : object.coshape()) { + MapShapeSpec(spec); + } + }, + [&](ProcEntityDetails &proc) { + if (const Symbol * + mappedSymbol{MapInterface(proc.procInterface())}) { + proc.set_procInterface(*mappedSymbol); + } else if (const DeclTypeSpec * mappedType{MapType(proc.type())}) { + proc.set_type(*mappedType); + } + if (proc.init()) { + if (const Symbol * mapped{MapSymbol(*proc.init())}) { + proc.set_init(*mapped); + } + } + }, + [&](const HostAssocDetails &hostAssoc) { + if (const Symbol * mapped{MapSymbol(hostAssoc.symbol())}) { + symbol.set_details(HostAssocDetails{*mapped}); + } + }, + [](const auto &) {}}, symbol.details()); } diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -1082,7 +1082,8 @@ bool HandleAttributeStmt(Attr, const std::list &); Symbol &HandleAttributeStmt(Attr, const parser::Name &); Symbol &DeclareUnknownEntity(const parser::Name &, Attrs); - Symbol &DeclareProcEntity(const parser::Name &, Attrs, const ProcInterface &); + Symbol &DeclareProcEntity( + const parser::Name &, Attrs, const Symbol *interface); void SetType(const parser::Name &, const DeclTypeSpec &); std::optional ResolveDerivedType(const parser::Name &); std::optional ResolveExtendsType( @@ -1156,7 +1157,7 @@ context().SetError(symbol); return symbol; } - bool HasCycle(const Symbol &, const ProcInterface &); + bool HasCycle(const Symbol &, const Symbol *interface); }; // Resolve construct entities and statement entities. @@ -2377,7 +2378,7 @@ [&](const ProcEntityDetails &p) { return symbol.test(Symbol::Flag::Function) && !symbol.attrs().test(Attr::INTRINSIC) && - !p.interface().type() && !p.interface().symbol(); + !p.type() && !p.procInterface(); }, [](const auto &) { return false; }, }, @@ -4385,36 +4386,32 @@ } bool DeclarationVisitor::HasCycle( - const Symbol &procSymbol, const ProcInterface &interface) { + const Symbol &procSymbol, const Symbol *interface) { SourceOrderedSymbolSet procsInCycle; procsInCycle.insert(procSymbol); - const ProcInterface *thisInterface{&interface}; - bool haveInterface{true}; - while (haveInterface) { - haveInterface = false; - if (const Symbol * interfaceSymbol{thisInterface->symbol()}) { - if (procsInCycle.count(*interfaceSymbol) > 0) { - for (const auto &procInCycle : procsInCycle) { - Say(procInCycle->name(), - "The interface for procedure '%s' is recursively " - "defined"_err_en_US, - procInCycle->name()); - context().SetError(*procInCycle); - } - return true; - } else if (const auto *procDetails{ - interfaceSymbol->detailsIf()}) { - haveInterface = true; - thisInterface = &procDetails->interface(); - procsInCycle.insert(*interfaceSymbol); + while (interface) { + if (procsInCycle.count(*interface) > 0) { + for (const auto &procInCycle : procsInCycle) { + Say(procInCycle->name(), + "The interface for procedure '%s' is recursively " + "defined"_err_en_US, + procInCycle->name()); + context().SetError(*procInCycle); } + return true; + } else if (const auto *procDetails{ + interface->detailsIf()}) { + procsInCycle.insert(*interface); + interface = procDetails->procInterface(); + } else { + break; } } return false; } Symbol &DeclarationVisitor::DeclareProcEntity( - const parser::Name &name, Attrs attrs, const ProcInterface &interface) { + const parser::Name &name, Attrs attrs, const Symbol *interface) { Symbol &symbol{DeclareEntity(name, attrs)}; if (auto *details{symbol.detailsIf()}) { if (details->IsInterfaceSet()) { @@ -4424,16 +4421,17 @@ context().SetError(symbol); } else if (HasCycle(symbol, interface)) { return symbol; - } else if (interface.type()) { - symbol.set(Symbol::Flag::Function); - } else if (interface.symbol()) { - if (interface.symbol()->test(Symbol::Flag::Function)) { + } else if (interface) { + details->set_procInterface(*interface); + if (interface->test(Symbol::Flag::Function)) { symbol.set(Symbol::Flag::Function); - } else if (interface.symbol()->test(Symbol::Flag::Subroutine)) { + } else if (interface->test(Symbol::Flag::Subroutine)) { symbol.set(Symbol::Flag::Subroutine); } + } else if (auto *type{GetDeclTypeSpec()}) { + SetType(name, *type); + symbol.set(Symbol::Flag::Function); } - details->set_interface(interface); SetBindNameOn(symbol); SetPassNameOn(symbol); } @@ -4960,11 +4958,9 @@ } void DeclarationVisitor::Post(const parser::ProcDecl &x) { const auto &name{std::get(x.t)}; - ProcInterface interface; + const Symbol *procInterface{nullptr}; if (interfaceName_) { - interface.set_symbol(*interfaceName_->symbol); - } else if (auto *type{GetDeclTypeSpec()}) { - interface.set_type(*type); + procInterface = interfaceName_->symbol; } auto attrs{HandleSaveName(name.source, GetAttrs())}; DerivedTypeDetails *dtDetails{nullptr}; @@ -4974,7 +4970,7 @@ if (!dtDetails) { attrs.set(Attr::EXTERNAL); } - Symbol &symbol{DeclareProcEntity(name, attrs, interface)}; + Symbol &symbol{DeclareProcEntity(name, attrs, procInterface)}; symbol.ReplaceName(name.source); if (dtDetails) { dtDetails->add_component(symbol); @@ -5688,9 +5684,7 @@ const DeclTypeSpec &typeSpec{ MakeNumericType(dyType.category(), dyType.kind())}; ProcEntityDetails details; - ProcInterface procInterface; - procInterface.set_type(typeSpec); - details.set_interface(procInterface); + details.set_type(typeSpec); symbol.set_details(std::move(details)); symbol.set(Symbol::Flag::Function); if (interface->IsElemental()) { @@ -5847,6 +5841,14 @@ "A length specifier cannot be used to declare the non-character entity '%s'"_err_en_US); } } + if (auto *proc{symbol.detailsIf()}) { + if (proc->procInterface()) { + Say(name, + "'%s' has an explicit interface and may not also have a type"_err_en_US); + context().SetError(symbol); + return; + } + } auto *prevType{symbol.GetType()}; if (!prevType) { symbol.SetType(type); @@ -7241,7 +7243,7 @@ } else if (const auto *details{symbol.detailsIf()}) { return !details->type(); } else if (const auto *details{symbol.detailsIf()}) { - return !details->interface().symbol() && !details->interface().type(); + return !details->procInterface() && !details->type(); } else { return false; } diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp --- a/flang/lib/Semantics/symbol.cpp +++ b/flang/lib/Semantics/symbol.cpp @@ -137,7 +137,7 @@ void EntityDetails::ReplaceType(const DeclTypeSpec &type) { type_ = &type; } ObjectEntityDetails::ObjectEntityDetails(EntityDetails &&d) - : EntityDetails(d) {} + : EntityDetails(std::move(d)) {} void ObjectEntityDetails::set_shape(const ArraySpec &shape) { CHECK(shape_.empty()); @@ -152,11 +152,8 @@ } } -ProcEntityDetails::ProcEntityDetails(EntityDetails &&d) : EntityDetails(d) { - if (type()) { - interface_.set_type(*type()); - } -} +ProcEntityDetails::ProcEntityDetails(EntityDetails &&d) + : EntityDetails(std::move(d)) {} UseErrorDetails::UseErrorDetails(const UseDetails &useDetails) { add_occurrence(useDetails.location(), *GetUsedModule(useDetails).scope()); @@ -301,7 +298,7 @@ [&](EntityDetails &x) { x.set_type(type); }, [&](ObjectEntityDetails &x) { x.set_type(type); }, [&](AssocEntityDetails &x) { x.set_type(type); }, - [&](ProcEntityDetails &x) { x.interface().set_type(type); }, + [&](ProcEntityDetails &x) { x.set_type(type); }, [&](TypeParamDetails &x) { x.set_type(type); }, [](auto &) {}, }, @@ -401,10 +398,10 @@ llvm::raw_ostream &operator<<( llvm::raw_ostream &os, const ProcEntityDetails &x) { - if (auto *symbol{x.interface_.symbol()}) { - os << ' ' << symbol->name(); + if (x.procInterface_) { + os << ' ' << x.procInterface_->name(); } else { - DumpType(os, x.interface_.type()); + DumpType(os, x.type()); } DumpOptional(os, "bindName", x.bindName()); DumpOptional(os, "passName", x.passName()); diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -280,9 +280,9 @@ bool IsBindCProcedure(const Symbol &symbol) { if (const auto *procDetails{symbol.detailsIf()}) { - if (const Symbol * procInterface{procDetails->interface().symbol()}) { + if (procDetails->procInterface()) { // procedure component with a BIND(C) interface - return IsBindCProcedure(*procInterface); + return IsBindCProcedure(*procDetails->procInterface()); } } return symbol.attrs().test(Attr::BIND_C) && IsProcedure(symbol); @@ -456,7 +456,9 @@ return common::visit( common::visitors{ [](const ProcEntityDetails &details) { - const Symbol *interface { details.interface().symbol() }; + const Symbol *interface { + details.procInterface() + }; return interface ? FindInterface(*interface) : nullptr; }, [](const ProcBindingDetails &details) { @@ -482,8 +484,8 @@ return common::visit( common::visitors{ [&](const ProcEntityDetails &details) -> const Symbol * { - if (const Symbol * interface{details.interface().symbol()}) { - return FindSubprogram(*interface); + if (details.procInterface()) { + return FindSubprogram(*details.procInterface()); } else { return &symbol; } diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp --- a/flang/lib/Semantics/type.cpp +++ b/flang/lib/Semantics/type.cpp @@ -463,10 +463,8 @@ } else if (auto *procDetails{newSymbol.detailsIf()}) { // We have a procedure pointer. Instantiate its return type if (const DeclTypeSpec * returnType{InstantiateType(newSymbol)}) { - ProcInterface &interface{procDetails->interface()}; - if (!interface.symbol()) { - // Don't change the type for interfaces based on symbols - interface.set_type(*returnType); + if (!procDetails->procInterface()) { + procDetails->ReplaceType(*returnType); } } } @@ -792,13 +790,4 @@ return o << x.AsFortran(); } -void ProcInterface::set_symbol(const Symbol &symbol) { - CHECK(!type_); - symbol_ = &symbol; -} -void ProcInterface::set_type(const DeclTypeSpec &type) { - CHECK(!symbol_); - type_ = &type; -} - } // namespace Fortran::semantics diff --git a/flang/test/Semantics/procinterface03.f90 b/flang/test/Semantics/procinterface03.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/procinterface03.f90 @@ -0,0 +1,5 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +procedure(sin), pointer :: pp +!ERROR: 'pp' has an explicit interface and may not also have a type +real :: pp +end