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 _______________________________________________ llvm-branch-commits mailing list [email protected] https://lists.llvm.org/cgi-bin/mailman/listinfo/llvm-branch-commits
