diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -79,6 +79,11 @@ kind 4, because the grammar of Fortran expressions parses it as a negation of a literal constant, not a negative literal constant. This compiler accepts it with a portability warning. +* Construct names like `loop` in `loop: do j=1,n` are defined to + be "local identifiers" and should be distinct in the "inclusive + scope" -- i.e., not scoped by `BLOCK` constructs. + As most (but not all) compilers implement `BLOCK` scoping of construct + names, so does f18, with a portability warning. ## Extensions, deletions, and legacy features supported by default 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 @@ -553,6 +553,7 @@ // Search for name in a derived type scope and its parents. Symbol *FindInTypeOrParents(const Scope &, const parser::Name &); Symbol *FindInTypeOrParents(const parser::Name &); + Symbol *FindInScopeOrBlockConstructs(const Scope &, SourceName); Symbol *FindSeparateModuleProcedureInterface(const parser::Name &); void EraseSymbol(const parser::Name &); void EraseSymbol(const Symbol &symbol) { currScope().erase(symbol.name()); } @@ -2369,6 +2370,20 @@ Symbol *ScopeHandler::FindInTypeOrParents(const parser::Name &name) { return FindInTypeOrParents(currScope(), name); } +Symbol *ScopeHandler::FindInScopeOrBlockConstructs( + const Scope &scope, SourceName name) { + if (Symbol * symbol{FindInScope(scope, name)}) { + return symbol; + } + for (const Scope &child : scope.children()) { + if (child.kind() == Scope::Kind::BlockConstruct) { + if (Symbol * symbol{FindInScopeOrBlockConstructs(child, name)}) { + return symbol; + } + } + } + return nullptr; +} void ScopeHandler::EraseSymbol(const parser::Name &name) { currScope().erase(name.source); @@ -6556,8 +6571,19 @@ } bool ConstructVisitor::CheckDef(const std::optional &x) { - if (x) { - MakeSymbol(*x, MiscDetails{MiscDetails::Kind::ConstructName}); + if (x && !x->symbol) { + // Construct names are not scoped by BLOCK in the standard, but many, + // but not all, compilers do treat them as if they were so scoped. + if (Symbol * inner{FindInScope(currScope(), *x)}) { + SayAlreadyDeclared(*x, *inner); + } else { + if (Symbol * + other{FindInScopeOrBlockConstructs(InclusiveScope(), x->source)}) { + SayWithDecl(*x, *other, + "The construct name '%s' should be distinct at the subprogram level"_port_en_US); + } + MakeSymbol(*x, MiscDetails{MiscDetails::Kind::ConstructName}); + } } return true; } diff --git a/flang/test/Semantics/OpenACC/acc-branch.f90 b/flang/test/Semantics/OpenACC/acc-branch.f90 --- a/flang/test/Semantics/OpenACC/acc-branch.f90 +++ b/flang/test/Semantics/OpenACC/acc-branch.f90 @@ -53,6 +53,7 @@ ! Exit branches out of parallel construct, attached to an OpenACC parallel construct. thisblk: BLOCK fortname: if (.true.) then + !PORTABILITY: The construct name 'name1' should be distinct at the subprogram level name1: do k = 1, N !$acc parallel !ERROR: EXIT to construct 'fortname' outside of PARALLEL construct is not allowed