[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:45 PDT 2026
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: kwyatt-ext
<details>
<summary>Changes</summary>
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.
---
Patch is 36.27 KiB, truncated to 20.00 KiB below, full version: https://github.com/llvm/llvm-project/pull/193235.diff
12 Files Affected:
- (modified) flang-rt/include/flang-rt/runtime/stat.h (+1)
- (modified) flang-rt/lib/runtime/stat.cpp (+3)
- (modified) flang/include/flang/Runtime/magic-numbers.h (+5)
- (modified) flang/lib/Evaluate/fold-implementation.h (+74-1)
- (modified) flang/lib/Evaluate/intrinsics.cpp (+227-1)
- (modified) flang/lib/Semantics/check-io.cpp (+73)
- (modified) flang/lib/Semantics/mod-file.cpp (+86)
- (modified) flang/lib/Semantics/mod-file.h (+3)
- (modified) flang/lib/Semantics/type.cpp (+5)
- (added) flang/test/Semantics/enumeration-type-intrinsics.f90 (+153)
- (added) flang/test/Semantics/enumeration-type-io.f90 (+68)
- (added) flang/test/Semantics/enumeration-type-mod.f90 (+84)
``````````diff
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, sco...
[truncated]
``````````
</details>
https://github.com/llvm/llvm-project/pull/193235
More information about the llvm-branch-commits
mailing list