Index: flang/include/flang/Semantics/symbol.h =================================================================== --- flang/include/flang/Semantics/symbol.h +++ flang/include/flang/Semantics/symbol.h @@ -558,6 +558,8 @@ const SourceName &name() const { return name_; } Attrs &attrs() { return attrs_; } const Attrs &attrs() const { return attrs_; } + Attrs &implicitAttrs() { return implicitAttrs_; } + const Attrs &implicitAttrs() const { return implicitAttrs_; } Flags &flags() { return flags_; } const Flags &flags() const { return flags_; } bool test(Flag flag) const { return flags_.test(flag); } @@ -684,6 +686,7 @@ const Scope *owner_; SourceName name_; Attrs attrs_; + Attrs implicitAttrs_; // subset of attrs_ that were not explicit Flags flags_; Scope *scope_{nullptr}; std::size_t size_{0}; // size in bytes Index: flang/lib/Semantics/resolve-names.cpp =================================================================== --- flang/lib/Semantics/resolve-names.cpp +++ flang/lib/Semantics/resolve-names.cpp @@ -598,7 +598,8 @@ d->set_derivedType(*derivedType); } else if (derivedType->CanReplaceDetails(details)) { // was forward-referenced - derivedType->attrs() |= attrs; + CheckDuplicatedAttrs(name, *symbol, attrs); + SetExplicitAttrs(*derivedType, attrs); derivedType->set_details(std::move(details)); } else { SayAlreadyDeclared(name, *derivedType); @@ -609,7 +610,8 @@ } if (symbol->CanReplaceDetails(details)) { // update the existing symbol - symbol->attrs() |= attrs; + CheckDuplicatedAttrs(name, *symbol, attrs); + SetExplicitAttrs(*symbol, attrs); if constexpr (std::is_same_v) { // Dummy argument defined by explicit interface? details.set_isDummy(IsDummy(*symbol)); @@ -617,7 +619,8 @@ symbol->set_details(std::move(details)); return *symbol; } else if constexpr (std::is_same_v) { - symbol->attrs() |= attrs; + CheckDuplicatedAttrs(name, *symbol, attrs); + SetExplicitAttrs(*symbol, attrs); return *symbol; } else { if (!CheckPossibleBadForwardRef(*symbol)) { @@ -637,6 +640,23 @@ void MakeExternal(Symbol &); + // C815 duplicated attribute checking; returns false on error + bool CheckDuplicatedAttr(SourceName, const Symbol &, Attr); + bool CheckDuplicatedAttrs(SourceName, const Symbol &, Attrs); + + void SetExplicitAttr(Symbol &symbol, Attr attr) const { + symbol.attrs().set(attr); + symbol.implicitAttrs().reset(attr); + } + void SetExplicitAttrs(Symbol &symbol, Attrs attrs) const { + symbol.attrs() |= attrs; + symbol.implicitAttrs() &= ~attrs; + } + void SetImplicitAttr(Symbol &symbol, Attr attr) const { + symbol.attrs().set(attr); + symbol.implicitAttrs().set(attr); + } + protected: FuncResultStack &funcResultStack() { return funcResultStack_; } @@ -2286,7 +2306,8 @@ Symbol &ScopeHandler::MakeSymbol( Scope &scope, const SourceName &name, Attrs attrs) { if (Symbol * symbol{FindInScope(scope, name)}) { - symbol->attrs() |= attrs; + CheckDuplicatedAttrs(name, *symbol, attrs); + SetExplicitAttrs(*symbol, attrs); return *symbol; } else { const auto pair{scope.try_emplace(name, attrs, UnknownDetails{})}; @@ -2432,17 +2453,17 @@ // the INTRINSIC attribute. Also set PURE &/or ELEMENTAL as // appropriate. void ScopeHandler::AcquireIntrinsicProcedureFlags(Symbol &symbol) { - symbol.attrs().set(Attr::INTRINSIC); + SetImplicitAttr(symbol, Attr::INTRINSIC); switch (context().intrinsics().GetIntrinsicClass(symbol.name().ToString())) { case evaluate::IntrinsicClass::elementalFunction: case evaluate::IntrinsicClass::elementalSubroutine: - symbol.attrs().set(Attr::ELEMENTAL); - symbol.attrs().set(Attr::PURE); + SetExplicitAttr(symbol, Attr::ELEMENTAL); + SetExplicitAttr(symbol, Attr::PURE); break; case evaluate::IntrinsicClass::impureSubroutine: break; default: - symbol.attrs().set(Attr::PURE); + SetExplicitAttr(symbol, Attr::PURE); } } @@ -2588,7 +2609,7 @@ void ScopeHandler::MakeExternal(Symbol &symbol) { if (!symbol.attrs().test(Attr::EXTERNAL)) { - symbol.attrs().set(Attr::EXTERNAL); + SetImplicitAttr(symbol, Attr::EXTERNAL); if (symbol.attrs().test(Attr::INTRINSIC)) { // C840 Say(symbol.name(), "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US, @@ -2597,6 +2618,30 @@ } } +bool ScopeHandler::CheckDuplicatedAttr( + SourceName name, const Symbol &symbol, Attr attr) { + if (attr == Attr::SAVE || attr == Attr::BIND_C) { + // these are checked elsewhere + } else if (symbol.attrs().test(attr)) { // C815 + if (symbol.implicitAttrs().test(attr)) { + // Implied attribute is now confirmed explicitly + } else { + Say(name, "%s attribute was already specified on '%s'"_err_en_US, + EnumToString(attr), name); + return false; + } + } + return true; +} + +bool ScopeHandler::CheckDuplicatedAttrs( + SourceName name, const Symbol &symbol, Attrs attrs) { + bool ok{true}; + attrs.IterateOverMembers( + [&](Attr x) { ok &= CheckDuplicatedAttr(name, symbol, x); }); + return ok; +} + // ModuleVisitor implementation bool ModuleVisitor::Pre(const parser::Only &x) { @@ -2784,6 +2829,8 @@ localSymbol.set_details(UseDetails{localName, useSymbol}); localSymbol.attrs() = useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE}; + localSymbol.implicitAttrs() = + localSymbol.attrs() & Attrs{Attr::ASYNCHRONOUS, Attr::VOLATILE}; localSymbol.flags() = useSymbol.flags(); return; } @@ -3053,7 +3100,7 @@ for (auto &pair : currScope()) { Symbol &symbol = *pair.second; if (!symbol.attrs().HasAny({Attr::PUBLIC, Attr::PRIVATE})) { - symbol.attrs().set(defaultAccess_); + SetImplicitAttr(symbol, defaultAccess_); } } } @@ -3097,7 +3144,7 @@ } void InterfaceVisitor::Post(const parser::GenericStmt &x) { if (auto &accessSpec{std::get>(x.t)}) { - GetGenericInfo().symbol->attrs().set(AccessSpecToAttr(*accessSpec)); + SetExplicitAttr(*GetGenericInfo().symbol, AccessSpecToAttr(*accessSpec)); } const auto &names{std::get>(x.t)}; AddSpecificProcs(names, ProcedureKind::Procedure); @@ -3449,9 +3496,10 @@ SubprogramDetails &SubprogramVisitor::PostSubprogramStmt( const parser::Name &name) { Symbol &symbol{*currScope().symbol()}; - symbol.attrs() |= EndAttrs(); + SetExplicitAttrs(symbol, EndAttrs()); if (symbol.attrs().test(Attr::MODULE)) { symbol.attrs().set(Attr::EXTERNAL, false); + symbol.implicitAttrs().set(Attr::EXTERNAL, false); } return symbol.get(); } @@ -3530,7 +3578,8 @@ if (auto *specific{generic->specific()}) { // Forward reference to ENTRY from a generic interface entrySymbol = specific; - entrySymbol->attrs() |= attrs; + CheckDuplicatedAttrs(entryName.source, *entrySymbol, attrs); + SetExplicitAttrs(*entrySymbol, attrs); } } } else { @@ -3717,9 +3766,9 @@ if (moduleInterface) { newSymbol.get().set_moduleInterface(*moduleInterface); if (moduleInterface->attrs().test(Attr::PRIVATE)) { - newSymbol.attrs().set(Attr::PRIVATE); + SetImplicitAttr(newSymbol, Attr::PRIVATE); } else if (moduleInterface->attrs().test(Attr::PUBLIC)) { - newSymbol.attrs().set(Attr::PUBLIC); + SetImplicitAttr(newSymbol, Attr::PUBLIC); } } if (entryStmts) { @@ -3837,7 +3886,7 @@ auto &details{symbol->get()}; details.set_isInterface(); if (isAbstract()) { - symbol->attrs().set(Attr::ABSTRACT); + SetExplicitAttr(*symbol, Attr::ABSTRACT); } else { MakeExternal(*symbol); } @@ -4029,7 +4078,7 @@ symbol = &HandleAttributeStmt(Attr::BIND_C, name); } else { symbol = &MakeCommonBlockSymbol(name); - symbol->attrs().set(Attr::BIND_C); + SetExplicitAttr(*symbol, Attr::BIND_C); } // 8.6.4(1) // Some entities such as named constant or module name need to checked @@ -4277,8 +4326,10 @@ if (!symbol) { symbol = &MakeSymbol(name, EntityDetails{}); } - symbol->attrs().set(attr); - symbol->attrs() = HandleSaveName(name.source, symbol->attrs()); + if (CheckDuplicatedAttr(name.source, *symbol, attr)) { + SetExplicitAttr(*symbol, attr); + symbol->attrs() = HandleSaveName(name.source, symbol->attrs()); + } return *symbol; } // C1107 @@ -4687,6 +4738,8 @@ auto &comp{DeclareEntity(*extendsName, Attrs{})}; comp.attrs().set( Attr::PRIVATE, extendsSymbol.attrs().test(Attr::PRIVATE)); + comp.implicitAttrs().set( + Attr::PRIVATE, extendsSymbol.implicitAttrs().test(Attr::PRIVATE)); comp.set(Symbol::Flag::ParentComp); DeclTypeSpec &type{currScope().MakeDerivedType( DeclTypeSpec::TypeDerived, std::move(*extendsType))}; @@ -5075,7 +5128,7 @@ return false; } if (isPrivate) { - genericSymbol->attrs().set(Attr::PRIVATE); + SetExplicitAttr(*genericSymbol, Attr::PRIVATE); } } for (const parser::Name &bindingName : bindingNames) { @@ -5485,7 +5538,7 @@ // Set the SAVE attribute on symbol unless it is implicitly saved anyway. void DeclarationVisitor::SetSaveAttr(Symbol &symbol) { if (!IsSaved(symbol)) { - symbol.attrs().set(Attr::SAVE); + SetImplicitAttr(symbol, Attr::SAVE); } } @@ -5615,10 +5668,10 @@ symbol.set_details(std::move(details)); symbol.set(Symbol::Flag::Function); if (interface->IsElemental()) { - symbol.attrs().set(Attr::ELEMENTAL); + SetExplicitAttr(symbol, Attr::ELEMENTAL); } if (interface->IsPure()) { - symbol.attrs().set(Attr::PURE); + SetExplicitAttr(symbol, Attr::PURE); } Resolve(name, symbol); return true; @@ -6440,7 +6493,7 @@ symbol.attrs() |= attrs & Attrs{Attr::TARGET, Attr::ASYNCHRONOUS, Attr::VOLATILE, Attr::CONTIGUOUS}; if (attrs.test(Attr::POINTER)) { - symbol.attrs().set(Attr::TARGET); + SetImplicitAttr(symbol, Attr::TARGET); } } @@ -7035,7 +7088,7 @@ if (symbol->has()) { symbol->set(flag); if (IsDummy(*symbol)) { - symbol->attrs().set(Attr::EXTERNAL); + SetImplicitAttr(*symbol, Attr::EXTERNAL); } ApplyImplicitRules(*symbol); } @@ -7588,7 +7641,7 @@ for (auto &child : node.children()) { auto &symbol{MakeSymbol(child.name(), SubprogramNameDetails{kind, child})}; if (child.HasModulePrefix()) { - symbol.attrs().set(Attr::MODULE); + SetExplicitAttr(symbol, Attr::MODULE); } auto childKind{child.GetKind()}; if (childKind == ProgramTree::Kind::Function) { @@ -7604,7 +7657,7 @@ MakeSymbol(std::get(entryStmt->t), std::move(details))}; symbol.set(child.GetSubpFlag()); if (child.HasModulePrefix()) { - symbol.attrs().set(Attr::MODULE); + SetExplicitAttr(symbol, Attr::MODULE); } } } Index: flang/test/Lower/call-site-mangling.f90 =================================================================== --- flang/test/Lower/call-site-mangling.f90 +++ flang/test/Lower/call-site-mangling.f90 @@ -112,7 +112,6 @@ end subroutine end interface procedure(some_bindc_iface) :: foo5 - external :: foo5 ! CHECK: fir.call @foo5 call foo5() end Index: flang/test/Semantics/misc-declarations.f90 =================================================================== --- flang/test/Semantics/misc-declarations.f90 +++ flang/test/Semantics/misc-declarations.f90 @@ -29,7 +29,7 @@ volatile :: coarrayComponent end subroutine subroutine C868(coarray,coarrayComponent) - real, volatile :: coarray[*] + real :: coarray[*] type(hasCoarray) :: coarrayComponent block !ERROR: VOLATILE attribute may not apply to a coarray accessed by USE or host association Index: flang/test/Semantics/resolve20.f90 =================================================================== --- flang/test/Semantics/resolve20.f90 +++ flang/test/Semantics/resolve20.f90 @@ -38,6 +38,10 @@ type :: m ! the name of a module can be used as a local identifier end type m + !ERROR: EXTERNAL attribute was already specified on 'a' + !ERROR: EXTERNAL attribute was already specified on 'b' + !ERROR: EXTERNAL attribute was already specified on 'c' + !ERROR: EXTERNAL attribute was already specified on 'd' external :: a, b, c, d !ERROR: EXTERNAL attribute not allowed on 'm' external :: m Index: flang/test/Semantics/resolve91.f90 =================================================================== --- flang/test/Semantics/resolve91.f90 +++ flang/test/Semantics/resolve91.f90 @@ -2,12 +2,15 @@ ! Tests for duplicate definitions and initializations, mostly of procedures 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 procedure(integer), pointer :: p end module m1 real, dimension(:), pointer :: realArray => null() + !ERROR: POINTER attribute was already specified on 'realarray' !ERROR: The type of 'realarray' has already been declared real, dimension(:), pointer :: realArray => localArray end module m1 @@ -19,6 +22,8 @@ end interface procedure(sub), pointer :: p1 => null() + !ERROR: EXTERNAL attribute was already specified on 'p1' + !ERROR: POINTER attribute was already specified on 'p1' !ERROR: The interface for procedure 'p1' has already been declared procedure(sub), pointer :: p1 => null() @@ -31,6 +36,8 @@ end interface procedure(fun), pointer :: f1 => null() + !ERROR: EXTERNAL attribute was already specified on 'f1' + !ERROR: POINTER attribute was already specified on 'f1' !ERROR: The interface for procedure 'f1' has already been declared procedure(fun), pointer :: f1 => null() @@ -71,6 +78,7 @@ integer, target :: jVar = 5 integer, target :: kVar = 5 integer, pointer :: pVar => jVar + !ERROR: POINTER attribute was already specified on 'pvar' !ERROR: The type of 'pvar' has already been declared integer, pointer :: pVar => kVar end module m8