Index: flang/lib/Semantics/resolve-names.cpp =================================================================== --- flang/lib/Semantics/resolve-names.cpp +++ flang/lib/Semantics/resolve-names.cpp @@ -888,7 +888,8 @@ void CheckExtantProc(const parser::Name &, Symbol::Flag); // Create a subprogram symbol in the current scope and push a new scope. Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag, - const parser::LanguageBindingSpec * = nullptr); + const parser::LanguageBindingSpec * = nullptr, + bool hasModulePrefix = false); Symbol *GetSpecificFromGeneric(const parser::Name &); Symbol &PostSubprogramStmt(); void CreateDummyArgument(SubprogramDetails &, const parser::Name &); @@ -3603,10 +3604,21 @@ } } +static bool HasModulePrefix(const std::list &prefixes) { + for (const auto &prefix : prefixes) { + if (std::holds_alternative(prefix.u)) { + return true; + } + } + return false; +} + bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) { - const auto &name{std::get( - std::get>(x.t).statement.t)}; - return BeginSubprogram(name, Symbol::Flag::Subroutine); + const auto &stmtTuple{ + std::get>(x.t).statement.t}; + return BeginSubprogram(std::get(stmtTuple), + Symbol::Flag::Subroutine, + HasModulePrefix(std::get>(stmtTuple))); } void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &x) { const auto &stmt{std::get>(x.t)}; @@ -3614,9 +3626,11 @@ &std::get>(stmt.statement.t)); } bool SubprogramVisitor::Pre(const parser::InterfaceBody::Function &x) { - const auto &name{std::get( - std::get>(x.t).statement.t)}; - return BeginSubprogram(name, Symbol::Flag::Function); + const auto &stmtTuple{ + std::get>(x.t).statement.t}; + return BeginSubprogram(std::get(stmtTuple), + Symbol::Flag::Function, + HasModulePrefix(std::get>(stmtTuple))); } void SubprogramVisitor::Post(const parser::InterfaceBody::Function &x) { const auto &stmt{std::get>(x.t)}; @@ -4025,10 +4039,16 @@ if (moduleInterface && &moduleInterface->owner() == &currScope()) { // Subprogram is MODULE FUNCTION or MODULE SUBROUTINE with an interface // previously defined in the same scope. - EraseSymbol(name); + if (GenericDetails * + generic{DEREF(FindSymbol(name)).detailsIf()}) { + generic->clear_specific(); + } else { + EraseSymbol(name); + } } } - Symbol &newSymbol{PushSubprogramScope(name, subpFlag, bindingSpec)}; + Symbol &newSymbol{ + PushSubprogramScope(name, subpFlag, bindingSpec, hasModulePrefix)}; if (moduleInterface) { newSymbol.get().set_moduleInterface(*moduleInterface); if (moduleInterface->attrs().test(Attr::PRIVATE)) { @@ -4136,7 +4156,8 @@ } Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name, - Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec) { + Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec, + bool hasModulePrefix) { Symbol *symbol{GetSpecificFromGeneric(name)}; if (!symbol) { if (bindingSpec && currScope().IsGlobal() && bindingSpec->v) { @@ -4161,6 +4182,8 @@ details.set_isInterface(); if (isAbstract()) { SetExplicitAttr(*symbol, Attr::ABSTRACT); + } else if (hasModulePrefix) { + SetExplicitAttr(*symbol, Attr::MODULE); } else { MakeExternal(*symbol); } @@ -4174,7 +4197,10 @@ } set_inheritFromParent(false); } - FindSymbol(name)->set(subpFlag); // PushScope() created symbol + if (Symbol * found{FindSymbol(name)}; + found && found->has()) { + found->set(subpFlag); // PushScope() created symbol + } return *symbol; } @@ -4210,6 +4236,7 @@ } else if (auto *details{symbol->detailsIf()}) { // found generic, want specific procedure auto *specific{details->specific()}; + Attrs moduleAttr; if (inInterfaceBlock()) { if (specific) { // Defining an interface in a generic of the same name which is @@ -4220,6 +4247,7 @@ // The shadowed procedure is a separate module procedure that is // actually defined later in this (sub)module. // Define its interface now as a new symbol. + moduleAttr.set(Attr::MODULE); specific = nullptr; } else if (&specific->owner() != &symbol->owner()) { // The shadowed procedure was from an enclosing scope and will be @@ -4238,8 +4266,8 @@ } } if (!specific) { - specific = - &currScope().MakeSymbol(name.source, Attrs{}, SubprogramDetails{}); + specific = &currScope().MakeSymbol( + name.source, std::move(moduleAttr), SubprogramDetails{}); if (details->derivedType()) { // A specific procedure with the same name as a derived type SayAlreadyDeclared(name, *details->derivedType()); Index: flang/test/Semantics/symbol28.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/symbol28.f90 @@ -0,0 +1,62 @@ +! RUN: %python %S/test_symbols.py %s %flang_fc1 +!DEF: /m1 Module +module m1 + !DEF: /m1/s PUBLIC (Subroutine) Generic + interface s + !DEF: /m1/s MODULE (Subroutine) Subprogram + module subroutine s + end subroutine + !DEF: /m1/s2 MODULE, PUBLIC (Subroutine) Subprogram + !DEF: /m1/s2/j INTENT(IN) ObjectEntity INTEGER(4) + module subroutine s2 (j) + !REF: /m1/s2/j + integer, intent(in) :: j + end subroutine + end interface +contains + !DEF: /m1/s MODULE (Subroutine) SubprogramName + module subroutine s + end subroutine + !REF: /m1/s2 + module procedure s2 + end procedure + !DEF: /m1/test PUBLIC (Subroutine) Subprogram + subroutine test + !REF: /m1/s + call s + !REF: /m1/s2 + call s(1) + end subroutine +end module +!DEF: /m2 Module +module m2 + !DEF: /m2/s PUBLIC (Subroutine) Generic + interface s + !DEF: /m2/s MODULE (Subroutine) Subprogram + module subroutine s + end subroutine + !DEF: /m2/s2 MODULE, PUBLIC (Subroutine) Subprogram + !DEF: /m2/s2/j INTENT(IN) ObjectEntity INTEGER(4) + module subroutine s2 (j) + !REF: /m2/s2/j + integer, intent(in) :: j + end subroutine + end interface +contains + !DEF: /m2/s MODULE SubprogramName + module procedure s + end procedure + !DEF: /m2/s2 MODULE, PUBLIC (Subroutine) Subprogram + !DEF: /m2/s2/j INTENT(IN) ObjectEntity INTEGER(4) + module subroutine s2 (j) + !REF: /m2/s2/j + integer, intent(in) :: j + end subroutine + !DEF: /m2/test PUBLIC (Subroutine) Subprogram + subroutine test + !REF: /m2/s + call s + !REF: /m2/s2 + call s(1) + end subroutine +end module