[flang] Resolve namelist group and object names

Namelist groups are represents by symbols with `NamelistDetails`.
Those contain a list of symbols representing the objects in the group.
References to namelist groups in io-control-spec are resolved.

In `.mod` files, namelist groups are written out at the end of the
module specification section. This is so that the declarations of the
objects in the namelist group appear before they are referenced.

Original-commit: flang-compiler/f18@8b70dbcac7
Reviewed-on: https://github.com/flang-compiler/f18/pull/277
Tree-same-pre-rewrite: false

flang/lib/semantics/mod-file.cc

@@ -164,6 +164,15 @@ void ModFileWriter::PutSymbol(
               PutLower(typeBindings << "=>", *proc) << '\n';
             }
           },
+          [&](const NamelistDetails &x) {
+            PutLower(decls_ << "namelist/", symbol);
+            char sep = '/';
+            for (const auto *object : x.objects()) {
+              PutLower(decls_ << sep, *object);
+              sep = ',';
+            }
+            decls_ << '\n';
+          },
           [&](const FinalProcDetails &) {
             PutLower(typeBindings << "final::", symbol) << '\n';
           },
@@ -280,6 +289,7 @@ void ModFileWriter::PutUseExtraAttr(
 }
 
 // Collect the symbols of this scope sorted by their original order, not name.
+// Namelists are an exception: they are sorted to the end.
 std::vector<const Symbol *> CollectSymbols(const Scope &scope) {
   std::set<const Symbol *> symbols;  // to prevent duplicates
   std::vector<const Symbol *> sorted;
@@ -293,7 +303,13 @@ std::vector<const Symbol *> CollectSymbols(const Scope &scope) {
     }
   }
   std::sort(sorted.begin(), sorted.end(), [](const Symbol *x, const Symbol *y) {
-    return x->name().begin() < y->name().begin();
+    bool xIsNml{x->has<NamelistDetails>()};
+    bool yIsNml{y->has<NamelistDetails>()};
+    if (xIsNml != yIsNml) {
+      return xIsNml < yIsNml;
+    } else {
+      return x->name().begin() < y->name().begin();
+    }
   });
   return sorted;
 }

flang/lib/semantics/resolve-names.cc

@@ -685,6 +685,8 @@ public:
   bool Pre(const parser::AllocateStmt &);
   void Post(const parser::AllocateStmt &);
   bool Pre(const parser::StructureConstructor &);
+  bool Pre(const parser::NamelistStmt::Group &);
+  bool Pre(const parser::IoControlSpec &);
 
 protected:
   bool BeginDecl();
@@ -3002,6 +3004,49 @@ bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) {
   return false;
 }
 
+bool DeclarationVisitor::Pre(const parser::NamelistStmt::Group &x) {
+  if (currScope().kind() == Scope::Kind::Block) {
+    Say("NAMELIST statement is not allowed in a BLOCK construct"_err_en_US);
+    return false;
+  }
+
+  NamelistDetails details;
+  for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {
+    auto *symbol{FindSymbol(name)};
+    if (!symbol) {
+      symbol = &MakeSymbol(name, ObjectEntityDetails{});
+      ApplyImplicitRules(*symbol);
+    } else if (!ConvertToObjectEntity(*symbol)) {
+      SayWithDecl(name, *symbol, "'%s' is not a variable"_err_en_US);
+    }
+    details.add_object(*symbol);
+  }
+
+  const auto &groupName{std::get<parser::Name>(x.t)};
+  auto *groupSymbol{FindInScope(currScope(), groupName)};
+  if (!groupSymbol) {
+    groupSymbol = &MakeSymbol(groupName, std::move(details));
+  } else if (groupSymbol->has<NamelistDetails>()) {
+    groupSymbol->get<NamelistDetails>().add_objects(details.objects());
+  } else {
+    SayAlreadyDeclared(groupName, *groupSymbol);
+  }
+  return false;
+}
+
+bool DeclarationVisitor::Pre(const parser::IoControlSpec &x) {
+  if (const auto *name{std::get_if<parser::Name>(&x.u)}) {
+    auto *symbol{FindSymbol(*name)};
+    if (!symbol) {
+      Say(*name, "Namelist group '%s' not found"_err_en_US);
+    } else if (!symbol->GetUltimate().has<NamelistDetails>()) {
+      SayWithDecl(
+          *name, *symbol, "'%s' is not the name of a namelist group"_err_en_US);
+    }
+  }
+  return true;
+}
+
 Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) {
   auto *prev{FindSymbol(name)};
   bool implicit{false};

flang/lib/semantics/symbol.cc

@@ -152,6 +152,7 @@ std::string DetailsToString(const Details &details) {
           [](const GenericDetails &) { return "Generic"; },
           [](const ProcBindingDetails &) { return "ProcBinding"; },
           [](const GenericBindingDetails &) { return "GenericBinding"; },
+          [](const NamelistDetails &) { return "Namelist"; },
           [](const FinalProcDetails &) { return "FinalProc"; },
           [](const TypeParamDetails &) { return "TypeParam"; },
           [](const MiscDetails &) { return "Misc"; },
@@ -376,6 +377,12 @@ std::ostream &operator<<(std::ostream &os, const Details &details) {
               sep = ',';
             }
           },
+          [&](const NamelistDetails &x) {
+            os << ": ";
+            for (const auto *object : x.objects()) {
+              os << ' ' << object->name();
+            }
+          },
           [&](const FinalProcDetails &) {},
           [&](const TypeParamDetails &x) {
             if (x.type()) {

flang/lib/semantics/symbol.h

@@ -246,6 +246,18 @@ private:
   SymbolList specificProcs_;
 };
 
+class NamelistDetails {
+public:
+  const SymbolList &objects() const { return objects_; }
+  void add_object(const Symbol &object) { objects_.push_back(&object); }
+  void add_objects(const SymbolList &objects) {
+    objects_.insert(objects_.end(), objects.begin(), objects.end());
+  }
+
+private:
+  SymbolList objects_;
+};
+
 class FinalProcDetails {};
 
 class MiscDetails {
@@ -353,8 +365,8 @@ using Details = std::variant<UnknownDetails, MainProgramDetails, ModuleDetails,
     SubprogramDetails, SubprogramNameDetails, EntityDetails,
     ObjectEntityDetails, ProcEntityDetails, AssocEntityDetails,
     DerivedTypeDetails, UseDetails, UseErrorDetails, HostAssocDetails,
-    GenericDetails, ProcBindingDetails, GenericBindingDetails, FinalProcDetails,
-    TypeParamDetails, MiscDetails>;
+    GenericDetails, ProcBindingDetails, GenericBindingDetails, NamelistDetails,
+    FinalProcDetails, TypeParamDetails, MiscDetails>;
 std::ostream &operator<<(std::ostream &, const Details &);
 std::string DetailsToString(const Details &);
 

flang/test/semantics/CMakeLists.txt

@@ -65,6 +65,7 @@ set(ERROR_TESTS
   resolve37.f90
   resolve38.f90
   resolve39.f90
+  resolve40.f90
 )
 
 # These test files have expected symbols in the source
@@ -104,6 +105,7 @@ set(MODFILE_TESTS
   modfile16.f90
   modfile17.f90
   modfile18.f90
+  modfile19.f90
 )
 
 set(LABEL_TESTS

flang/test/semantics/modfile19.f90

@@ -0,0 +1,33 @@
+! Copyright (c) 2019, 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.
+
+module m
+  implicit complex(8)(z)
+  real :: x
+  namelist /nl1/ x, y
+  namelist /nl2/ y, x
+  namelist /nl1/ i, z
+  complex(8) :: z
+  real :: y
+end
+
+!Expect: m.mod
+!module m
+!  real(4)::x
+!  real(4)::y
+!  integer(4)::i
+!  complex(8)::z
+!  namelist/nl1/x,y,i,z
+!  namelist/nl2/y,x
+!end

flang/test/semantics/resolve40.f90

@@ -0,0 +1,76 @@
+! Copyright (c) 2019, 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.
+
+subroutine s1
+  namelist /nl/x
+  block
+    !ERROR: NAMELIST statement is not allowed in a BLOCK construct
+    namelist /nl/y
+  end block
+end
+
+subroutine s2
+  open(12, file='nl.out')
+  !ERROR: Namelist group 'nl' not found
+  write(12, nml=nl)
+end
+
+subroutine s3
+  real :: x
+  open(12, file='nl.out')
+  !ERROR: 'x' is not the name of a namelist group
+  write(12, nml=x)
+end
+
+module m4
+  real :: x
+  namelist /nl/x
+end
+subroutine s4a
+  use m4
+  namelist /nl2/x
+  open(12, file='nl.out')
+  write(12, nml=nl)
+  write(12, nml=nl2)
+end
+subroutine s4b
+  use m4
+  real :: y
+  !ERROR: 'nl' is already declared in this scoping unit
+  namelist /nl/y
+end
+
+subroutine s5
+  namelist /nl/x
+  !ERROR: The type of 'x' has already been implicitly declared
+  integer x
+end
+
+subroutine s6
+  !ERROR: 's6' is not a variable
+  namelist /nl/ s6
+  !ERROR: 'f' is not a variable
+  namelist /nl/ f
+contains
+  integer function f()
+    f = 1
+  end
+end
+
+subroutine s7
+  real x
+  namelist /nl/ x
+  !ERROR: EXTERNAL attribute not allowed on 'x'
+  external x
+end