[flang] Simplify name resolution visitor for parser::Enumerator

Do not define a Pre and a Post, simply walk the expression
with Walk in Pre to resolve the names inside the expression
before evaluating it.

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

diff --git a/flang/lib/evaluate/tools.h b/flang/lib/evaluate/tools.h
index 7658dc9..7c4068b 100644 (file)
--- a/flang/lib/evaluate/tools.h
+++ b/flang/lib/evaluate/tools.h
@@ -747,5 +747,12 @@ template<typename A> const semantics::Symbol *GetLastTarget(const A &x) {
 // Resolve any whole ASSOCIATE(B=>A) associations
 const semantics::Symbol &ResolveAssociations(const semantics::Symbol &);
 
+// Increment Integer expression
+template<int KIND>
+Expr<Type<TypeCategory::Integer, KIND>> Increment(
+    Expr<Type<TypeCategory::Integer, KIND>> &&expr) {
+  using IntT = Type<TypeCategory::Integer, KIND>;
+  return Expr<IntT>{Add<IntT>{std::move(expr), Expr<IntT>{1}}};
+}
 }
 #endif  // FORTRAN_EVALUATE_TOOLS_H_

diff --git a/flang/lib/evaluate/type.h b/flang/lib/evaluate/type.h
index 5ffb886..16a4063 100644 (file)
--- a/flang/lib/evaluate/type.h
+++ b/flang/lib/evaluate/type.h
@@ -54,6 +54,7 @@ using common::TypeCategory;
 template<TypeCategory CATEGORY, int KIND = 0> class Type;
 
 using SubscriptInteger = Type<TypeCategory::Integer, 8>;
+using CInteger = Type<TypeCategory::Integer, 4>;
 using LogicalResult = Type<TypeCategory::Logical, 1>;
 using LargestReal = Type<TypeCategory::Real, 16>;
 

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index bc08af0..a931c54 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -691,6 +691,8 @@ public:
   bool Pre(const parser::BindEntity &);
   bool Pre(const parser::NamedConstantDef &);
   bool Pre(const parser::NamedConstant &);
+  void Post(const parser::EnumDef &);
+  bool Pre(const parser::Enumerator &);
   bool Pre(const parser::AsynchronousStmt &);
   bool Pre(const parser::ContiguousStmt &);
   bool Pre(const parser::ExternalStmt &);
@@ -844,6 +846,12 @@ private:
   const parser::Name *interfaceName_{nullptr};
   // Map type-bound generic to binding names of its specific bindings
   std::multimap<Symbol *, const parser::Name *> genericBindings_;
+  // Info about current ENUM
+  struct EnumeratorState {
+    // Enum value must hold inside a C_INT (7.6.2).
+    using CIntExpr = evaluate::Expr<evaluate::CInteger>;
+    std::optional<CIntExpr> value{CIntExpr{-1}};
+  } enumerationState_;
 
   bool HandleAttributeStmt(Attr, const std::list<parser::Name> &);
   Symbol &HandleAttributeStmt(Attr, const parser::Name &);
@@ -2704,6 +2712,56 @@ bool DeclarationVisitor::Pre(const parser::NamedConstant &x) {
   }
   return false;
 }
+
+bool DeclarationVisitor::Pre(const parser::Enumerator &enumerator) {
+  const parser::Name &name{std::get<parser::NamedConstant>(enumerator.t).v};
+  Symbol *symbol{FindSymbol(name)};
+  if (symbol) {
+    // Enumerator names should not appear in any statement before the enum
+    // Technically, the standard does not really prevent them from
+    // appearing in things like a DIMENSION statement, but it would
+    // either be wrong or useless as they are scalars and the user should
+    // not try to temper with enumerator type and attributes.
+    SayAlreadyDeclared(name, *symbol);
+    symbol = nullptr;
+  } else {
+    symbol = &MakeSymbol(name, Attrs{Attr::PARAMETER}, ObjectEntityDetails{});
+    symbol->SetType(context().MakeNumericType(
+        TypeCategory::Integer, evaluate::CInteger::kind));
+  }
+
+  if (auto &init{std::get<std::optional<parser::ScalarIntConstantExpr>>(
+          enumerator.t)}) {
+    Walk(*init);  // resolve names in expression before evaluation.
+    if (MaybeIntExpr expr{EvaluateIntExpr(*init)}) {
+      // Cast all init expressions to C_INT so that they can then be
+      // safely incremented (see 7.6 Note 2).
+      enumerationState_.value =
+          evaluate::ConvertToType<evaluate::CInteger>(std::move(*expr));
+    } else {
+      // Error in expr, prevent resolution of next enumerators value
+      enumerationState_.value = std::nullopt;
+    }
+  } else if (enumerationState_.value) {
+    enumerationState_.value =
+        FoldExpr(evaluate::Increment(std::move(*enumerationState_.value)));
+  }
+
+  if (symbol) {
+    if (enumerationState_.value.has_value()) {
+      symbol->get<ObjectEntityDetails>().set_init(
+          SomeExpr{*enumerationState_.value});
+    } else {
+      context().SetError(*symbol);
+    }
+  }
+  return false;
+}
+
+void DeclarationVisitor::Post(const parser::EnumDef &) {
+  enumerationState_ = EnumeratorState{};
+}
+
 bool DeclarationVisitor::Pre(const parser::AsynchronousStmt &x) {
   return HandleAttributeStmt(Attr::ASYNCHRONOUS, x.v);
 }

diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt
index 5675526..74f2812 100644 (file)
--- a/flang/test/semantics/CMakeLists.txt
+++ b/flang/test/semantics/CMakeLists.txt
@@ -96,6 +96,7 @@ set(ERROR_TESTS
   resolve57.f90
   resolve58.f90
   resolve59.f90
+  resolve60.f90
   stop01.f90
   structconst01.f90
   structconst02.f90
@@ -215,6 +216,7 @@ set(MODFILE_TESTS
   modfile28.f90
   modfile29.f90
   modfile30.f90
+  modfile31.f90
 )
 
 set(LABEL_TESTS

diff --git a/flang/test/semantics/modfile31.f90 b/flang/test/semantics/modfile31.f90
new file mode 100644 (file)
index 0000000..9d56b17
--- /dev/null
+++ b/flang/test/semantics/modfile31.f90
@@ -0,0 +1,47 @@
+! 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.
+
+! Test 7.6 enum values
+
+module m1
+  integer, parameter :: x(1) = [4]
+  enum, bind(C)
+    enumerator :: red, green
+    enumerator blue
+    enumerator yellow
+    enumerator :: purple = 2
+    enumerator :: brown
+  end enum
+
+  enum, bind(C)
+    enumerator :: oak, beech = -rank(x)*x(1), pine, poplar = brown
+  end enum
+
+end
+
+!Expect: m1.mod
+!module m1
+!integer(4),parameter::x(1_8:1_8)=[Integer(4)::4_4]
+!integer(4),parameter::red=0_4
+!integer(4),parameter::green=1_4
+!integer(4),parameter::blue=2_4
+!integer(4),parameter::yellow=3_4
+!integer(4),parameter::purple=2_4
+!integer(4),parameter::brown=3_4
+!integer(4),parameter::oak=0_4
+!integer(4),parameter::beech=-4_4
+!integer(4),parameter::pine=-3_4
+!integer(4),parameter::poplar=3_4
+!end
+

diff --git a/flang/test/semantics/resolve60.f90 b/flang/test/semantics/resolve60.f90
new file mode 100644 (file)
index 0000000..8f54ab9
--- /dev/null
+++ b/flang/test/semantics/resolve60.f90
@@ -0,0 +1,51 @@
+! 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.
+
+! Testing 7.6 enum
+
+  ! OK
+  enum, bind(C)
+    enumerator :: red, green
+    enumerator blue, pink
+    enumerator yellow
+    enumerator :: purple = 2
+  end enum
+
+  integer(yellow) anint4
+
+  enum, bind(C)
+    enumerator :: square, cicrle
+    !ERROR: 'square' is already declared in this scoping unit
+    enumerator square
+  end enum
+
+  dimension :: apple(4)
+  real :: peach
+
+  enum, bind(C)
+    !ERROR: 'apple' is already declared in this scoping unit
+    enumerator :: apple
+    enumerator :: pear
+    !ERROR: 'peach' is already declared in this scoping unit
+    enumerator :: peach
+    !ERROR: 'red' is already declared in this scoping unit
+    enumerator :: red
+  end enum
+
+  enum, bind(C)
+    !ERROR: Must be a constant value
+    enumerator :: wrong = 0/0
+  end enum
+
+end