https://github.com/kwyatt-ext updated https://github.com/llvm/llvm-project/pull/193235
>From a2a7e083015144584fc9e51a7c8faae64b10c047 Mon Sep 17 00:00:00 2001 From: Kevin Wyatt <[email protected]> Date: Thu, 16 Apr 2026 13:38:20 -0500 Subject: [PATCH 1/2] Enumeration Type Sem-3: Intrinsics + I/O + Module Files (PRs 6-8) Adds enumeration type intrinsics (HUGE, NEXT, PREVIOUS, INT) with constant folding, STAT argument support with boundary detection, formatted I/O rejection for enumeration types, module file round-trip support, and runtime STAT_ENUM_BOUNDARY error code. Files from original PRs 6-8 (including PREVIOUS intrinsic from PR 7). --- flang-rt/include/flang-rt/runtime/stat.h | 1 + flang-rt/lib/runtime/stat.cpp | 3 + flang/include/flang/Runtime/magic-numbers.h | 5 + flang/lib/Evaluate/fold-implementation.h | 75 ++++++- flang/lib/Evaluate/intrinsics.cpp | 228 +++++++++++++++++++- flang/lib/Semantics/check-io.cpp | 73 +++++++ flang/lib/Semantics/mod-file.cpp | 86 ++++++++ flang/lib/Semantics/mod-file.h | 3 + flang/lib/Semantics/type.cpp | 5 + 9 files changed, 477 insertions(+), 2 deletions(-) diff --git a/flang-rt/include/flang-rt/runtime/stat.h b/flang-rt/include/flang-rt/runtime/stat.h index dc372de53506a..72d45a29c71fc 100644 --- a/flang-rt/include/flang-rt/runtime/stat.h +++ b/flang-rt/include/flang-rt/runtime/stat.h @@ -53,6 +53,7 @@ enum Stat { StatMoveAllocSameAllocatable = FORTRAN_RUNTIME_STAT_MOVE_ALLOC_SAME_ALLOCATABLE, StatBadPointerDeallocation = FORTRAN_RUNTIME_STAT_BAD_POINTER_DEALLOCATION, + StatEnumBoundary = FORTRAN_RUNTIME_STAT_ENUM_BOUNDARY, // Dummy status for work queue continuation, declared here to perhaps // avoid collisions diff --git a/flang-rt/lib/runtime/stat.cpp b/flang-rt/lib/runtime/stat.cpp index 1d4aae2e49736..076b5b81b71d2 100644 --- a/flang-rt/lib/runtime/stat.cpp +++ b/flang-rt/lib/runtime/stat.cpp @@ -70,6 +70,9 @@ RT_API_ATTRS const char *StatErrorString(int stat) { return "DEALLOCATE of a pointer that is not the whole content of a pointer " "ALLOCATE"; + case StatEnumBoundary: + return "NEXT or PREVIOUS of enumeration type at boundary"; + default: return nullptr; } diff --git a/flang/include/flang/Runtime/magic-numbers.h b/flang/include/flang/Runtime/magic-numbers.h index 6788ba098bcf9..2c15103a21bc2 100644 --- a/flang/include/flang/Runtime/magic-numbers.h +++ b/flang/include/flang/Runtime/magic-numbers.h @@ -73,6 +73,11 @@ Status codes for GETCWD. #endif #define FORTRAN_RUNTIME_STAT_MISSING_CWD 111 +#if 0 +Status code for NEXT/PREVIOUS at enumeration type boundary. +#endif +#define FORTRAN_RUNTIME_STAT_ENUM_BOUNDARY 112 + #if 0 ieee_class_type values The sequence is that of F18 Clause 17.2p3, but nothing depends on that. diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h index 2df2b9e5a300b..c59b0ed68289b 100644 --- a/flang/lib/Evaluate/fold-implementation.h +++ b/flang/lib/Evaluate/fold-implementation.h @@ -1290,7 +1290,80 @@ Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) { return Folder<T>{context}.UNPACK(std::move(funcRef)); } // TODO: extends_type_of, same_type_as - if constexpr (!std::is_same_v<T, SomeDerived>) { + if constexpr (std::is_same_v<T, SomeDerived>) { + // Fold enumeration type intrinsics: HUGE(enum), NEXT(enum), + // PREVIOUS(enum) + if (name == "huge") { + // HUGE was eagerly folded — the first arg is the constant result + if (args.size() >= 1 && args[0]) { + if (auto *expr{UnwrapExpr<Expr<SomeDerived>>(args[0])}) { + return std::move(*expr); + } + } + } else if (name == "next" || name == "previous") { + // Don't fold if STAT is present — STAT assignment is a side effect + if (args.size() >= 2 && args[1]) { + return Expr<T>{std::move(funcRef)}; + } + if (args.size() >= 1 && args[0]) { + if (auto *expr{UnwrapExpr<Expr<SomeDerived>>(args[0])}) { + if (auto type{expr->GetType()}) { + if (const auto *derived{GetDerivedTypeSpec(*type)}) { + if (derived->IsEnumerationType()) { + if (const auto *scope{derived->GetScope()}) { + auto ordIter{ + scope->find(semantics::SourceName{"__ordinal", 9})}; + if (ordIter != scope->end()) { + const semantics::Symbol &ordSym{*ordIter->second}; + int count{derived->typeSymbol() + .GetUltimate() + .get<semantics::DerivedTypeDetails>() + .enumeratorCount()}; + // Extract ordinal from constant value + if (auto *constant{ + UnwrapConstantValue<SomeDerived>(*expr)}) { + if (auto sc{constant->GetScalarValue()}) { + if (auto ordExpr{sc->Find(ordSym)}) { + if (auto ordVal{ToInt64(*ordExpr)}) { + bool isNext{name == "next"}; + bool atBoundary{ + isNext ? *ordVal >= count : *ordVal <= 1}; + if (atBoundary) { + // At boundary without STAT — error + // termination at runtime. Don't fold; + // emit warning. + if (isNext) { + context.messages().Say( + "NEXT() of last enumerator without STAT= causes error termination"_warn_en_US); + } else { + context.messages().Say( + "PREVIOUS() of first enumerator without STAT= causes error termination"_warn_en_US); + } + return Expr<T>{std::move(funcRef)}; + } + int newOrd{isNext + ? static_cast<int>(*ordVal + 1) + : static_cast<int>(*ordVal - 1)}; + StructureConstructor ctor{*derived}; + ctor.Add(ordSym, + Expr<SomeType>{Expr<SomeInteger>{ + Expr<Type<TypeCategory::Integer, 4>>{ + newOrd}}}); + return Expr<SomeDerived>{ + Constant<SomeDerived>{std::move(ctor)}}; + } + } + } + } + } + } + } + } + } + } + } + } + } else { return FoldIntrinsicFunction(context, std::move(funcRef)); } } diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index ede9eb36e4cad..4a1bfc5bbb4e1 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -2940,6 +2940,18 @@ class IntrinsicProcTable::Implementation { ActualArguments &, FoldingContext &) const; std::optional<SpecificCall> HandleC_Devloc( ActualArguments &, FoldingContext &) const; + std::optional<SpecificCall> HandleEnumerationHuge( + const semantics::DerivedTypeSpec &, ActualArguments &, + FoldingContext &) const; + std::optional<SpecificCall> HandleEnumerationNext( + const semantics::DerivedTypeSpec &, ActualArguments &, + FoldingContext &) const; + std::optional<SpecificCall> HandleEnumerationPrevious( + const semantics::DerivedTypeSpec &, ActualArguments &, + FoldingContext &) const; + std::optional<SpecificCall> HandleEnumerationInt( + const semantics::DerivedTypeSpec &, ActualArguments &, + FoldingContext &) const; const std::string &ResolveAlias(const std::string &name) const { auto iter{aliases_.find(name)}; return iter == aliases_.end() ? name : iter->second; @@ -2968,7 +2980,7 @@ bool IntrinsicProcTable::Implementation::IsIntrinsicFunction( } // special cases return name == "__builtin_c_loc" || name == "__builtin_c_devloc" || - name == "null"; + name == "null" || name == "next" || name == "previous"; } bool IntrinsicProcTable::Implementation::IsIntrinsicSubroutine( const std::string &name0) const { @@ -3647,6 +3659,170 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::HandleC_Devloc( return std::nullopt; } +// HUGE(x) for enumeration types — returns the last enumerator +std::optional<SpecificCall> +IntrinsicProcTable::Implementation::HandleEnumerationHuge( + const semantics::DerivedTypeSpec &derived, ActualArguments &arguments, + FoldingContext &context) const { + static const char *const keywords[]{"x", nullptr}; + if (!CheckAndRearrangeArguments(arguments, context.messages(), keywords)) { + return std::nullopt; + } + int count{derived.typeSymbol() + .GetUltimate() + .get<semantics::DerivedTypeDetails>() + .enumeratorCount()}; + // Build a StructureConstructor with __ordinal = enumeratorCount + const auto *scope{derived.GetScope()}; + if (!scope) { + return std::nullopt; + } + auto ordIter{scope->find(semantics::SourceName{"__ordinal", 9})}; + if (ordIter == scope->end()) { + return std::nullopt; + } + const semantics::Symbol &ordSym{*ordIter->second}; + StructureConstructor ctor{derived}; + ctor.Add(ordSym, + Expr<SomeType>{ + Expr<SomeInteger>{Expr<Type<TypeCategory::Integer, 4>>{count}}}); + // Build FunctionResult and DummyArguments + DynamicType enumType{derived}; + characteristics::DummyDataObject ddo{characteristics::TypeAndShape{enumType}}; + ddo.intent = common::Intent::In; + ddo.attrs.set(characteristics::DummyDataObject::Attr::OnlyIntrinsicInquiry); + characteristics::Procedure::Attrs attrs; + attrs.set(characteristics::Procedure::Attr::Pure); + // Replace arguments with the constant result + arguments.clear(); + arguments.emplace_back( + AsGenericExpr(Expr<SomeDerived>{Constant<SomeDerived>{std::move(ctor)}})); + return SpecificCall{ + SpecificIntrinsic{"huge"s, + characteristics::Procedure{characteristics::FunctionResult{enumType}, + characteristics::DummyArguments{ + characteristics::DummyArgument{"x"s, std::move(ddo)}}, + attrs}}, + std::move(arguments)}; +} + +// NEXT(a [, stat]) for enumeration types — returns the next enumerator +std::optional<SpecificCall> +IntrinsicProcTable::Implementation::HandleEnumerationNext( + const semantics::DerivedTypeSpec &derived, ActualArguments &arguments, + FoldingContext &context) const { + static const char *const keywords[]{"a", "stat", nullptr}; + if (!CheckAndRearrangeArguments(arguments, context.messages(), keywords, 1)) { + return std::nullopt; + } + if (!arguments[0]) { + context.messages().Say("NEXT() requires argument A"_err_en_US); + return std::nullopt; + } + DynamicType enumerationType{derived}; + characteristics::DummyDataObject ddoA{ + characteristics::TypeAndShape{enumerationType}}; + ddoA.intent = common::Intent::In; + DynamicType statType{ + TypeCategory::Integer, defaults_.GetDefaultKind(TypeCategory::Integer)}; + characteristics::DummyDataObject ddoStat{ + characteristics::TypeAndShape{statType}}; + ddoStat.intent = common::Intent::Out; + ddoStat.attrs.set(characteristics::DummyDataObject::Attr::Optional); + characteristics::Procedure::Attrs attrs; + attrs.set(characteristics::Procedure::Attr::Pure); + attrs.set(characteristics::Procedure::Attr::Elemental); + return SpecificCall{ + SpecificIntrinsic{"next"s, + characteristics::Procedure{ + characteristics::FunctionResult{enumerationType}, + characteristics::DummyArguments{ + characteristics::DummyArgument{"a"s, std::move(ddoA)}, + characteristics::DummyArgument{"stat"s, std::move(ddoStat)}}, + attrs}}, + std::move(arguments)}; +} + +// PREVIOUS(a [, stat]) for enumeration types — returns the previous enumerator +std::optional<SpecificCall> +IntrinsicProcTable::Implementation::HandleEnumerationPrevious( + const semantics::DerivedTypeSpec &derived, ActualArguments &arguments, + FoldingContext &context) const { + static const char *const keywords[]{"a", "stat", nullptr}; + if (!CheckAndRearrangeArguments(arguments, context.messages(), keywords, 1)) { + return std::nullopt; + } + if (!arguments[0]) { + context.messages().Say("PREVIOUS() requires argument A"_err_en_US); + return std::nullopt; + } + DynamicType enumerationType{derived}; + characteristics::DummyDataObject ddoA{ + characteristics::TypeAndShape{enumerationType}}; + ddoA.intent = common::Intent::In; + DynamicType statType{ + TypeCategory::Integer, defaults_.GetDefaultKind(TypeCategory::Integer)}; + characteristics::DummyDataObject ddoStat{ + characteristics::TypeAndShape{statType}}; + ddoStat.intent = common::Intent::Out; + ddoStat.attrs.set(characteristics::DummyDataObject::Attr::Optional); + characteristics::Procedure::Attrs attrs; + attrs.set(characteristics::Procedure::Attr::Pure); + attrs.set(characteristics::Procedure::Attr::Elemental); + return SpecificCall{ + SpecificIntrinsic{"previous"s, + characteristics::Procedure{ + characteristics::FunctionResult{enumerationType}, + characteristics::DummyArguments{ + characteristics::DummyArgument{"a"s, std::move(ddoA)}, + characteristics::DummyArgument{"stat"s, std::move(ddoStat)}}, + attrs}}, + std::move(arguments)}; +} + +// INT(x) for enumeration types — returns the ordinal as an integer +std::optional<SpecificCall> +IntrinsicProcTable::Implementation::HandleEnumerationInt( + const semantics::DerivedTypeSpec &derived, ActualArguments &arguments, + FoldingContext &context) const { + static const char *const keywords[]{"a", "kind", nullptr}; + if (!CheckAndRearrangeArguments(arguments, context.messages(), keywords, 1)) { + return std::nullopt; + } + // Determine result kind + int kind{defaults_.GetDefaultKind(TypeCategory::Integer)}; + if (arguments.size() > 1 && arguments[1]) { + if (const auto *kindExpr{arguments[1]->UnwrapExpr()}) { + if (auto kindVal{ToInt64(*kindExpr)}) { + kind = static_cast<int>(*kindVal); + } + } + } + DynamicType enumerationType{derived}; + DynamicType resultType{TypeCategory::Integer, kind}; + characteristics::DummyDataObject ddo{ + characteristics::TypeAndShape{enumerationType}}; + ddo.intent = common::Intent::In; + characteristics::Procedure::Attrs attrs; + attrs.set(characteristics::Procedure::Attr::Pure); + attrs.set(characteristics::Procedure::Attr::Elemental); + characteristics::DummyArguments dummies; + dummies.emplace_back("a"s, std::move(ddo)); + // Always include KIND dummy — CheckAndRearrangeArguments always populates + // the slot even when absent + characteristics::DummyDataObject kindDdo{ + characteristics::TypeAndShape{DynamicType{TypeCategory::Integer, + defaults_.GetDefaultKind(TypeCategory::Integer)}}}; + kindDdo.intent = common::Intent::In; + auto &kindDummy{dummies.emplace_back("kind"s, std::move(kindDdo))}; + kindDummy.SetOptional(); + return SpecificCall{SpecificIntrinsic{"int"s, + characteristics::Procedure{ + characteristics::FunctionResult{resultType}, + std::move(dummies), attrs}}, + std::move(arguments)}; +} + static bool CheckForNonPositiveValues(FoldingContext &context, const ActualArgument &arg, const std::string &procName, const std::string &argName) { @@ -3855,6 +4031,56 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe( } } } + // Enumeration type intrinsics: HUGE, NEXT, INT + if (arguments.size() >= 1 && arguments[0]) { + if (auto type{arguments[0]->GetType()}) { + if (const auto *derived{GetDerivedTypeSpec(*type)}) { + if (derived->IsEnumerationType()) { + if (call.name == "huge") { + return HandleEnumerationHuge(*derived, arguments, context); + } else if (call.name == "next") { + return HandleEnumerationNext(*derived, arguments, context); + } else if (call.name == "int") { + return HandleEnumerationInt(*derived, arguments, context); + } + } + } + } + } + // Enumeration type intrinsics: HUGE, NEXT, INT + if (arguments.size() >= 1 && arguments[0]) { + if (auto type{arguments[0]->GetType()}) { + if (const auto *derived{GetDerivedTypeSpec(*type)}) { + if (derived->IsEnumerationType()) { + if (call.name == "huge") { + return HandleEnumerationHuge(*derived, arguments, context); + } else if (call.name == "next") { + return HandleEnumerationNext(*derived, arguments, context); + } else if (call.name == "int") { + return HandleEnumerationInt(*derived, arguments, context); + } + } + } + } + } + // Enumeration type intrinsics: HUGE, NEXT, PREVIOUS, INT + if (arguments.size() >= 1 && arguments[0]) { + if (auto type{arguments[0]->GetType()}) { + if (const auto *derived{GetDerivedTypeSpec(*type)}) { + if (derived->IsEnumerationType()) { + if (call.name == "huge") { + return HandleEnumerationHuge(*derived, arguments, context); + } else if (call.name == "next") { + return HandleEnumerationNext(*derived, arguments, context); + } else if (call.name == "previous") { + return HandleEnumerationPrevious(*derived, arguments, context); + } else if (call.name == "int") { + return HandleEnumerationInt(*derived, arguments, context); + } + } + } + } + } } // Find the specific subroutine and match the actual arguments against its diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp index 5a5bee2b80e3c..f88897e362548 100644 --- a/flang/lib/Semantics/check-io.cpp +++ b/flang/lib/Semantics/check-io.cpp @@ -332,6 +332,21 @@ void IoChecker::Enter(const parser::InputItem &spec) { CheckForDefinableVariable(*var, "Input"); if (auto expr{AnalyzeExpr(context_, *var)}) { auto at{var->GetSource()}; + if (flags_.test(Flag::StarFmt)) { + if (auto type{expr->GetType()}; type && + type->category() == TypeCategory::Derived && + !type->IsUnlimitedPolymorphic()) { + const auto &derived{type->GetDerivedTypeSpec()}; + if (const auto *details{ + derived.typeSymbol().detailsIf<DerivedTypeDetails>()}) { + if (details->isEnumerationType()) { + context_.Say(at, + "Enumeration type may not appear in list-directed input"_err_en_US); + return; + } + } + } + } CheckForAssumedRank(UnwrapWholeSymbolDataRef(*expr), at); CheckForBadIoType(*expr, flags_.test(Flag::FmtOrNml) ? common::DefinedIo::ReadFormatted @@ -665,6 +680,21 @@ void IoChecker::Enter(const parser::OutputItem &item) { "Output item must not be a procedure"_err_en_US); // C1233 } else { auto at{parser::FindSourceLocation(item)}; + if (flags_.test(Flag::StarFmt)) { + if (auto type{expr->GetType()}; type && + type->category() == TypeCategory::Derived && + !type->IsUnlimitedPolymorphic()) { + const auto &derived{type->GetDerivedTypeSpec()}; + if (const auto *details{ + derived.typeSymbol().detailsIf<DerivedTypeDetails>()}) { + if (details->isEnumerationType()) { + context_.Say(at, + "Enumeration type may not appear in list-directed output"_err_en_US); + return; + } + } + } + } CheckForAssumedRank(UnwrapWholeSymbolDataRef(*expr), at); CheckForBadIoType(*expr, flags_.test(Flag::FmtOrNml) ? common::DefinedIo::WriteFormatted @@ -1224,6 +1254,17 @@ parser::Message *IoChecker::CheckForBadIoType(const evaluate::DynamicType &type, where, "I/O list item may not be unlimited polymorphic"_err_en_US); } else if (type.category() == TypeCategory::Derived) { const auto &derived{type.GetDerivedTypeSpec()}; + if (const auto *details{ + derived.typeSymbol().detailsIf<DerivedTypeDetails>()}) { + if (details->isEnumerationType()) { + if (which == common::DefinedIo::ReadUnformatted || + which == common::DefinedIo::WriteUnformatted) { + return &context_.Say(where, + "Enumeration type may not be used in unformatted I/O"_err_en_US); + } + return nullptr; // formatted I/O is allowed + } + } const Scope &scope{context_.FindScope(where)}; if (const Symbol * bad{FindUnsafeIoDirectComponent(which, derived, scope)}) { @@ -1289,6 +1330,38 @@ void IoChecker::CheckNamelist(const Symbol &namelist, common::DefinedIo which, const auto &details{namelist.GetUltimate().get<NamelistDetails>()}; for (const Symbol &object : details.objects()) { context_.CheckIndexVarRedefine(namelistLocation, object); + if (auto type{evaluate::DynamicType::From(object)}; + type && type->category() == TypeCategory::Derived) { + const auto &derived{type->GetDerivedTypeSpec()}; + if (const auto *dtDetails{ + derived.typeSymbol().detailsIf<DerivedTypeDetails>()}) { + if (dtDetails->isEnumerationType()) { + context_.Say(namelistLocation, + "Enumeration type '%s' may not be a namelist group object"_err_en_US, + derived.name()); + continue; + } + } + // Check direct components for enumeration types + if (derived.GetScope()) { + DirectComponentIterator directs{derived}; + for (const Symbol &component : directs) { + if (auto compType{evaluate::DynamicType::From(component)}; + compType && compType->category() == TypeCategory::Derived) { + const auto &compDerived{compType->GetDerivedTypeSpec()}; + if (const auto *compDetails{compDerived.typeSymbol() + .detailsIf<DerivedTypeDetails>()}) { + if (compDetails->isEnumerationType()) { + context_.Say(namelistLocation, + "Namelist group object '%s' has a direct component '%s' of enumeration type"_err_en_US, + object.name(), component.name()); + break; + } + } + } + } + } + } if (auto *msg{CheckForBadIoType(object, which, namelistLocation)}) { evaluate::AttachDeclaration(*msg, namelist); } else if (which == common::DefinedIo::ReadFormatted) { diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp index 2865d16c68bb8..3fc6f8284c1e8 100644 --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -9,6 +9,7 @@ #include "mod-file.h" #include "resolve-names.h" #include "flang/Common/restorer.h" +#include "flang/Evaluate/fold.h" #include "flang/Evaluate/tools.h" #include "flang/Parser/message.h" #include "flang/Parser/parsing.h" @@ -608,6 +609,10 @@ void ModFileWriter::PutDerivedType( PutDECStructure(typeSymbol, scope); return; } + if (details.isEnumerationType()) { + PutEnumerationType(typeSymbol); + return; + } PutAttrs(decls_ << "type", typeSymbol.attrs()); if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) { decls_ << ",extends(" << extends->name() << ')'; @@ -680,6 +685,82 @@ void ModFileWriter::PutDECStructure( decls_ << "end structure\n"; } +void ModFileWriter::PutEnumerationType(const Symbol &typeSymbol) { + auto &details{typeSymbol.get<DerivedTypeDetails>()}; + PutAttrs(decls_ << "enumeration type", typeSymbol.attrs()); + decls_ << "::" << typeSymbol.name() << '\n'; + // Collect enumerator PARAMETER symbols from the enclosing scope that have + // this enumeration type, sorted by ordinal value. Only the first + // enumeratorCount PARAMETERs (by ordinal) are true enumerators created by + // the ENUMERATOR statement; any additional PARAMETERs of this type are + // user-declared and should not be included here. + struct EnumeratorInfo { + SourceName name; + const Symbol *sym{nullptr}; + int ordinal{0}; + }; + // GetSymbols() returns symbols in source-position order. The real + // enumerators are created inside the ENUMERATION TYPE block and appear + // before any user-declared PARAMETERs of the same type. For each ordinal + // 1..N, take only the first PARAMETER seen (by source order) — that is + // the real enumerator. + int count{details.enumeratorCount()}; + std::vector<EnumeratorInfo> enumerators(count); // indexed by ordinal-1 + std::vector<bool> filled(count, false); + for (const auto &ref : typeSymbol.owner().GetSymbols()) { + if (ref->attrs().test(Attr::PARAMETER)) { + if (const auto *obj{ref->detailsIf<ObjectEntityDetails>()}) { + if (obj->type() && + obj->type()->category() == DeclTypeSpec::TypeDerived && + &obj->type()->derivedTypeSpec().typeSymbol() == &typeSymbol) { + int ordinal{0}; + if (const auto &init{obj->init()}) { + // The init may be a bare StructureConstructor or a + // Constant<SomeDerived> (after folding). Use + // GetScalarConstantValue which handles both. + if (auto ctor{ + evaluate::GetScalarConstantValue<evaluate::SomeDerived>( + *init)}) { + for (const auto &[compRef, val] : *ctor) { + if (auto intVal{evaluate::ToInt64(val.value())}) { + ordinal = static_cast<int>(*intVal); + } + } + } + } + if (ordinal >= 1 && ordinal <= count && !filled[ordinal - 1]) { + enumerators[ordinal - 1] = {ref->name(), &*ref, ordinal}; + filled[ordinal - 1] = true; + emittedEnumerators_.insert(*ref); + } + } + } + } + } + if (!enumerators.empty()) { + decls_ << "enumerator::"; + bool first{true}; + for (const auto &e : enumerators) { + if (!first) { + decls_ << ','; + } + decls_ << e.name; + first = false; + } + decls_ << '\n'; + } + decls_ << "end enumeration type\n"; + // Emit access overrides for individual enumerators, matching the + // pattern used elsewhere in mod file output (e.g., namelists, generics). + if (!isSubmodule_) { + for (const auto &e : enumerators) { + if (e.sym->attrs().test(Attr::PRIVATE)) { + decls_ << "private::" << e.name << '\n'; + } + } + } +} + // Attributes that may be in a subprogram prefix static const Attrs subprogramPrefixAttrs{Attr::ELEMENTAL, Attr::IMPURE, Attr::MODULE, Attr::NON_RECURSIVE, Attr::PURE, Attr::SIMPLE, @@ -1022,6 +1103,11 @@ void ModFileWriter::PutObjectEntity( return; // symbol was emitted on STRUCTURE statement } } + // Enumerator PARAMETERs are emitted as part of the ENUMERATION TYPE + // block — suppress standalone emission to avoid duplicates on USE. + if (emittedEnumerators_.find(symbol) != emittedEnumerators_.end()) { + return; + } } PutEntity( os, symbol, [&]() { PutType(os, DEREF(symbol.GetType())); }, diff --git a/flang/lib/Semantics/mod-file.h b/flang/lib/Semantics/mod-file.h index 9e5724089b3c5..d4d3684f67539 100644 --- a/flang/lib/Semantics/mod-file.h +++ b/flang/lib/Semantics/mod-file.h @@ -52,6 +52,8 @@ class ModFileWriter { std::string containsBuf_; // Tracks nested DEC structures and fields of that type UnorderedSymbolSet emittedDECStructures_, emittedDECFields_; + // Tracks enumerator PARAMETER symbols emitted within ENUMERATION TYPE blocks + UnorderedSymbolSet emittedEnumerators_; UnorderedSymbolSet usedNonIntrinsicModules_; llvm::raw_string_ostream needs_{needsBuf_}; @@ -79,6 +81,7 @@ class ModFileWriter { void PutProcEntity(llvm::raw_ostream &, const Symbol &); void PutDerivedType(const Symbol &, const Scope * = nullptr); void PutDECStructure(const Symbol &, const Scope * = nullptr); + void PutEnumerationType(const Symbol &); void PutTypeParam(llvm::raw_ostream &, const Symbol &); void PutUserReduction(llvm::raw_ostream &, const Symbol &); void PutSubprogram(const Symbol &); diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp index 678bae83ba68e..448a29b7c18bd 100644 --- a/flang/lib/Semantics/type.cpp +++ b/flang/lib/Semantics/type.cpp @@ -1007,6 +1007,11 @@ std::string DeclTypeSpec::AsFortran() const { return "RECORD" + derivedTypeSpec().typeSymbol().name().ToString(); } else if (derivedTypeSpec().IsVectorType()) { return derivedTypeSpec().VectorTypeAsFortran(); + } else if (derivedTypeSpec() + .typeSymbol() + .get<DerivedTypeDetails>() + .isEnumerationType()) { + return "TYPE(" + derivedTypeSpec().typeSymbol().name().ToString() + ')'; } else { return "TYPE(" + derivedTypeSpec().AsFortran() + ')'; } >From dd58684723c08f32e1d5b7d7f6d969c8ebd1bdd7 Mon Sep 17 00:00:00 2001 From: Kevin Wyatt <[email protected]> Date: Tue, 21 Apr 2026 09:19:46 -0500 Subject: [PATCH 2/2] Adding test cases. --- .../Semantics/enumeration-type-intrinsics.f90 | 153 ++++++++++++++++++ flang/test/Semantics/enumeration-type-io.f90 | 68 ++++++++ flang/test/Semantics/enumeration-type-mod.f90 | 84 ++++++++++ 3 files changed, 305 insertions(+) create mode 100644 flang/test/Semantics/enumeration-type-intrinsics.f90 create mode 100644 flang/test/Semantics/enumeration-type-io.f90 create mode 100644 flang/test/Semantics/enumeration-type-mod.f90 diff --git a/flang/test/Semantics/enumeration-type-intrinsics.f90 b/flang/test/Semantics/enumeration-type-intrinsics.f90 new file mode 100644 index 0000000000000..f4478903d8ddb --- /dev/null +++ b/flang/test/Semantics/enumeration-type-intrinsics.f90 @@ -0,0 +1,153 @@ +! RUN: %flang_fc1 -fsyntax-only -pedantic %s 2>&1 | FileCheck %s +! Test intrinsics HUGE, NEXT, PREVIOUS, INT for enumeration types (F2023 7.6.2) + +module enum_intrinsics_mod + enumeration type :: color + enumerator :: red, green, blue + end enumeration type + + enumeration type :: v_value + enumerator :: v_one, v_two, v_three + enumerator v_four + end enumeration type +end module + +subroutine test_huge() + use enum_intrinsics_mod + type(color) :: x + type(v_value) :: y + + ! HUGE(x) returns the last enumerator + x = huge(x) + y = huge(y) + + ! HUGE in comparison — should fold to .TRUE. + if (huge(x) == blue) continue + if (huge(y) == v_four) continue +end subroutine + +subroutine test_next() + use enum_intrinsics_mod + type(color) :: c, nc + integer :: istat + + ! NEXT(a) returns the next enumerator + c = red + nc = next(c) + + ! NEXT with constants + nc = next(red) + nc = next(green) + + ! NEXT with STAT= argument + nc = next(c, stat=istat) + nc = next(blue, stat=istat) +end subroutine + +subroutine test_previous() + use enum_intrinsics_mod + type(color) :: c, pc + integer :: istat + + ! PREVIOUS(a) returns the previous enumerator + c = blue + pc = previous(c) + + ! PREVIOUS with constants + pc = previous(blue) + pc = previous(green) + + ! PREVIOUS with STAT= argument + pc = previous(c, stat=istat) + pc = previous(red, stat=istat) +end subroutine + +subroutine test_int() + use enum_intrinsics_mod + integer :: i + integer(8) :: j + + ! INT(x) returns the ordinal position + i = int(red) + i = int(green) + i = int(blue) + + ! INT with KIND= argument + j = int(red, kind=8) + j = int(green, 8) +end subroutine + +subroutine test_int_parameter() + use enum_intrinsics_mod + ! INT(x) in parameter (constant) context + integer, parameter :: r = int(red) + integer, parameter :: g = int(green) + integer, parameter :: b = int(blue) + + ! Verify ordinals are 1-based + integer, parameter :: test1 = r ! should be 1 + integer, parameter :: test2 = g ! should be 2 + integer, parameter :: test3 = b ! should be 3 +end subroutine + +subroutine test_huge_constant() + use enum_intrinsics_mod + ! HUGE in constant context + logical, parameter :: h1 = huge(red) == blue + logical, parameter :: h2 = huge(v_one) == v_four +end subroutine + +subroutine test_next_constant() + use enum_intrinsics_mod + ! NEXT with constant folding — non-boundary cases + logical, parameter :: n1 = next(red) == green + logical, parameter :: n2 = next(green) == blue +end subroutine + +subroutine test_next_boundary_with_stat() + use enum_intrinsics_mod + type(color) :: nc + integer :: istat + ! NEXT at boundary with STAT — no error, STAT gets nonzero + nc = next(blue, stat=istat) + nc = next(huge(red), stat=istat) +end subroutine + +subroutine test_previous_constant() + use enum_intrinsics_mod + ! PREVIOUS with constant folding — non-boundary cases + logical, parameter :: p1 = previous(blue) == green + logical, parameter :: p2 = previous(green) == red +end subroutine + +subroutine test_previous_boundary_with_stat() + use enum_intrinsics_mod + type(color) :: pc + integer :: istat + ! PREVIOUS at boundary with STAT — no error, STAT gets nonzero + pc = previous(red, stat=istat) +end subroutine + +subroutine test_next_boundary_warning() + use enum_intrinsics_mod + type(color) :: nc + ! NEXT at boundary without STAT — warning + !CHECK: warning: NEXT() of last enumerator without STAT= causes error termination + nc = next(blue) +end subroutine + +subroutine test_previous_boundary_warning() + use enum_intrinsics_mod + type(color) :: pc + ! PREVIOUS at boundary without STAT — warning + !CHECK: warning: PREVIOUS() of first enumerator without STAT= causes error termination + pc = previous(red) +end subroutine + +subroutine test_huge_real_still_works() + ! Non-enumeration HUGE still works normally + real :: r + integer :: i + r = huge(r) + i = huge(i) +end subroutine diff --git a/flang/test/Semantics/enumeration-type-io.f90 b/flang/test/Semantics/enumeration-type-io.f90 new file mode 100644 index 0000000000000..2862d8d0bb9f4 --- /dev/null +++ b/flang/test/Semantics/enumeration-type-io.f90 @@ -0,0 +1,68 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +! Test I/O constraints for enumeration types (F2023 7.6.2) + +module enum_io_mod + enumeration type :: color + enumerator :: red, green, blue + end enumeration type +end module + +subroutine test_valid_io() + use enum_io_mod + type(color) :: c + character(10) :: fmt + c = red + fmt = '(I4)' + ! Valid: explicit format with I edit descriptor + write(*, '(I4)') c + ! Valid: explicit format via character variable + write(10, fmt) c + ! Valid: explicit format read + read(*, '(I4)') c +end subroutine + +subroutine test_list_directed() + use enum_io_mod + type(color) :: c + c = red + !ERROR: Enumeration type may not appear in list-directed output + print *, c + !ERROR: Enumeration type may not appear in list-directed input + read *, c +end subroutine + +subroutine test_unformatted() + use enum_io_mod + type(color) :: c + c = red + !ERROR: Enumeration type may not be used in unformatted I/O + write(10) c + !ERROR: Enumeration type may not be used in unformatted I/O + read(10) c +end subroutine + +subroutine test_namelist_enum_object() + use enum_io_mod + type(color) :: c + namelist /nml/ c + !ERROR: Enumeration type 'color' may not be a namelist group object + write(*, nml=nml) +end subroutine + +subroutine test_namelist_enum_component() + use enum_io_mod + type :: has_color + type(color) :: clr + integer :: n + end type + type(has_color) :: d + namelist /nml2/ d + !ERROR: Namelist group object 'd' has a direct component 'clr' of enumeration type + write(*, nml=nml2) +end subroutine + +subroutine test_namelist_valid() + integer :: n + namelist /nml3/ n + write(*, nml=nml3) +end subroutine diff --git a/flang/test/Semantics/enumeration-type-mod.f90 b/flang/test/Semantics/enumeration-type-mod.f90 new file mode 100644 index 0000000000000..3c2f7c8f96289 --- /dev/null +++ b/flang/test/Semantics/enumeration-type-mod.f90 @@ -0,0 +1,84 @@ +! RUN: %python %S/test_modfile.py %s %flang_fc1 +! Check correct modfile generation for enumeration types. + +! Basic enumeration type +module m1 + enumeration type :: color + enumerator :: red, green, blue + end enumeration type + type(color) :: c = green +end + +!Expect: m1.mod +!module m1 +!enumeration type::color +!enumerator::red,green,blue +!end enumeration type +!type(color)::c +!end + +! Private enumeration type +module m2 + enumeration type, private :: color + enumerator :: red, green, blue + end enumeration type +end + +!Expect: m2.mod +!module m2 +!enumeration type,private::color +!enumerator::red,green,blue +!end enumeration type +!end + +! Multiple enumeration types +module m3 + enumeration type :: color + enumerator :: red, green, blue + end enumeration type + enumeration type :: direction + enumerator :: north, south, east, west + end enumeration type +end + +!Expect: m3.mod +!module m3 +!enumeration type::color +!enumerator::red,green,blue +!end enumeration type +!enumeration type::direction +!enumerator::north,south,east,west +!end enumeration type +!end + +! Enumeration type with variable declaration +module m4 + enumeration type :: color + enumerator :: red, green, blue + end enumeration type + type(color) :: default_color = green + type(color), parameter :: favorite = blue +end + +!Expect: m4.mod +!module m4 +!enumeration type::color +!enumerator::red,green,blue +!end enumeration type +!type(color)::default_color +!type(color),parameter::favorite=color(3_4) +!end + +! USE and re-export +module m5 + use m1, only: color, red, green, blue, c +end + +!Expect: m5.mod +!module m5 +!use m1,only:color +!use m1,only:red +!use m1,only:green +!use m1,only:blue +!use m1,only:c +!end _______________________________________________ llvm-branch-commits mailing list [email protected] https://lists.llvm.org/cgi-bin/mailman/listinfo/llvm-branch-commits
