[flang-commits] [flang] [flang] Enumeration Type: (PR 2/5) Name Resolution + Expression + Relational + SELECT CASE (PR #193028)

[via flang-commits]

================
@@ -236,6 +238,89 @@ template <TypeCategory CAT> struct TypeVisitor {
   const std::list<parser::CaseConstruct::Case> &caseList;
 };
 
+// Convert a single enumeration CASE value to its __ordinal integer.
+static bool ConvertEnumCaseValue(SemanticsContext &context,
+    const parser::CaseValue &caseValue,
+    const semantics::DerivedTypeSpec &enumType,
+    const semantics::Symbol &ordSym) {
+  const auto &expr{parser::UnwrapRef<parser::Expr>(caseValue)};
+  auto *x{expr.typedExpr.get()};
+  if (!x || !x->v) {
+    return false;
+  }
+  auto type{x->v->GetType()};
+  if (!type || type->category() != TypeCategory::Derived) {
+    std::string typeStr{type ? type->AsFortran() : "typeless"s};
+    context.Say(expr.source,
+        "CASE value has type '%s' which is not compatible with the SELECT CASE expression's type '%s'"_err_en_US,
+        typeStr, enumType.AsFortran());
+    return false;
+  }
+  const auto *caseDerived{evaluate::GetDerivedTypeSpec(*type)};
+  if (!caseDerived || !caseDerived->IsEnumerationType() ||
+      &caseDerived->typeSymbol() != &enumType.typeSymbol()) {
+    context.Say(expr.source,
+        "CASE value has type '%s' which is not compatible with the SELECT CASE expression's type '%s'"_err_en_US,
+        type->AsFortran(), enumType.AsFortran());
+    return false;
+  }
+  // Extract the ordinal integer from the constant enum value
+  parser::Messages buffer;
+  parser::ContextualMessages foldingMessages{expr.source, &buffer};
+  evaluate::FoldingContext foldingContext{
+      context.foldingContext(), foldingMessages};
+  auto folded{evaluate::Fold(foldingContext, SomeExpr{*x->v})};
+  if (auto sc{
+          evaluate::GetScalarConstantValue<evaluate::SomeDerived>(folded)}) {
+    if (auto ordExpr{sc->Find(ordSym)}) {
+      x->v = std::move(*ordExpr);
+      return true;
+    }
+  }
+  context.Say(expr.source,
+      "CASE value (%s) must be a constant scalar"_err_en_US, x->v->AsFortran());
+  return false;
+}
+
+// A parse-tree visitor that converts every enumeration CASE value it
+// encounters to its ordinal integer value, recording whether all
+// conversions succeeded.
+struct EnumCaseValueConverter {
+  template <typename A> bool Pre(const A &) { return true; }
+  template <typename A> void Post(const A &) {}
+  bool Pre(const parser::CaseValue &val) {
+    if (!ConvertEnumCaseValue(context, val, enumType, ordSym)) {
+      ok = false;
+    }
+    return false;
+  }
+  SemanticsContext &context;
+  const semantics::DerivedTypeSpec &enumType;
+  const semantics::Symbol &ordSym;
+  bool ok{true};
+};
+
+// Walk all CASE values in an enumeration SELECT CASE, check type
+// compatibility, and convert each to its ordinal integer value.
+static bool ConvertEnumCaseValues(SemanticsContext &context,
+    const std::list<parser::CaseConstruct::Case> &cases,
+    const semantics::DerivedTypeSpec &enumType) {
+  const auto *scope{enumType.GetScope()};
+  if (!scope) {
+    return false;
+  }
+  auto ordIter{scope->find(
+      semantics::SourceName{semantics::DerivedTypeDetails::ordinalComponentName,
+          sizeof(semantics::DerivedTypeDetails::ordinalComponentName) - 1})};
+  if (ordIter == scope->end()) {
+    return false;
+  }
+  const semantics::Symbol &ordSym{*ordIter->second};
+  EnumCaseValueConverter visitor{context, enumType, ordSym};
+  parser::Walk(cases, visitor);
----------------
MattPD wrote:

A `SELECT CASE` nested inside an arm of an enumeration `SELECT CASE` is rejected, even when the inner construct is valid. Built at this revision and ran:

```fortran
subroutine s
  enumeration type :: color
    enumerator :: red, green, blue
  end enumeration type
  type(color) :: c
  integer :: j
  c = red
  j = 5
  select case (c)
  case (red)
    select case (j)        ! ordinary integer SELECT CASE
    case (1)
      print *, "one"
    end select
  case (green)
  end select
end subroutine
```

```
error: CASE value has type 'INTEGER(4)' which is not compatible with the SELECT CASE expression's type 'ENUMERATION TYPE :: color'
      case (1)
            ^
```

The inner `case (1)` belongs to the integer `select case (j)`, but it is checked against the outer `color` selector. `ConvertEnumCaseValues` receives the outer case list, and `parser::Walk` recurses through each arm's body, so `Pre(const parser::CaseValue &)` fires on the case values of any nested `SELECT CASE` and converts them against the outer enumeration type.

The same happens for a nested `SELECT CASE` over a different enumeration type, and over the same enumeration type (where the inner enumerators are then reported as `INTEGER(4)`), at any nesting depth (the inner select can sit under a `DO` or `IF`). An integer or character outer `SELECT CASE` is unaffected, and the outer enum's own arms are still checked correctly. Reverting just this line back to a per-case loop over the `CaseSelector`s and rebuilding makes all of these compile cleanly, so the rejection comes specifically from walking the whole case list.

Would restricting the walk to each case's `CaseStmt`/`CaseSelector`, or having the visitor stop descent at a nested `parser::CaseConstruct`, be the right fix? A regression test with an integer, same-enum, and different-enum `SELECT CASE` nested inside an enumeration `SELECT CASE` would lock it down.

https://github.com/llvm/llvm-project/pull/193028