[flang] Add semantic checks C8104, C8105. Add tests for C8103, C8104, C8105

Original-commit: flang-compiler/f18@8134fc477e
Reviewed-on: https://github.com/flang-compiler/f18/pull/1037

flang/lib/Semantics/CMakeLists.txt

@@ -21,6 +21,7 @@ add_library(FortranSemantics
   check-do-forall.cpp
   check-if-stmt.cpp
   check-io.cpp
+  check-namelist.cpp
   check-nullify.cpp
   check-omp-structure.cpp
   check-purity.cpp

flang/lib/Semantics/check-namelist.cpp

@@ -0,0 +1,40 @@
+//===-- lib/Semantics/check-namelist.cpp ----------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "check-namelist.h"
+
+namespace Fortran::semantics {
+
+void NamelistChecker::Leave(const parser::NamelistStmt &nmlStmt) {
+  for (const auto &x : nmlStmt.v) {
+    if (const auto *nml{std::get<parser::Name>(x.t).symbol}) {
+      for (const auto &nmlObjName : std::get<std::list<parser::Name>>(x.t)) {
+        const auto *nmlObjSymbol{nmlObjName.symbol};
+        if (nmlObjSymbol && nmlObjSymbol->has<ObjectEntityDetails>()) {
+          const auto *symDetails{
+              std::get_if<ObjectEntityDetails>(&nmlObjSymbol->details())};
+          if (symDetails && symDetails->IsAssumedSize()) {  // C8104
+            context_.Say(nmlObjName.source,
+                "A namelist group object '%s' must not be"
+                " assumed-size"_err_en_US,
+                nmlObjSymbol->name());
+          }
+          if (nml->attrs().test(Attr::PUBLIC) &&
+              nmlObjSymbol->attrs().test(Attr::PRIVATE)) {  // C8105
+            context_.Say(nmlObjName.source,
+                "A PRIVATE namelist group object '%s' must not be in a "
+                "PUBLIC namelist"_err_en_US,
+                nmlObjSymbol->name());
+          }
+        }
+      }
+    }
+  }
+}
+
+}

flang/lib/Semantics/check-namelist.h

@@ -0,0 +1,25 @@
+//===-------lib/Semantics/check-namelist.h --------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_SEMANTICS_CHECK_NAMELIST_H_
+#define FORTRAN_SEMANTICS_CHECK_NAMELIST_H_
+
+#include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/semantics.h"
+
+namespace Fortran::semantics {
+class NamelistChecker : public virtual BaseChecker {
+public:
+  NamelistChecker(SemanticsContext &context) : context_{context} {}
+  void Leave(const parser::NamelistStmt &);
+
+private:
+  SemanticsContext &context_;
+};
+}
+#endif  // FORTRAN_SEMANTICS_CHECK_NAMELIST_H_

flang/lib/Semantics/semantics.cpp

@@ -19,6 +19,7 @@
 #include "check-do-forall.h"
 #include "check-if-stmt.h"
 #include "check-io.h"
+#include "check-namelist.h"
 #include "check-nullify.h"
 #include "check-omp-structure.h"
 #include "check-purity.h"
@@ -111,11 +112,11 @@ private:
 };
 
 using StatementSemanticsPass1 = ExprChecker;
-using StatementSemanticsPass2 = SemanticsVisitor<
-    AllocateChecker, ArithmeticIfStmtChecker, AssignmentChecker, CoarrayChecker,
-    DataChecker, DeallocateChecker, DoForallChecker, IfStmtChecker, IoChecker,
-    NullifyChecker, OmpStructureChecker, PurityChecker, ReturnStmtChecker,
-    StopChecker>;
+using StatementSemanticsPass2 = SemanticsVisitor<AllocateChecker,
+    ArithmeticIfStmtChecker, AssignmentChecker, CoarrayChecker, DataChecker,
+    DeallocateChecker, DoForallChecker, IfStmtChecker, IoChecker,
+    NamelistChecker, NullifyChecker, OmpStructureChecker, PurityChecker,
+    ReturnStmtChecker, StopChecker>;
 
 static bool PerformStatementSemantics(
     SemanticsContext &context, parser::Program &program) {

flang/test/Semantics/CMakeLists.txt

@@ -213,6 +213,7 @@ set(ERROR_TESTS
   block-data01.f90
   complex01.f90
   data01.f90
+  namelist01.f90
 )
 
 # These test files have expected symbols in the source

flang/test/Semantics/namelist01.f90

@@ -0,0 +1,49 @@
+! Test for checking namelist constraints, C8103-C8105
+
+module dup
+  integer dupName
+  integer uniqueName
+end module dup
+
+subroutine C8103a(x)
+  use dup, only: uniqueName, dupName
+  integer :: x
+  !ERROR: 'dupname' is already declared in this scoping unit
+  namelist /dupName/ x, x
+end subroutine C8103a
+
+subroutine C8103b(y)
+  use dup, only: uniqueName
+  integer :: y
+  namelist /dupName/ y, y
+end subroutine C8103b
+
+subroutine C8104a(ivar, jvar)
+  integer :: ivar(10,8)
+  integer :: jvar(*)
+  NAMELIST /NLIST/ ivar
+  !ERROR: A namelist group object 'jvar' must not be assumed-size
+  NAMELIST /NLIST/ jvar
+end subroutine C8104a
+
+subroutine C8104b(ivar, jvar)
+  integer, dimension(*) :: jvar
+  !ERROR: A namelist group object 'jvar' must not be assumed-size
+  NAMELIST /NLIST/ ivar, jvar
+end subroutine C8104b
+
+subroutine C8104c(jvar)
+  integer :: jvar(10, 3:*)
+  !ERROR: A namelist group object 'jvar' must not be assumed-size
+  NAMELIST /NLIST/ jvar
+end subroutine C8104c
+
+module C8105
+  integer, private :: x
+  public :: NLIST
+  !ERROR: A PRIVATE namelist group object 'x' must not be in a PUBLIC namelist
+  NAMELIST /NLIST/ x
+  !ERROR: A PRIVATE namelist group object 'x' must not be in a PUBLIC namelist
+  NAMELIST /NLIST2/ x
+  public :: NLIST2
+end module C8105