aboutsummaryrefslogtreecommitdiff
path: root/flang/lib/Semantics/resolve-names.cpp
diff options
context:
space:
mode:
Diffstat (limited to 'flang/lib/Semantics/resolve-names.cpp')
-rw-r--r--flang/lib/Semantics/resolve-names.cpp179
1 files changed, 63 insertions, 116 deletions
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 5041a6a..b7c7603d 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1106,8 +1106,9 @@ protected:
// or nullptr on error.
Symbol *DeclareStatementEntity(const parser::DoVariable &,
const std::optional<parser::IntegerTypeSpec> &);
- Symbol &MakeCommonBlockSymbol(const parser::Name &);
- Symbol &MakeCommonBlockSymbol(const std::optional<parser::Name> &);
+ Symbol &MakeCommonBlockSymbol(const parser::Name &, SourceName);
+ Symbol &MakeCommonBlockSymbol(
+ const std::optional<parser::Name> &, SourceName);
bool CheckUseError(const parser::Name &);
void CheckAccessibility(const SourceName &, bool, Symbol &);
void CheckCommonBlocks();
@@ -1244,8 +1245,6 @@ private:
bool OkToAddComponent(const parser::Name &, const Symbol *extends = nullptr);
ParamValue GetParamValue(
const parser::TypeParamValue &, common::TypeParamAttr attr);
- void CheckCommonBlockDerivedType(
- const SourceName &, const Symbol &, UnorderedSymbolSet &);
Attrs HandleSaveName(const SourceName &, Attrs);
void AddSaveName(std::set<SourceName> &, const SourceName &);
bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &);
@@ -3963,8 +3962,26 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
}
}
+ auto AreSameModuleProcOrBothInterfaces{[](const Symbol &p1,
+ const Symbol &p2) {
+ if (IsProcedure(p1) && !IsPointer(p1) && IsProcedure(p2) &&
+ !IsPointer(p2)) {
+ auto classification{ClassifyProcedure(p1)};
+ if (classification == ClassifyProcedure(p2)) {
+ if (classification == ProcedureDefinitionClass::External) {
+ const auto *subp1{p1.detailsIf<SubprogramDetails>()};
+ const auto *subp2{p2.detailsIf<SubprogramDetails>()};
+ return subp1 && subp1->isInterface() && subp2 && subp2->isInterface();
+ } else if (classification == ProcedureDefinitionClass::Module) {
+ return AreSameModuleSymbol(p1, p2);
+ }
+ }
+ }
+ return false;
+ }};
+
auto AreSameProcedure{[&](const Symbol &p1, const Symbol &p2) {
- if (&p1 == &p2) {
+ if (&p1.GetUltimate() == &p2.GetUltimate()) {
return true;
} else if (p1.name() != p2.name()) {
return false;
@@ -3972,31 +3989,16 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
p2.attrs().test(Attr::INTRINSIC)) {
return p1.attrs().test(Attr::INTRINSIC) &&
p2.attrs().test(Attr::INTRINSIC);
- } else if (!IsProcedure(p1) || !IsProcedure(p2)) {
- return false;
- } else if (IsPointer(p1) || IsPointer(p2)) {
- return false;
- } else if (const auto *subp{p1.detailsIf<SubprogramDetails>()};
- subp && !subp->isInterface()) {
- return false; // defined in module, not an external
- } else if (const auto *subp{p2.detailsIf<SubprogramDetails>()};
- subp && !subp->isInterface()) {
- return false; // defined in module, not an external
+ } else if (AreSameModuleProcOrBothInterfaces(p1, p2)) {
+ // Both are external interfaces, perhaps to the same procedure,
+ // or both are module procedures from modules with the same name.
+ auto p1Chars{evaluate::characteristics::Procedure::Characterize(
+ p1, GetFoldingContext())};
+ auto p2Chars{evaluate::characteristics::Procedure::Characterize(
+ p2, GetFoldingContext())};
+ return p1Chars && p2Chars && *p1Chars == *p2Chars;
} else {
- // Both are external interfaces, perhaps to the same procedure
- auto class1{ClassifyProcedure(p1)};
- auto class2{ClassifyProcedure(p2)};
- if (class1 == ProcedureDefinitionClass::External &&
- class2 == ProcedureDefinitionClass::External) {
- auto chars1{evaluate::characteristics::Procedure::Characterize(
- p1, GetFoldingContext())};
- auto chars2{evaluate::characteristics::Procedure::Characterize(
- p2, GetFoldingContext())};
- // same procedure interface defined identically in two modules?
- return chars1 && chars2 && *chars1 == *chars2;
- } else {
- return false;
- }
+ return false;
}
}};
@@ -4097,13 +4099,32 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
localSymbol = &newSymbol;
}
if (useGeneric) {
- // Combine two use-associated generics
+ // Combine two use-associated generics.
localSymbol->attrs() =
useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE};
localSymbol->flags() = useSymbol.flags();
AddGenericUse(*localGeneric, localName, useUltimate);
- localGeneric->clear_derivedType();
- localGeneric->CopyFrom(*useGeneric);
+ // Don't duplicate specific procedures.
+ std::size_t originalLocalSpecifics{localGeneric->specificProcs().size()};
+ std::size_t useSpecifics{useGeneric->specificProcs().size()};
+ CHECK(originalLocalSpecifics == localGeneric->bindingNames().size());
+ CHECK(useSpecifics == useGeneric->bindingNames().size());
+ std::size_t j{0};
+ for (const Symbol &useSpecific : useGeneric->specificProcs()) {
+ SourceName useBindingName{useGeneric->bindingNames()[j++]};
+ bool isDuplicate{false};
+ std::size_t k{0};
+ for (const Symbol &localSpecific : localGeneric->specificProcs()) {
+ if (localGeneric->bindingNames()[k++] == useBindingName &&
+ AreSameProcedure(localSpecific, useSpecific)) {
+ isDuplicate = true;
+ break;
+ }
+ }
+ if (!isDuplicate) {
+ localGeneric->AddSpecificProc(useSpecific, useBindingName);
+ }
+ }
}
localGeneric->clear_derivedType();
if (combinedDerivedType) {
@@ -5564,7 +5585,7 @@ bool DeclarationVisitor::Pre(const parser::BindEntity &x) {
if (kind == parser::BindEntity::Kind::Object) {
symbol = &HandleAttributeStmt(Attr::BIND_C, name);
} else {
- symbol = &MakeCommonBlockSymbol(name);
+ symbol = &MakeCommonBlockSymbol(name, name.source);
SetExplicitAttr(*symbol, Attr::BIND_C);
}
// 8.6.4(1)
@@ -7147,7 +7168,7 @@ bool DeclarationVisitor::Pre(const parser::SaveStmt &x) {
auto kind{std::get<parser::SavedEntity::Kind>(y.t)};
const auto &name{std::get<parser::Name>(y.t)};
if (kind == parser::SavedEntity::Kind::Common) {
- MakeCommonBlockSymbol(name);
+ MakeCommonBlockSymbol(name, name.source);
AddSaveName(specPartState_.saveInfo.commons, name.source);
} else {
HandleAttributeStmt(Attr::SAVE, name);
@@ -7227,59 +7248,22 @@ void DeclarationVisitor::CheckCommonBlocks() {
if (symbol.get<CommonBlockDetails>().objects().empty() &&
symbol.attrs().test(Attr::BIND_C)) {
Say(symbol.name(),
- "'%s' appears as a COMMON block in a BIND statement but not in"
- " a COMMON statement"_err_en_US);
- }
- }
- // check objects in common blocks
- for (const auto &name : specPartState_.commonBlockObjects) {
- const auto *symbol{currScope().FindSymbol(name)};
- if (!symbol) {
- continue;
- }
- const auto &attrs{symbol->attrs()};
- if (attrs.test(Attr::ALLOCATABLE)) {
- Say(name,
- "ALLOCATABLE object '%s' may not appear in a COMMON block"_err_en_US);
- } else if (attrs.test(Attr::BIND_C)) {
- Say(name,
- "Variable '%s' with BIND attribute may not appear in a COMMON block"_err_en_US);
- } else if (IsNamedConstant(*symbol)) {
- Say(name,
- "A named constant '%s' may not appear in a COMMON block"_err_en_US);
- } else if (IsDummy(*symbol)) {
- Say(name,
- "Dummy argument '%s' may not appear in a COMMON block"_err_en_US);
- } else if (symbol->IsFuncResult()) {
- Say(name,
- "Function result '%s' may not appear in a COMMON block"_err_en_US);
- } else if (const DeclTypeSpec * type{symbol->GetType()}) {
- if (type->category() == DeclTypeSpec::ClassStar) {
- Say(name,
- "Unlimited polymorphic pointer '%s' may not appear in a COMMON block"_err_en_US);
- } else if (const auto *derived{type->AsDerived()}) {
- if (!IsSequenceOrBindCType(derived)) {
- Say(name,
- "Derived type '%s' in COMMON block must have the BIND or"
- " SEQUENCE attribute"_err_en_US);
- }
- UnorderedSymbolSet typeSet;
- CheckCommonBlockDerivedType(name, derived->typeSymbol(), typeSet);
- }
+ "'%s' appears as a COMMON block in a BIND statement but not in a COMMON statement"_err_en_US);
}
}
specPartState_.commonBlockObjects = {};
}
-Symbol &DeclarationVisitor::MakeCommonBlockSymbol(const parser::Name &name) {
- return Resolve(name, currScope().MakeCommonBlock(name.source));
+Symbol &DeclarationVisitor::MakeCommonBlockSymbol(
+ const parser::Name &name, SourceName location) {
+ return Resolve(name, currScope().MakeCommonBlock(name.source, location));
}
Symbol &DeclarationVisitor::MakeCommonBlockSymbol(
- const std::optional<parser::Name> &name) {
+ const std::optional<parser::Name> &name, SourceName location) {
if (name) {
- return MakeCommonBlockSymbol(*name);
+ return MakeCommonBlockSymbol(*name, location);
} else {
- return MakeCommonBlockSymbol(parser::Name{});
+ return MakeCommonBlockSymbol(parser::Name{}, location);
}
}
@@ -7287,43 +7271,6 @@ bool DeclarationVisitor::NameIsKnownOrIntrinsic(const parser::Name &name) {
return FindSymbol(name) || HandleUnrestrictedSpecificIntrinsicFunction(name);
}
-// Check if this derived type can be in a COMMON block.
-void DeclarationVisitor::CheckCommonBlockDerivedType(const SourceName &name,
- const Symbol &typeSymbol, UnorderedSymbolSet &typeSet) {
- if (auto iter{typeSet.find(SymbolRef{typeSymbol})}; iter != typeSet.end()) {
- return;
- }
- typeSet.emplace(typeSymbol);
- if (const auto *scope{typeSymbol.scope()}) {
- for (const auto &pair : *scope) {
- const Symbol &component{*pair.second};
- if (component.attrs().test(Attr::ALLOCATABLE)) {
- Say2(name,
- "Derived type variable '%s' may not appear in a COMMON block"
- " due to ALLOCATABLE component"_err_en_US,
- component.name(), "Component with ALLOCATABLE attribute"_en_US);
- return;
- }
- const auto *details{component.detailsIf<ObjectEntityDetails>()};
- if (component.test(Symbol::Flag::InDataStmt) ||
- (details && details->init())) {
- Say2(name,
- "Derived type variable '%s' may not appear in a COMMON block due to component with default initialization"_err_en_US,
- component.name(), "Component with default initialization"_en_US);
- return;
- }
- if (details) {
- if (const auto *type{details->type()}) {
- if (const auto *derived{type->AsDerived()}) {
- const Symbol &derivedTypeSymbol{derived->typeSymbol()};
- CheckCommonBlockDerivedType(name, derivedTypeSymbol, typeSet);
- }
- }
- }
- }
- }
-}
-
bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction(
const parser::Name &name) {
if (auto interface{context().intrinsics().IsSpecificIntrinsicFunction(
@@ -9655,7 +9602,7 @@ void ResolveNamesVisitor::CreateCommonBlockSymbols(
const parser::CommonStmt &commonStmt) {
for (const parser::CommonStmt::Block &block : commonStmt.blocks) {
const auto &[name, objects] = block.t;
- Symbol &commonBlock{MakeCommonBlockSymbol(name)};
+ Symbol &commonBlock{MakeCommonBlockSymbol(name, commonStmt.source)};
for (const auto &object : objects) {
Symbol &obj{DeclareObjectEntity(std::get<parser::Name>(object.t))};
if (auto *details{obj.detailsIf<ObjectEntityDetails>()}) {
generated by cgit v1.1 at 2025-10-04 07:48:33 +0000