[flang] Address review comments

Change IsModule to a member function of Scope.

Make multiple PRIVATE statements in a derived type be a non-fatal error.

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

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index d9d3cd2ff8e8191e8c276524f1d34f1acd234913..00cd44d5b4152a4697d436ba725ba5aa16f95730 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -36,7 +36,6 @@ using namespace parser::literals;
 class MessageHandler;
 
 static GenericSpec MapGenericSpec(const parser::GenericSpec &);
-static bool IsModule(const Scope &);
 
 // ImplicitRules maps initial character of identifier to the DeclTypeSpec
 // representing the implicit type; std::nullopt if none.
@@ -2127,7 +2126,7 @@ bool DeclarationVisitor::Pre(const parser::TypeAttrSpec::Extends &x) {
 }
 
 bool DeclarationVisitor::Pre(const parser::PrivateStmt &x) {
-  if (!IsModule(currScope().parent())) {
+  if (!currScope().parent().IsModule()) {
     Say("PRIVATE is only allowed in a derived type that is"
         " in a module"_err_en_US);  // C766
   } else if (derivedTypeInfo_.sawContains) {
@@ -2136,7 +2135,7 @@ bool DeclarationVisitor::Pre(const parser::PrivateStmt &x) {
     derivedTypeInfo_.privateComps = true;
   } else {
     Say("PRIVATE may not appear more than once in"
-      " derived type components"_err_en_US);  // C738
+        " derived type components"_en_US);  // C738
   }
   return false;
 }
@@ -2362,7 +2361,7 @@ bool ResolveNamesVisitor::Pre(const parser::ImportStmt &x) {
   // Check C896 and C899: where IMPORT statements are allowed
   switch (scope.kind()) {
   case Scope::Kind::Module:
-    if (IsModule(scope)) {
+    if (scope.IsModule()) {
       Say("IMPORT is not allowed in a module scoping unit"_err_en_US);
       return false;
     } else if (x.kind == common::ImportKind::None) {
@@ -2886,12 +2885,6 @@ static GenericSpec MapGenericSpec(const parser::GenericSpec &genericSpec) {
       genericSpec.u);
 }
 
-// Is this a scope for a module (and not a submodule)?
-static bool IsModule(const Scope &scope) {
-  return scope.kind() == Scope::Kind::Module &&
-      !scope.symbol()->get<ModuleDetails>().isSubmodule();
-}
-
 static void PutIndent(std::ostream &os, int indent) {
   for (int i = 0; i < indent; ++i) {
     os << "  ";

diff --git a/flang/lib/semantics/scope.cc b/flang/lib/semantics/scope.cc
index 857e04255d5c8d85f9fca756e9a4ff4c261d7c30..e4ed1df1c60f743e3e23a1a9e10a420468435b84 100644 (file)
--- a/flang/lib/semantics/scope.cc
+++ b/flang/lib/semantics/scope.cc
@@ -23,6 +23,10 @@ Scope Scope::globalScope{Scope::systemScope, Scope::Kind::Global, nullptr};
 
 Symbols<1024> Scope::allSymbols;
 
+bool Scope::IsModule() const {
+  return kind_ == Kind::Module && !symbol_->get<ModuleDetails>().isSubmodule();
+}
+
 Scope &Scope::MakeScope(Kind kind, Symbol *symbol) {
   children_.emplace_back(*this, kind, symbol);
   return children_.back();

diff --git a/flang/lib/semantics/scope.h b/flang/lib/semantics/scope.h
index 4723d3c63ab52a75d3d1879f4cfa6ca76b0edea4..c786e517d6b1066f9359345589c56d7b0660f6c3 100644 (file)
--- a/flang/lib/semantics/scope.h
+++ b/flang/lib/semantics/scope.h
@@ -60,6 +60,7 @@ public:
     return parent_;
   }
   Kind kind() const { return kind_; }
+  bool IsModule() const;  // only module, not submodule
   Symbol *symbol() { return symbol_; }
   const Symbol *symbol() const { return symbol_; }
 

diff --git a/flang/test/semantics/resolve31.f90 b/flang/test/semantics/resolve31.f90
index 7469c78a71dccb2f74f400d2cca71a40ab705427..9e3f800b59ce4460e531f2be8a9ecbd47fea9435 100644 (file)
--- a/flang/test/semantics/resolve31.f90
+++ b/flang/test/semantics/resolve31.f90
@@ -53,8 +53,7 @@ module m4
   type :: t1
     private
     sequence
-    !ERROR: PRIVATE may not appear more than once in derived type components
-    private
+    private  ! not a fatal error
   end type
   !ERROR: A sequence type may not have the EXTENDS attribute
   type, extends(t1) :: t2