================
@@ -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:
Confirmed on a rebuild at this revision: the nested integer / same-enum /
different-enum selects (including under `DO`/`IF`) now compile cleanly, and the
outer enum's own case values are still validated. Thanks for the fix and the
added tests.
https://github.com/llvm/llvm-project/pull/193028
_______________________________________________
cfe-commits mailing list
[email protected]
https://lists.llvm.org/cgi-bin/mailman/listinfo/cfe-commits
