[flang] More name resolution for construct entities

Push a new scope for constructs and statements that require one
(DataStmt, DO CONCURRENT, ForallConstruct, ForallStmt -- there are more
to do). Currently we use the Block kind of scope because there is no
difference. Perhaps that kind should be renamed to Construct, though it
does apply to statements as well as constructs.

Add DeclareConstructEntity to create a construct or statement entity.
When the type is not specified it can come from the type of a symbol in
the enclosing scope with the same name. Change DeclareObjectEntity et al.
to return the symbol declared, for the benefit of DeclareConstructEntity.

Use DeclareConstructEntity for DO CONCURRENT index-name, LOCAL, and
LOCAL_INIT variables and the data-i-do-variable in DataImpliedDo

Names in SHARED locality spec need special handling: create a new kinds
of symbol with HostAssocDetails to represent the host-association of the
shared variables within the construct scope. That symbol gets the
LocalityShared flag without affecting the symbol in the outer scope.
HostAssoc symbols may be useful in other contexts, e.g. up-level
references to local variables.

Add parser::DoConstruct::IsDoConcurrent() because DO CONCURRENT loops
introduce a construct scope while other DO loops do not.

Move CanonicalizeDo to before name resolution so that name resolution
doesn't have to deal with labeled DO CONCURRENT loops.

Allow for type of index name to be specified in ConcurrentHeader.

Resolve the derived type name in an AllocateStmt, StructureConstructor

Original-commit: flang-compiler/f18@bc7b989136
Reviewed-on: https://github.com/flang-compiler/f18/pull/214

flang/lib/parser/parse-tree.cc

@@ -65,6 +65,12 @@ Expr::Expr(Designator &&x)
 Expr::Expr(FunctionReference &&x)
   : u{common::Indirection<FunctionReference>::Make(std::move(x))} {}
 
+bool DoConstruct::IsDoConcurrent() const {
+  auto &doStmt{std::get<Statement<NonLabelDoStmt>>(t).statement};
+  auto &control{std::get<std::optional<LoopControl>>(doStmt.t)};
+  return control && std::holds_alternative<LoopControl::Concurrent>(control->u);
+}
+
 static Designator MakeArrayElementRef(Name &name, std::list<Expr> &subscripts) {
   ArrayElement arrayElement{name, std::list<SectionSubscript>{}};
   for (Expr &expr : subscripts) {

flang/lib/parser/parse-tree.h

@@ -2202,6 +2202,7 @@ WRAPPER_CLASS(EndDoStmt, std::optional<Name>);
 // CONTINUE; multiple "label DO" loops ending on the same label
 struct DoConstruct {
   TUPLE_CLASS_BOILERPLATE(DoConstruct);
+  bool IsDoConcurrent() const;
   std::tuple<Statement<NonLabelDoStmt>, Block, Statement<EndDoStmt>> t;
 };
 

flang/lib/semantics/mod-file.cc

@@ -155,6 +155,7 @@ void ModFileWriter::PutSymbol(const Symbol &symbol, bool &didContains) {
             }
             PutLower(decls_ << "final::", symbol) << '\n';
           },
+          [](const HostAssocDetails &) {},
           [&](const auto &) { PutEntity(decls_, symbol); }},
       symbol.details());
 }

flang/lib/semantics/resolve-names.cc

@@ -165,9 +165,6 @@ public:
   bool Pre(const parser::DeclarationTypeSpec::Record &);
   void Post(const parser::TypeParamSpec &);
   void Post(const parser::TypeParamValue &);
-  void Post(const parser::StructureConstructor &);
-  bool Pre(const parser::AllocateStmt &);
-  void Post(const parser::AllocateStmt &);
   bool Pre(const parser::TypeGuardStmt &);
   void Post(const parser::TypeGuardStmt &);
 
@@ -180,6 +177,7 @@ protected:
   void BeginDeclTypeSpec();
   void EndDeclTypeSpec();
   void BeginDerivedTypeSpec(DerivedTypeSpec &);
+  bool IsDerivedTypeSpec() const { return derivedTypeSpec_ != nullptr; }
   void SetDerivedDeclTypeSpec(DeclTypeSpec::Category);
 
 private:
@@ -591,10 +589,18 @@ public:
   void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &);
   void Post(const parser::TypeBoundProcedureStmt::WithInterface &);
   void Post(const parser::FinalProcedureStmt &);
+  bool Pre(const parser::AllocateStmt &);
+  void Post(const parser::AllocateStmt &);
+  bool Pre(const parser::StructureConstructor &);
+  void Post(const parser::StructureConstructor &);
 
 protected:
   bool BeginDecl();
   void EndDecl();
+  // Declare a construct or statement entity. If there isn't a type specified
+  // it comes from the entity in the containing scope, or implicit rules.
+  // Return pointer to the new symbol, or nullptr on error.
+  Symbol *DeclareConstructEntity(const SourceName &);
   bool CheckUseError(const SourceName &, const Symbol &);
 
 private:
@@ -614,9 +620,9 @@ private:
 
   bool HandleAttributeStmt(Attr, const std::list<parser::Name> &);
   Symbol &HandleAttributeStmt(Attr, const SourceName &);
-  void DeclareUnknownEntity(const SourceName &, Attrs);
-  void DeclareObjectEntity(const SourceName &, Attrs);
-  void DeclareProcEntity(const SourceName &, Attrs, const ProcInterface &);
+  Symbol &DeclareUnknownEntity(const SourceName &, Attrs);
+  Symbol &DeclareObjectEntity(const SourceName &, Attrs);
+  Symbol &DeclareProcEntity(const SourceName &, Attrs, const ProcInterface &);
   void SetType(const SourceName &, Symbol &, const DeclTypeSpec &);
   const Symbol *ResolveDerivedType(const SourceName &);
   bool CanBeTypeBoundProc(const Symbol &);
@@ -662,20 +668,40 @@ private:
   }
 };
 
+// Resolve construct entities and statement entities.
 // Check that construct names don't conflict with other names.
-class ConstructNamesVisitor : public virtual ScopeHandler {
+class ConstructVisitor : public DeclarationVisitor {
 public:
-  explicit ConstructNamesVisitor(const IntrinsicTypeDefaultKinds &defaultKinds)
-    : ScopeHandler{defaultKinds} {}
+  explicit ConstructVisitor(const IntrinsicTypeDefaultKinds &defaultKinds)
+    : ScopeHandler{defaultKinds}, DeclarationVisitor{defaultKinds} {}
+
+  template<typename T> void Walk(const T &);
+
+  bool Pre(const parser::ConcurrentHeader &);
+  void Post(const parser::ConcurrentHeader &);
+  bool Pre(const parser::LocalitySpec::Local &);
+  bool Pre(const parser::LocalitySpec::LocalInit &);
+  bool Pre(const parser::LocalitySpec::Shared &);
+  bool Pre(const parser::DataImpliedDo &);
+  bool Pre(const parser::DataStmt &);
+  void Post(const parser::DataStmt &);
+  bool Pre(const parser::DoConstruct &);
+  void Post(const parser::DoConstruct &);
+  void Post(const parser::ConcurrentControl &);
+  bool Pre(const parser::ForallConstruct &);
+  void Post(const parser::ForallConstruct &);
+  bool Pre(const parser::ForallStmt &);
+  void Post(const parser::ForallStmt &);
+  bool Pre(const parser::BlockStmt &);
+  bool Pre(const parser::EndBlockStmt &);
 
   // Definitions of construct names
   bool Pre(const parser::WhereConstructStmt &x) { return CheckDef(x.t); }
   bool Pre(const parser::ForallConstructStmt &x) { return CheckDef(x.t); }
   bool Pre(const parser::AssociateStmt &x) { return CheckDef(x.t); }
-  bool Pre(const parser::BlockStmt &x) { return CheckDef(x.v); }
   bool Pre(const parser::ChangeTeamStmt &x) { return CheckDef(x.t); }
   bool Pre(const parser::CriticalStmt &x) { return CheckDef(x.t); }
-  bool Pre(const parser::LabelDoStmt &x) { return CheckDef(x.t); }
+  bool Pre(const parser::LabelDoStmt &x) { CHECK(false); }
   bool Pre(const parser::NonLabelDoStmt &x) { return CheckDef(x.t); }
   bool Pre(const parser::IfThenStmt &x) { return CheckDef(x.t); }
   bool Pre(const parser::SelectCaseStmt &x) { return CheckDef(x.t); }
@@ -691,7 +717,6 @@ public:
   void Post(const parser::EndWhereStmt &x) { CheckRef(x.v); }
   void Post(const parser::EndForallStmt &x) { CheckRef(x.v); }
   void Post(const parser::EndAssociateStmt &x) { CheckRef(x.v); }
-  void Post(const parser::EndBlockStmt &x) { CheckRef(x.v); }
   void Post(const parser::EndChangeTeamStmt &x) { CheckRef(x.t); }
   void Post(const parser::EndCriticalStmt &x) { CheckRef(x.v); }
   void Post(const parser::EndDoStmt &x) { CheckRef(x.v); }
@@ -714,19 +739,19 @@ private:
   }
   bool CheckDef(const std::optional<parser::Name> &);
   void CheckRef(const std::optional<parser::Name> &);
+  void CheckIntegerType(const Symbol &);
 };
 
 // Walk the parse tree and resolve names to symbols.
 class ResolveNamesVisitor : public virtual ScopeHandler,
                             public ModuleVisitor,
                             public SubprogramVisitor,
-                            public DeclarationVisitor,
-                            public ConstructNamesVisitor {
+                            public ConstructVisitor {
 public:
   using ArraySpecVisitor::Post;
   using ArraySpecVisitor::Pre;
-  using ConstructNamesVisitor::Post;
-  using ConstructNamesVisitor::Pre;
+  using ConstructVisitor::Post;
+  using ConstructVisitor::Pre;
   using DeclarationVisitor::Post;
   using DeclarationVisitor::Pre;
   using ImplicitRulesVisitor::Post;
@@ -741,8 +766,7 @@ public:
   ResolveNamesVisitor(
       Scope &rootScope, const IntrinsicTypeDefaultKinds &defaultKinds)
     : ScopeHandler{defaultKinds}, ModuleVisitor{defaultKinds},
-      SubprogramVisitor{defaultKinds}, DeclarationVisitor{defaultKinds},
-      ConstructNamesVisitor{defaultKinds} {
+      SubprogramVisitor{defaultKinds}, ConstructVisitor{defaultKinds} {
     PushScope(rootScope);
   }
 
@@ -757,15 +781,12 @@ public:
   bool Pre(const parser::MainProgram &);
   void Post(const parser::EndProgramStmt &);
   void Post(const parser::Program &);
-  bool Pre(const parser::BlockStmt &);
-  bool Pre(const parser::EndBlockStmt &);
   bool Pre(const parser::ImplicitStmt &);
   void Post(const parser::PointerObject &);
   void Post(const parser::AllocateObject &);
   void Post(const parser::PointerAssignmentStmt &);
   void Post(const parser::Designator &);
   template<typename T> void Post(const parser::LoopBounds<T> &);
-  void Post(const parser::ConcurrentControl &);
   void Post(const parser::ProcComponentRef &);
   void Post(const parser::ProcedureDesignator &);
   bool Pre(const parser::FunctionReference &);
@@ -957,20 +978,6 @@ bool DeclTypeSpecVisitor::Pre(const parser::DeclarationTypeSpec::Record &x) {
   return true;
 }
 
-void DeclTypeSpecVisitor::Post(const parser::StructureConstructor &) {
-  // TODO: StructureConstructor
-  // TODO: name in derived type spec must be resolved
-  derivedTypeSpec_ = nullptr;
-}
-bool DeclTypeSpecVisitor::Pre(const parser::AllocateStmt &) {
-  BeginDeclTypeSpec();
-  return true;
-}
-void DeclTypeSpecVisitor::Post(const parser::AllocateStmt &) {
-  // TODO: AllocateStmt
-  EndDeclTypeSpec();
-  derivedTypeSpec_ = nullptr;
-}
 bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) {
   BeginDeclTypeSpec();
   return true;
@@ -1339,7 +1346,9 @@ static bool NeedsType(const Symbol &symbol) {
 void ScopeHandler::ApplyImplicitRules(Symbol &symbol) {
   ConvertToObjectEntity(symbol);
   if (NeedsType(symbol)) {
-    if (const auto type{GetImplicitType(symbol)}) {
+    if (isImplicitNoneType()) {
+      Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
+    } else if (const auto type{GetImplicitType(symbol)}) {
       symbol.SetType(*type);
     }
   }
@@ -2164,10 +2173,10 @@ void DeclarationVisitor::Post(const parser::ObjectDecl &x) {
 }
 
 // Declare an entity not yet known to be an object or proc.
-void DeclarationVisitor::DeclareUnknownEntity(
+Symbol &DeclarationVisitor::DeclareUnknownEntity(
     const SourceName &name, Attrs attrs) {
   if (!arraySpec().empty()) {
-    DeclareObjectEntity(name, attrs);
+    return DeclareObjectEntity(name, attrs);
   } else {
     Symbol &symbol{DeclareEntity<EntityDetails>(name, attrs)};
     if (auto &type{GetDeclTypeSpec()}) {
@@ -2176,10 +2185,11 @@ void DeclarationVisitor::DeclareUnknownEntity(
     if (symbol.attrs().test(Attr::EXTERNAL)) {
       ConvertToProcEntity(symbol);
     }
+    return symbol;
   }
 }
 
-void DeclarationVisitor::DeclareProcEntity(
+Symbol &DeclarationVisitor::DeclareProcEntity(
     const SourceName &name, Attrs attrs, const ProcInterface &interface) {
   Symbol &symbol{DeclareEntity<ProcEntityDetails>(name, attrs)};
   if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
@@ -2192,9 +2202,10 @@ void DeclarationVisitor::DeclareProcEntity(
     }
     details->set_interface(interface);
   }
+  return symbol;
 }
 
-void DeclarationVisitor::DeclareObjectEntity(
+Symbol &DeclarationVisitor::DeclareObjectEntity(
     const SourceName &name, Attrs attrs) {
   Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, attrs)};
   if (auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
@@ -2211,6 +2222,7 @@ void DeclarationVisitor::DeclareObjectEntity(
       ClearArraySpec();
     }
   }
+  return symbol;
 }
 
 void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Type &x) {
@@ -2446,6 +2458,53 @@ void DeclarationVisitor::Post(const parser::FinalProcedureStmt &x) {
   }
 }
 
+bool DeclarationVisitor::Pre(const parser::AllocateStmt &) {
+  BeginDeclTypeSpec();
+  return true;
+}
+void DeclarationVisitor::Post(const parser::AllocateStmt &) {
+  if (IsDerivedTypeSpec()) {
+    SetDerivedDeclTypeSpec(DeclTypeSpec::TypeDerived);
+    ResolveDerivedType(GetDeclTypeSpec()->derivedTypeSpec().name());
+  }
+  EndDeclTypeSpec();
+}
+
+bool DeclarationVisitor::Pre(const parser::StructureConstructor &) {
+  BeginDeclTypeSpec();
+  return true;
+}
+void DeclarationVisitor::Post(const parser::StructureConstructor &) {
+  SetDerivedDeclTypeSpec(DeclTypeSpec::TypeDerived);
+  DerivedTypeSpec &type{GetDeclTypeSpec()->derivedTypeSpec()};
+  ResolveDerivedType(type.name());
+  EndDeclTypeSpec();
+}
+
+Symbol *DeclarationVisitor::DeclareConstructEntity(const SourceName &name) {
+  auto *prev{FindSymbol(name)};
+  if (prev) {
+    if (prev->owner() == currScope()) {
+      SayAlreadyDeclared(name, *prev);
+      return nullptr;
+    }
+    prev->remove_occurrence(name);
+  }
+  auto &symbol{DeclareObjectEntity(name, {})};
+  if (symbol.GetType()) {
+    // type came from explicit type-spec
+  } else if (!prev) {
+    ApplyImplicitRules(symbol);
+  } else if (!prev->has<ObjectEntityDetails>() && !prev->has<EntityDetails>()) {
+    Say2(name, "Index name '%s' conflicts with existing identifier"_err_en_US,
+        prev->name(), "Previous declaration of '%s'"_en_US);
+    return nullptr;
+  } else if (auto *type{prev->GetType()}) {
+    symbol.SetType(*type);
+  }
+  return &symbol;
+}
+
 // Set the type of an entity or report an error.
 void DeclarationVisitor::SetType(
     const SourceName &name, Symbol &symbol, const DeclTypeSpec &type) {
@@ -2575,22 +2634,141 @@ bool DeclarationVisitor::OkToAddComponent(
   }
 }
 
-// ConstructNamesVisitor implementation
+// ConstructVisitor implementation
 
-bool ConstructNamesVisitor::CheckDef(const std::optional<parser::Name> &x) {
+template<typename T> void ConstructVisitor::Walk(const T &x) {
+  parser::Walk(x, *static_cast<ResolveNamesVisitor *>(this));
+}
+
+bool ConstructVisitor::Pre(const parser::ConcurrentHeader &) {
+  BeginDeclTypeSpec();
+  return true;
+}
+void ConstructVisitor::Post(const parser::ConcurrentHeader &) {
+  EndDeclTypeSpec();
+}
+
+bool ConstructVisitor::Pre(const parser::LocalitySpec::Local &x) {
+  for (auto &name : x.v) {
+    if (auto *symbol{DeclareConstructEntity(name.source)}) {
+      symbol->set(Symbol::Flag::LocalityLocal);
+    }
+  }
+  return false;
+}
+bool ConstructVisitor::Pre(const parser::LocalitySpec::LocalInit &x) {
+  for (auto &name : x.v) {
+    if (auto *symbol{DeclareConstructEntity(name.source)}) {
+      symbol->set(Symbol::Flag::LocalityLocalInit);
+    }
+  }
+  return false;
+}
+bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) {
+  for (auto &name : x.v) {
+    if (auto *prev{FindSymbol(name.source)}) {
+      if (prev->owner() == currScope()) {
+        SayAlreadyDeclared(name.source, *prev);
+      }
+      auto &symbol{MakeSymbol(name, HostAssocDetails{*prev})};
+      symbol.set(Symbol::Flag::LocalityShared);
+    } else {
+      Say(name.source, "Variable '%s' not found"_err_en_US);
+    }
+  }
+  return false;
+}
+
+bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) {
+  auto &objects{std::get<std::list<parser::DataIDoObject>>(x.t)};
+  auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(x.t)};
+  auto &bounds{
+      std::get<parser::LoopBounds<parser::ScalarIntConstantExpr>>(x.t)};
+  if (type) {
+    BeginDeclTypeSpec();
+    DeclTypeSpecVisitor::Pre(*type);
+  }
+  if (auto *symbol{DeclareConstructEntity(bounds.name.thing.thing.source)}) {
+    CheckIntegerType(*symbol);
+  }
+  if (type) {
+    EndDeclTypeSpec();
+  }
+  Walk(bounds);
+  Walk(objects);
+  return false;
+}
+
+bool ConstructVisitor::Pre(const parser::DataStmt &) {
+  PushScope(Scope::Kind::Block, nullptr);
+  return true;
+}
+void ConstructVisitor::Post(const parser::DataStmt &) { PopScope(); }
+
+bool ConstructVisitor::Pre(const parser::DoConstruct &x) {
+  if (x.IsDoConcurrent()) {
+    PushScope(Scope::Kind::Block, nullptr);
+  }
+  return true;
+}
+void ConstructVisitor::Post(const parser::DoConstruct &x) {
+  if (x.IsDoConcurrent()) {
+    PopScope();
+  }
+}
+
+void ConstructVisitor::Post(const parser::ConcurrentControl &x) {
+  auto &name{std::get<parser::Name>(x.t).source};
+  if (auto *symbol{DeclareConstructEntity(name)}) {
+    CheckIntegerType(*symbol);
+  }
+}
+
+bool ConstructVisitor::Pre(const parser::ForallConstruct &) {
+  PushScope(Scope::Kind::Block, nullptr);
+  return true;
+}
+void ConstructVisitor::Post(const parser::ForallConstruct &) { PopScope(); }
+bool ConstructVisitor::Pre(const parser::ForallStmt &) {
+  PushScope(Scope::Kind::Block, nullptr);
+  return true;
+}
+void ConstructVisitor::Post(const parser::ForallStmt &) { PopScope(); }
+
+bool ConstructVisitor::Pre(const parser::BlockStmt &x) {
+  CheckDef(x.v);
+  PushScope(Scope::Kind::Block, nullptr);
+  return false;
+}
+bool ConstructVisitor::Pre(const parser::EndBlockStmt &x) {
+  PopScope();
+  CheckRef(x.v);
+  return false;
+}
+
+bool ConstructVisitor::CheckDef(const std::optional<parser::Name> &x) {
   if (x) {
     MakeSymbol(*x, MiscDetails{MiscDetails::Kind::ConstructName});
   }
   return true;
 }
 
-void ConstructNamesVisitor::CheckRef(const std::optional<parser::Name> &x) {
+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->source);
   }
 }
 
+void ConstructVisitor::CheckIntegerType(const Symbol &symbol) {
+  if (auto *type{symbol.GetType()}) {
+    if (type->category() != DeclTypeSpec::Intrinsic ||
+        type->intrinsicTypeSpec().category() != TypeCategory::Integer) {
+      Say(symbol.name(), "Variable '%s' is not scalar integer"_err_en_US);
+    }
+  }
+}
+
 // ResolveNamesVisitor implementation
 
 bool ResolveNamesVisitor::Pre(const parser::CommonBlockObject &x) {
@@ -2936,14 +3114,9 @@ void ResolveNamesVisitor::Post(const parser::SpecificationPart &) {
   CheckImports();
   bool inModule{currScope().kind() == Scope::Kind::Module};
   for (auto &pair : currScope()) {
-    auto &name{pair.first};
     auto &symbol{*pair.second};
     if (NeedsExplicitType(symbol)) {
-      if (isImplicitNoneType()) {
-        Say(name, "No explicit type declared for '%s'"_err_en_US);
-      } else {
-        ApplyImplicitRules(symbol);
-      }
+      ApplyImplicitRules(symbol);
     }
     if (symbol.has<GenericDetails>()) {
       CheckGenericProcedures(symbol);
@@ -3004,7 +3177,7 @@ bool ResolveNamesVisitor::Pre(const parser::MainProgram &x) {
   if (auto &subpPart{
           std::get<std::optional<parser::InternalSubprogramPart>>(x.t)}) {
     subpNamesOnly_ = SubprogramKind::Internal;
-    parser::Walk(*subpPart, *static_cast<ResolveNamesVisitor *>(this));
+    Walk(*subpPart);
     subpNamesOnly_ = std::nullopt;
   }
   return true;
@@ -3012,16 +3185,6 @@ bool ResolveNamesVisitor::Pre(const parser::MainProgram &x) {
 
 void ResolveNamesVisitor::Post(const parser::EndProgramStmt &) { PopScope(); }
 
-bool ResolveNamesVisitor::Pre(const parser::BlockStmt &x) {
-  ConstructNamesVisitor::Pre(x);
-  PushScope(Scope::Kind::Block, nullptr);
-  return false;
-}
-bool ResolveNamesVisitor::Pre(const parser::EndBlockStmt &x) {
-  PopScope();
-  ConstructNamesVisitor::Post(x);
-  return false;
-}
 bool ResolveNamesVisitor::Pre(const parser::ImplicitStmt &x) {
   if (currScope().kind() == Scope::Kind::Block) {
     Say("IMPLICIT statement is not allowed in BLOCK construct"_err_en_US);
@@ -3073,7 +3236,7 @@ void ResolveNamesVisitor::Post(const parser::ProcComponentRef &x) {
 }
 void ResolveNamesVisitor::Post(const parser::TypeGuardStmt &x) {
   DeclTypeSpecVisitor::Post(x);
-  ConstructNamesVisitor::Post(x);
+  ConstructVisitor::Post(x);
 }
 bool ResolveNamesVisitor::Pre(const parser::StmtFunctionStmt &x) {
   if (!HandleStmtFunction(x)) {
@@ -3085,9 +3248,6 @@ bool ResolveNamesVisitor::Pre(const parser::StmtFunctionStmt &x) {
   }
   return true;
 }
-void ResolveNamesVisitor::Post(const parser::ConcurrentControl &x) {
-  ResolveName(std::get<parser::Name>(x.t).source);
-}
 
 void ResolveNamesVisitor::Post(const parser::Program &) {
   // ensure that all temps were deallocated
@@ -3103,7 +3263,7 @@ void ResolveNames(parser::Messages &messages, Scope &rootScope,
   for (auto &dir : searchDirectories) {
     visitor.add_searchDirectory(dir);
   }
-  parser::Walk(program, visitor);
+  visitor.Walk(program);
   messages.Annex(visitor.messages());
 }
 

flang/lib/semantics/rewrite-parse-tree.cc

@@ -50,7 +50,6 @@ public:
   bool Pre(parser::EquivalenceStmt &) { return false; }
   bool Pre(parser::BindEntity &) { return false; }
   bool Pre(parser::Keyword &) { return false; }
-  bool Pre(parser::DataStmtValue &) { return false; }
   bool Pre(parser::SavedEntity &) { return false; }
   bool Pre(parser::EntryStmt &) { return false; }
 

flang/lib/semantics/semantics.cc

@@ -45,6 +45,7 @@ bool Semantics::Perform(parser::Program &program) {
   if (AnyFatalError()) {
     return false;
   }
+  parser::CanonicalizeDo(program);
   ResolveNames(messages_, globalScope_, program, directories_, defaultKinds_);
   if (AnyFatalError()) {
     return false;
@@ -53,7 +54,6 @@ bool Semantics::Perform(parser::Program &program) {
   if (AnyFatalError()) {
     return false;
   }
-  parser::CanonicalizeDo(program);
   ModFileWriter writer;
   writer.set_directory(moduleDirectory_);
   if (!writer.WriteAll(globalScope_)) {

flang/lib/semantics/symbol.cc

@@ -126,6 +126,7 @@ std::string DetailsToString(const Details &details) {
           [](const DerivedTypeDetails &) { return "DerivedType"; },
           [](const UseDetails &) { return "Use"; },
           [](const UseErrorDetails &) { return "UseError"; },
+          [](const HostAssocDetails &) { return "HostAssoc"; },
           [](const GenericDetails &) { return "Generic"; },
           [](const ProcBindingDetails &) { return "ProcBinding"; },
           [](const GenericBindingDetails &) { return "GenericBinding"; },
@@ -184,6 +185,8 @@ Symbol &Symbol::GetUltimate() {
 const Symbol &Symbol::GetUltimate() const {
   if (const auto *details{detailsIf<UseDetails>()}) {
     return details->symbol().GetUltimate();
+  } else if (const auto *details{detailsIf<HostAssocDetails>()}) {
+    return details->symbol().GetUltimate();
   } else {
     return *this;
   }
@@ -202,9 +205,7 @@ const DeclTypeSpec *Symbol::GetType() const {
           [](const TypeParamDetails &x) {
             return x.type().has_value() ? &x.type().value() : nullptr;
           },
-          [](const auto &) {
-            return static_cast<const DeclTypeSpec *>(nullptr);
-          },
+          [](const auto &) -> const DeclTypeSpec * { return nullptr; },
       },
       details_);
 }
@@ -259,6 +260,7 @@ int Symbol::Rank() const {
             return 0; /*TODO*/
           },
           [](const UseDetails &x) { return x.symbol().Rank(); },
+          [](const HostAssocDetails &x) { return x.symbol().Rank(); },
           [](const ObjectEntityDetails &oed) {
             return static_cast<int>(oed.shape().size());
           },
@@ -374,6 +376,7 @@ std::ostream &operator<<(std::ostream &os, const Details &details) {
               os << " from " << pair.second->name() << " at " << *pair.first;
             }
           },
+          [](const HostAssocDetails &) {},
           [&](const GenericDetails &x) {
             for (const auto *proc : x.specificProcs()) {
               os << ' ' << proc->name();
@@ -466,6 +469,15 @@ std::ostream &DumpForUnparse(
     if (symbol.test(Symbol::Flag::Implicit)) {
       os << " (implicit)";
     }
+    if (symbol.test(Symbol::Flag::LocalityLocal)) {
+      os << " (local)";
+    }
+    if (symbol.test(Symbol::Flag::LocalityLocalInit)) {
+      os << " (local_init)";
+    }
+    if (symbol.test(Symbol::Flag::LocalityShared)) {
+      os << " (shared)";
+    }
     os << ' ' << symbol.GetDetailsName();
     if (const auto *type{symbol.GetType()}) {
       os << ' ' << *type;

flang/lib/semantics/symbol.h

@@ -230,6 +230,16 @@ private:
   listType occurrences_;
 };
 
+// A symbol host-associated from an enclosing scope.
+class HostAssocDetails {
+public:
+  HostAssocDetails(const Symbol &symbol) : symbol_{&symbol} {}
+  const Symbol &symbol() const { return *symbol_; }
+
+private:
+  const Symbol *symbol_;
+};
+
 class GenericDetails {
 public:
   using listType = std::list<const Symbol *>;
@@ -276,8 +286,8 @@ class UnknownDetails {};
 using Details = std::variant<UnknownDetails, MainProgramDetails, ModuleDetails,
     SubprogramDetails, SubprogramNameDetails, EntityDetails,
     ObjectEntityDetails, ProcEntityDetails, DerivedTypeDetails, UseDetails,
-    UseErrorDetails, GenericDetails, ProcBindingDetails, GenericBindingDetails,
-    FinalProcDetails, TypeParamDetails, MiscDetails>;
+    UseErrorDetails, HostAssocDetails, GenericDetails, ProcBindingDetails,
+    GenericBindingDetails, FinalProcDetails, TypeParamDetails, MiscDetails>;
 std::ostream &operator<<(std::ostream &, const Details &);
 std::string DetailsToString(const Details &);
 
@@ -288,7 +298,10 @@ public:
       Subroutine,  // symbol is a subroutine
       Implicit,  // symbol is implicitly typed
       ModFile,  // symbol came from .mod file
-      ParentComp  // symbol is the "parent component" of an extended type
+      ParentComp,  // symbol is the "parent component" of an extended type
+      LocalityLocal,  // named in LOCAL locality-spec
+      LocalityLocalInit,  // named in LOCAL_INIT locality-spec
+      LocalityShared  // named in SHARED locality-spec
   );
   using Flags = common::EnumSet<Flag, Flag_enumSize>;
 

flang/test/semantics/CMakeLists.txt

@@ -72,6 +72,7 @@ set(SYMBOL_TESTS
   symbol06.f90
   symbol07.f90
   symbol08.f90
+  symbol09.f90
 )
 
 # These test files have expected .mod file contents in the source

flang/test/semantics/resolve35.f90

@@ -29,3 +29,69 @@ subroutine s2(x)
   foo: do i = 1, 10
   end do foo
 end
+
+subroutine s3
+  real :: a(10,10), b(10,10)
+  type y; end type
+  integer(8) :: x
+  !ERROR: Index name 'y' conflicts with existing identifier
+  forall(x=1:10, y=1:10)
+    a(x, y) = b(x, y)
+  end forall
+  !ERROR: Index name 'y' conflicts with existing identifier
+  forall(x=1:10, y=1:10) a(x, y) = b(x, y)
+end
+
+subroutine s4
+  real :: a(10), b(10)
+  complex :: x
+  !ERROR: Variable 'x' is not scalar integer
+  forall(x=1:10)
+    a(x) = b(x)
+  end forall
+  !ERROR: Variable 'y' is not scalar integer
+  forall(y=1:10)
+    a(y) = b(y)
+  end forall
+end
+
+subroutine s5
+  real :: a(10), b(10)
+  !ERROR: 'i' is already declared in this scoping unit
+  forall(i=1:10, i=1:10)
+    a(i) = b(i)
+  end forall
+end
+
+subroutine s6
+  integer, parameter :: n = 4
+  real, dimension(n) :: x
+  data(x(i), i=1, n) / n * 0.0 /
+  !ERROR: Index name 't' conflicts with existing identifier
+  data(x(t), t=1, n) / n * 0.0 /
+contains
+  subroutine t
+  end
+end
+
+subroutine s7
+  !ERROR: 'i' is already declared in this scoping unit
+  do concurrent(integer::i=1:5) local(j, i) &
+      !ERROR: 'j' is already declared in this scoping unit
+      local_init(k, j) &
+      !ERROR: Variable 'a' not found
+      shared(a)
+    a(i) = j + 1
+  end do
+end
+
+subroutine s8
+  implicit none
+  !ERROR: No explicit type declared for 'i'
+  do concurrent(i=1:5) &
+    !ERROR: No explicit type declared for 'j'
+    local(j) &
+    !ERROR: No explicit type declared for 'k'
+    local_init(k)
+  end do
+end

flang/test/semantics/symbol09.f90

@@ -0,0 +1,130 @@
+! Copyright (c) 2018, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+!DEF: /s1 Subprogram
+subroutine s1
+ !DEF: /s1/a ObjectEntity REAL(4)
+ !DEF: /s1/b ObjectEntity REAL(4)
+ real a(10), b(10)
+ !DEF: /s1/i ObjectEntity INTEGER(8)
+ integer(kind=8) i
+ !DEF: /s1/Block1/i ObjectEntity INTEGER(8)
+ forall(i=1:10)
+  !REF: /s1/a
+  !REF: /s1/Block1/i
+  !REF: /s1/b
+  a(i) = b(i)
+ end forall
+ !DEF: /s1/Block2/i ObjectEntity INTEGER(8)
+ !REF: /s1/a
+ !REF: /s1/b
+ forall(i=1:10)a(i) = b(i)
+end subroutine
+
+!DEF: /s2 Subprogram
+subroutine s2
+ !DEF: /s2/a ObjectEntity REAL(4)
+ real a(10)
+ !DEF: /s2/i ObjectEntity INTEGER(4)
+ integer i
+ !DEF: /s2/Block1/i ObjectEntity INTEGER(4)
+ do concurrent(i=1:10)
+  !REF: /s2/a
+  !REF: /s2/Block1/i
+  a(i) = i
+ end do
+ !REF: /s2/i
+ do i=1,10
+  !REF: /s2/a
+  !REF: /s2/i
+  a(i) = i
+ end do
+end subroutine
+
+!DEF: /s3 Subprogram
+subroutine s3
+ !DEF: /s3/n PARAMETER ObjectEntity INTEGER(4)
+ integer, parameter :: n = 4
+ !DEF: /s3/n2 PARAMETER ObjectEntity INTEGER(4)
+ !REF: /s3/n
+ integer, parameter :: n2 = n*n
+ !REF: /s3/n
+ !DEF: /s3/x ObjectEntity REAL(4)
+ real, dimension(n,n) :: x
+ !REF: /s3/x
+ !DEF: /s3/Block1/k (implicit) ObjectEntity INTEGER(4)
+ !DEF: /s3/Block1/j ObjectEntity INTEGER(8)
+ !REF: /s3/n
+ !REF: /s3/n2
+ data ((x(k,j),integer(kind=8)::j=1,n),k=1,n)/n2*3.0/
+end subroutine
+
+!DEF: /s4 Subprogram
+subroutine s4
+ !DEF: /s4/t DerivedType
+ !DEF: /s4/t/k TypeParam INTEGER(4)
+ type :: t(k)
+  !REF: /s4/t/k
+  integer, kind :: k
+  !DEF: /s4/t/a ObjectEntity INTEGER(4)
+  integer :: a
+ end type t
+ !REF: /s4/t
+ !DEF: /s4/x ObjectEntity TYPE(t)
+ type(t(1)) :: x
+ !REF: /s4/x
+ !REF: /s4/t
+ data x/t(1)(2)/
+ !REF: /s4/x
+ !REF: /s4/t
+ x = t(1)(2)
+end subroutine
+
+!DEF: /s5 Subprogram
+subroutine s5
+ !DEF: /s5/t DerivedType
+ !DEF: /s5/t/l TypeParam INTEGER(4)
+ type :: t(l)
+  !REF: /s5/t/l
+  integer, len :: l
+ end type t
+ !REF: /s5/t
+ !DEF: /s5/x ALLOCATABLE ObjectEntity TYPE(t)
+ type(t(:)), allocatable :: x
+ !DEF: /s5/y ALLOCATABLE ObjectEntity REAL(4)
+ real, allocatable :: y
+ !REF: /s5/t
+ !REF: /s5/x
+ allocate(t(1)::x)
+ !REF: /s5/y
+ allocate(real::y)
+end subroutine
+
+!DEF: /s6 Subprogram
+subroutine s6
+ !DEF: /s6/j ObjectEntity INTEGER(8)
+ integer(kind=8) j
+ !DEF: /s6/a ObjectEntity INTEGER(4)
+ integer :: a(5) = 1
+ !DEF: /s6/Block1/i ObjectEntity INTEGER(4)
+ !DEF: /s6/Block1/j (local) ObjectEntity INTEGER(8)
+ !DEF: /s6/Block1/k (implicit) (local_init) ObjectEntity INTEGER(4)
+ !REF: /s6/a
+ do concurrent(integer::i=1:5)local(j)local_init(k)shared(a)
+  !DEF: /s6/Block1/a (shared) HostAssoc
+  !REF: /s6/Block1/i
+  !REF: /s6/Block1/j
+  a(i) = j+1
+ end do
+end subroutine