[llvm-branch-commits] [flang] [llvm] [flang] Enumeration Type: (PR 3/5) Intrinsics + I/O + Modules (PR #193235)
via llvm-branch-commits
llvm-branch-commits at lists.llvm.org
Tue Apr 21 07:45:12 PDT 2026
https://github.com/kwyatt-ext created https://github.com/llvm/llvm-project/pull/193235
This PR adds intrinsics: HUGE, INT, NEXT, and PREVIOUS. It adds support for I/O, specifically formatted I/O with explicit format. Also, it adds module support.
It is the 3rd of 5 stacked PRs.
AI Usage Disclosure: AI tools (Claude Opus 4.6) were used to assist with implementation of this feature and test code generation. I have reviewed, modified, and tested all AI-generated code.
>From d07c46c7809a33cec84ba0265943d808356f2872 Mon Sep 17 00:00:00 2001
From: Kevin Wyatt <kwyatt at hpe.com>
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 d4d7f2b705b3d..a5d693b372f61 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 84cd2288fcd0b..9341676a6c386 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2936,6 +2936,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;
@@ -2964,7 +2976,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 {
@@ -3620,6 +3632,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) {
@@ -3828,6 +4004,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 46abd3d298d02..f23c24777247f 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -331,6 +331,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
@@ -664,6 +679,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
@@ -1198,6 +1228,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)}) {
@@ -1263,6 +1304,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 3bfe1e144f961..7234dc74cb5dd 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"
@@ -590,6 +591,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() << ')';
@@ -662,6 +667,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::RECURSIVE};
@@ -1003,6 +1084,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 9b91c32adbc76..51d66f31b1d12 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -978,6 +978,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 ad3b73b8a3881b2c03627d8a7ac50a2dc9fb1e08 Mon Sep 17 00:00:00 2001
From: Kevin Wyatt <kwyatt at hpe.com>
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
More information about the llvm-branch-commits
mailing list