[flang] Warn about construct names that are not distinct in the inclusive scope

[klausler]

Summary

f18 implements BLOCK scoping for construct names, like most but not all Fortran
compilers, but in the 2018 standard such names are defined to be local identifiers
whose scope is the inclusive scope -- i.e., the subprogram or main program.
Detect usage that depends on this extension and emit a portability warning.

flang/docs/Extensions.md

* If a dimension of a descriptor has zero extent in a call to
   `CFI_section`, `CFI_setpointer` or `CFI_allocate`, the lower
   bound on that dimension will be set to 1 for consistency with
   the `LBOUND()` intrinsic function.
 * `-2147483648_4` is, strictly speaking, a non-conforming literal
   constant on a machine with 32-bit two's-complement integers as
   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
 
 * Tabs in source
 * `<>` as synonym for `.NE.` and `/=`
 * `$` and `@` as legal characters in names
 * Initialization in type declaration statements using `/values/`
 * Kind specification with `*`, e.g. `REAL*4`

flang/lib/Semantics/resolve-names.cpp

public:
   Symbol *FindInScope(const Scope &, const parser::Name &);
   Symbol *FindInScope(const Scope &, const SourceName &);
   template <typename T> Symbol *FindInScope(const T &name) {
     return FindInScope(currScope(), name);
   }
   // 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()); }
   // Make a new symbol with the name and attrs of an existing one
   Symbol &CopySymbol(const SourceName &, const Symbol &);
 
   // Make symbols in the current or named scope
   Symbol &MakeSymbol(Scope &, const SourceName &, Attrs);

 // Find a component or type parameter by name in a derived type or its parents.
 Symbol *ScopeHandler::FindInTypeOrParents(
     const Scope &scope, const parser::Name &name) {
   return Resolve(name, scope.FindComponent(name.source));
 }
 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);
   name.symbol = nullptr;
 }
 
 static bool NeedsType(const Symbol &symbol) {
   return !symbol.GetType() &&
bool ConstructVisitor::Pre(const parser::SelectRankConstruct &) {
   return true;
 }
 
 void ConstructVisitor::Post(const parser::SelectRankConstruct &) {
   PopAssociation();
 }
 
 bool ConstructVisitor::CheckDef(const std::optional<parser::Name> &x) {
-  if (x) {
+  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;
 }
 
 void ConstructVisitor::CheckRef(const std::optional<parser::Name> &x) {
   if (x) {
     // Just add an occurrence of this name; checking is done in ValidateLabels
     FindSymbol(*x);
   }

flang/test/Semantics/OpenACC/acc-branch.f90

outer: do i=1, N
     end do inner
   end do outer
   !$acc end parallel
   end do name1
 
   ! 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
         exit fortname
         !$acc loop
           do i = 1, N
             a(i) = 3.14
             if(i == N-1) THEN