[flang-commits] [flang] 594700c - [flang] Warn about construct names that are not distinct in the inclusive scope

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-02-12T11:42:38-08:00
New Revision: 594700c12247e64a623043164fc10a93d59f5068

URL: https://github.com/llvm/llvm-project/commit/594700c12247e64a623043164fc10a93d59f5068
DIFF: https://github.com/llvm/llvm-project/commit/594700c12247e64a623043164fc10a93d59f5068.diff

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

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.

Differential Revision: https://reviews.llvm.org/D143776

Added: 
    

Modified: 
    flang/docs/Extensions.md
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/OpenACC/acc-branch.f90

Removed: 
    


################################################################################
diff  --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 928fe07a79068..69b3f10ac26ab 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -79,6 +79,11 @@ end
   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
index 12e4f4dd2d994..77ce3bcc0c377 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -553,6 +553,7 @@ class ScopeHandler : public ImplicitRulesVisitor {
   // 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(
 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 @@ void ConstructVisitor::Post(const parser::SelectRankConstruct &) {
 }
 
 bool ConstructVisitor::CheckDef(const std::optional<parser::Name> &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
index ec6280b88d584..9035775a3f765 100644
--- a/flang/test/Semantics/OpenACC/acc-branch.f90
+++ b/flang/test/Semantics/OpenACC/acc-branch.f90
@@ -53,6 +53,7 @@ program openacc_clause_validity
   ! 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