diff --git a/flang/examples/FeatureList/FeatureList.cpp b/flang/examples/FeatureList/FeatureList.cpp index 355d79a04e4ba..bee18096f9fb2 100644 --- a/flang/examples/FeatureList/FeatureList.cpp +++ b/flang/examples/FeatureList/FeatureList.cpp @@ -311,6 +311,7 @@ struct NodeVisitor { READ_FEATURE(Expr::NEQV) READ_FEATURE(Expr::DefinedBinary) READ_FEATURE(Expr::ComplexConstructor) + READ_FEATURE(ConditionalExpr) READ_FEATURE(External) READ_FEATURE(ExternalStmt) READ_FEATURE(FailImageStmt) diff --git a/flang/include/flang/Evaluate/expression.h b/flang/include/flang/Evaluate/expression.h index f7a1f9b955181..c8570e4a52e78 100644 --- a/flang/include/flang/Evaluate/expression.h +++ b/flang/include/flang/Evaluate/expression.h @@ -390,6 +390,34 @@ struct LogicalOperation LogicalOperator logicalOperator; }; +// Fortran 2023 conditional expression: (cond ? val : cond ? val : ... : else) +// All branches have the same type and rank (verified during semantic analysis). +template class ConditionalExpr { +public: + using Result = T; + CLASS_BOILERPLATE(ConditionalExpr) + ConditionalExpr(Expr &&cond, Expr &&thenVal, + Expr &&elseVal) + : condition_{std::move(cond)}, thenValue_{std::move(thenVal)}, + elseValue_{std::move(elseVal)} {} + bool operator==(const ConditionalExpr &) const; + Expr &condition() { return condition_.value(); } + const Expr &condition() const { return condition_.value(); } + Expr &thenValue() { return thenValue_.value(); } + const Expr &thenValue() const { return thenValue_.value(); } + Expr &elseValue() { return elseValue_.value(); } + const Expr &elseValue() const { return elseValue_.value(); } + int Rank() const { return thenValue().Rank(); } + std::optional GetType() const { return thenValue().GetType(); } + static constexpr int Corank() { return 0; } + llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; + +private: + common::CopyableIndirection> condition_; + common::CopyableIndirection> thenValue_; + common::CopyableIndirection> elseValue_; +}; + // Array constructors template class ArrayConstructorValues; @@ -536,7 +564,7 @@ class Expr> Convert>; using Operations = std::tuple, Negate, Add, Subtract, Multiply, Divide, - Power, Extremum>; + Power, Extremum, ConditionalExpr>; using Indices = std::conditional_t, std::tuple<>>; using TypeParamInquiries = @@ -568,7 +596,7 @@ class Expr> Convert>; using Operations = std::tuple, Negate, Add, Subtract, Multiply, Divide, - Power, Extremum>; + Power, Extremum, ConditionalExpr>; using Others = std::tuple, ArrayConstructor, Designator, FunctionRef>; @@ -594,7 +622,8 @@ class Expr> Convert>; using Operations = std::variant, Parentheses, Negate, Add, Subtract, Multiply, - Divide, Power, RealToIntPower, Extremum>; + Divide, Power, RealToIntPower, Extremum, + ConditionalExpr>; using Others = std::variant, ArrayConstructor, Designator, FunctionRef>; @@ -612,7 +641,7 @@ class Expr> using Operations = std::variant, Negate, Convert, Add, Subtract, Multiply, Divide, Power, RealToIntPower, - ComplexConstructor>; + ComplexConstructor, ConditionalExpr>; using Others = std::variant, ArrayConstructor, Designator, FunctionRef>; @@ -638,7 +667,7 @@ class Expr> std::variant, ArrayConstructor, Designator, FunctionRef, Parentheses, Convert, Concat, - Extremum, SetLength> + Extremum, SetLength, ConditionalExpr> u; }; @@ -710,7 +739,7 @@ class Expr> private: using Operations = std::tuple, Parentheses, Not, - LogicalOperation>; + LogicalOperation, ConditionalExpr>; using Relations = std::conditional_t>, std::tuple<>>; using Others = std::tuple, ArrayConstructor, @@ -788,7 +817,8 @@ template <> class Expr : public ExpressionBase { using Result = SomeDerived; EVALUATE_UNION_CLASS_BOILERPLATE(Expr) std::variant, ArrayConstructor, StructureConstructor, - Designator, FunctionRef, Parentheses> + Designator, FunctionRef, Parentheses, + ConditionalExpr> u; }; @@ -929,6 +959,7 @@ FOR_EACH_INTRINSIC_KIND(extern template class ArrayConstructor, ) template class Relational; \ FOR_EACH_TYPE_AND_KIND(template class ExpressionBase, ) \ FOR_EACH_INTRINSIC_KIND(template class ArrayConstructorValues, ) \ - FOR_EACH_INTRINSIC_KIND(template class ArrayConstructor, ) + FOR_EACH_INTRINSIC_KIND(template class ArrayConstructor, ) \ + FOR_EACH_INTRINSIC_KIND(template class ConditionalExpr, ) } // namespace Fortran::evaluate #endif // FORTRAN_EVALUATE_EXPRESSION_H_ diff --git a/flang/include/flang/Evaluate/fold.h b/flang/include/flang/Evaluate/fold.h index b21c0f311fd35..df43489aa679c 100644 --- a/flang/include/flang/Evaluate/fold.h +++ b/flang/include/flang/Evaluate/fold.h @@ -105,6 +105,15 @@ std::optional ToInt64(const Expr &); std::optional ToInt64(const Expr &); std::optional ToInt64(const ActualArgument &); +// When an expression is a constant logical scalar, ToLogical() extracts its +// value. +inline std::optional ToLogical(const Expr &expr) { + if (auto val{GetScalarConstantValue(expr)}) { + return val->IsTrue(); + } + return std::nullopt; +} + template std::optional ToInt64(const std::optional &x) { if (x) { diff --git a/flang/include/flang/Evaluate/shape.h b/flang/include/flang/Evaluate/shape.h index f0505cfcdf2d7..e5c2d6e8cb63d 100644 --- a/flang/include/flang/Evaluate/shape.h +++ b/flang/include/flang/Evaluate/shape.h @@ -189,6 +189,21 @@ class GetShapeHelper Result operator()(const ArrayConstructor &aconst) const { return Shape{GetArrayConstructorExtent(aconst)}; } + template + Result operator()(const ConditionalExpr &conditional) const { + // Per F2023 10.1.4(7), the shape is that of the selected branch. + // When all branches have identical static extents, return the common shape. + int rank{conditional.thenValue().Rank()}; + Result thenShape{(*this)(conditional.thenValue())}; + if (!thenShape) { + return Shape(rank, std::nullopt); + } + Result elseShape{(*this)(conditional.elseValue())}; + if (thenShape != elseShape) { + return Shape(rank, std::nullopt); + } + return thenShape; + } template Result operator()(const Operation &operation) const { if (int rr{operation.right().Rank()}; rr > 0) { diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index 0fded08456bcf..09c942d8d21b6 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -50,6 +50,9 @@ struct IsVariableHelper Result operator()(const CoarrayRef &) const { return true; } Result operator()(const ComplexPart &) const { return true; } Result operator()(const ProcedureDesignator &) const; + template Result operator()(const ConditionalExpr &) const { + return false; + } template Result operator()(const Expr &x) const { if constexpr (common::HasMember || std::is_same_v) { @@ -1381,6 +1384,7 @@ enum class Operator { Call, Constant, Convert, + Conditional, Div, Eq, Eqv, diff --git a/flang/include/flang/Evaluate/traverse.h b/flang/include/flang/Evaluate/traverse.h index d63c16f93230a..44cfaa2a7073d 100644 --- a/flang/include/flang/Evaluate/traverse.h +++ b/flang/include/flang/Evaluate/traverse.h @@ -224,6 +224,10 @@ class Traverse { Result operator()(const StructureConstructor &x) const { return visitor_.Combine(visitor_(x.derivedTypeSpec()), CombineContents(x)); } + // Conditional expressions (Fortran 2023) + template Result operator()(const ConditionalExpr &x) const { + return Combine(x.condition(), x.thenValue(), x.elseValue()); + } // Operations and wrappers // Have a single operator() for all Operations. diff --git a/flang/include/flang/Parser/characters.h b/flang/include/flang/Parser/characters.h index 3761700ad348c..620c6b357f948 100644 --- a/flang/include/flang/Parser/characters.h +++ b/flang/include/flang/Parser/characters.h @@ -170,6 +170,7 @@ inline constexpr bool IsValidFortranTokenCharacter(char ch) { case '<': case '=': case '>': + case '?': // Used in conditional expressions (Fortran 2023) case '[': case ']': case '{': // Used in OpenMP context selector specification diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h index 84c7b8d2a5349..eefab487413da 100644 --- a/flang/include/flang/Parser/dump-parse-tree.h +++ b/flang/include/flang/Parser/dump-parse-tree.h @@ -252,6 +252,7 @@ class ParseTreeDumper { NODE(parser, ComputedGotoStmt) NODE(parser, ConcurrentControl) NODE(parser, ConcurrentHeader) + NODE(parser, ConditionalExpr) NODE(parser, ConnectSpec) NODE(ConnectSpec, CharExpr) NODE_ENUM(ConnectSpec::CharExpr, Kind) diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h index 4aec99c80bdae..d19c344522881 100644 --- a/flang/include/flang/Parser/parse-tree.h +++ b/flang/include/flang/Parser/parse-tree.h @@ -1678,6 +1678,17 @@ struct ImageSelector { std::tuple, std::list> t; }; +// F2023 R1002 conditional-expr -> +// ( scalar-logical-expr ? expr +// [ : scalar-logical-expr ? expr ]... +// : expr ) +struct ConditionalExpr { + TUPLE_CLASS_BOILERPLATE(ConditionalExpr); + std::tuple, + common::Indirection> + t; +}; + // R1001 - R1022 expressions struct Expr { UNION_CLASS_BOILERPLATE(Expr); @@ -1776,11 +1787,12 @@ struct Expr { CharBlock source; std::variant, - LiteralConstant, common::Indirection, ArrayConstructor, - StructureConstructor, common::Indirection, Parentheses, - UnaryPlus, Negate, NOT, PercentLoc, DefinedUnary, Power, Multiply, Divide, - Add, Subtract, Concat, LT, LE, EQ, NE, GE, GT, AND, OR, EQV, NEQV, - DefinedBinary, ComplexConstructor, common::Indirection> + LiteralConstant, ConditionalExpr, common::Indirection, + ArrayConstructor, StructureConstructor, + common::Indirection, Parentheses, UnaryPlus, Negate, + NOT, PercentLoc, DefinedUnary, Power, Multiply, Divide, Add, Subtract, + Concat, LT, LE, EQ, NE, GE, GT, AND, OR, EQV, NEQV, DefinedBinary, + ComplexConstructor, common::Indirection> u; }; diff --git a/flang/include/flang/Semantics/dump-expr.h b/flang/include/flang/Semantics/dump-expr.h index 8cbb78b585f4a..d79a294258ff1 100644 --- a/flang/include/flang/Semantics/dump-expr.h +++ b/flang/include/flang/Semantics/dump-expr.h @@ -201,6 +201,19 @@ class DumpEvaluateExpr { Show(op.right()); Outdent(); } + template void Show(const evaluate::ConditionalExpr &x) { + Indent("conditional expr "s + std::string(TypeOf::name)); + Indent("condition"); + Show(x.condition()); + Outdent(); + Indent("then"); + Show(x.thenValue()); + Outdent(); + Indent("else"); + Show(x.elseValue()); + Outdent(); + Outdent(); + } void Show(const evaluate::Relational &x); template void Show(const evaluate::Expr &x) { Indent("expr <"s + std::string(TypeOf::name) + ">"s); diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h index 490399aa03ff8..0054a86486e79 100644 --- a/flang/include/flang/Semantics/expression.h +++ b/flang/include/flang/Semantics/expression.h @@ -169,6 +169,7 @@ class ExpressionAnalyzer { MaybeExpr Analyze(const parser::DataStmtValue &); MaybeExpr Analyze(const parser::AllocateObject &); MaybeExpr Analyze(const parser::PointerObject &); + MaybeExpr Analyze(const parser::ConditionalExpr &); template MaybeExpr Analyze(const common::Indirection &x) { return Analyze(x.value()); diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index e73a4d82951af..be7db0f20821d 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -112,6 +112,19 @@ class IsConstantExprHelper return result; } + template bool operator()(const ConditionalExpr &x) const { + // A conditional expression is a primary. Therefore, only the selected + // branch must be constant. If the condition is a constant expression + // whose value cannot yet be determined, both branches must be constant. + if (!(*this)(x.condition())) { + return false; + } else if (auto condVal{ToLogical(x.condition())}) { + return *condVal ? (*this)(x.thenValue()) : (*this)(x.elseValue()); + } else { + return (*this)(x.thenValue()) && (*this)(x.elseValue()); + } + } + private: bool IsConstantStructureConstructorComponent( const Symbol &, const Expr &) const; @@ -358,6 +371,10 @@ class IsInitialDataTargetHelper bool operator()(const Operation &) const { return false; } + template bool operator()(const ConditionalExpr &) const { + // A conditional expression cannot be an initial data target + return false; + } template bool operator()(const Parentheses &x) const { return (*this)(x.left()); } @@ -1193,6 +1210,12 @@ class IsContiguousHelper Result operator()(const NullPointer &) const { return true; } + template Result operator()(const ConditionalExpr &x) { + // Conditional expressions are never variables; expression results are + // always contiguous. + return true; + } + private: // Returns "true" for a provably empty or simply contiguous array section; // return "false" for a provably nonempty discontiguous section or for use @@ -1760,6 +1783,12 @@ class CollectUsedSymbolValuesHelper return {}; // doesn't count as a use } + template Result operator()(const ConditionalExpr &condExpr) { + auto restorer{common::ScopedSet(isDefinition_, false)}; + return Combine((*this)(condExpr.condition()), + Combine((*this)(condExpr.thenValue()), (*this)(condExpr.elseValue()))); + } + private: static bool IsBindingUsedAsProcedure(const Expr &expr) { if (const auto *pd{std::get_if(&expr.u)}) { diff --git a/flang/lib/Evaluate/expression.cpp b/flang/lib/Evaluate/expression.cpp index 759fe5bc71b69..128c39b3eb004 100644 --- a/flang/lib/Evaluate/expression.cpp +++ b/flang/lib/Evaluate/expression.cpp @@ -64,6 +64,16 @@ Expr>::LEN() const { } return std::nullopt; }, + [](const ConditionalExpr &x) -> T { + if (auto tlen{x.thenValue().LEN()}) { + if (auto elen{x.elseValue().LEN()}) { + if (*tlen == *elen) { + return tlen; + } + } + } + return std::nullopt; + }, [](const Designator &dr) { return dr.LEN(); }, [](const FunctionRef &fr) { return fr.LEN(); }, [](const SetLength &x) -> T { return x.right(); }, @@ -141,6 +151,12 @@ template bool Extremum::operator==(const Extremum &that) const { return ordering == that.ordering && Base::operator==(that); } +template +bool ConditionalExpr::operator==(const ConditionalExpr &that) const { + return condition_ == that.condition_ && thenValue_ == that.thenValue_ && + elseValue_ == that.elseValue_; +} + template bool LogicalOperation::operator==(const LogicalOperation &that) const { return logicalOperator == that.logicalOperator && Base::operator==(that); diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h index 529e3a9ad5a08..d4d7f2b705b3d 100644 --- a/flang/lib/Evaluate/fold-implementation.h +++ b/flang/lib/Evaluate/fold-implementation.h @@ -143,6 +143,8 @@ Expr FoldOperation( template Expr FoldOperation(FoldingContext &, ArrayConstructor &&); Expr FoldOperation(FoldingContext &, StructureConstructor &&); +template +Expr FoldOperation(FoldingContext &, ConditionalExpr &&); template std::optional> Folder::GetNamedConstant(const Symbol &symbol0) { @@ -2211,6 +2213,17 @@ Expr FoldOperation(FoldingContext &context, RealToIntPower &&x) { x.right().u); } +template +Expr FoldOperation(FoldingContext &context, ConditionalExpr &&x) { + x.condition() = Fold(context, std::move(x.condition())); + // If the condition is a scalar logical constant, select the branch. + if (auto cst{GetScalarConstantValue(x.condition())}) { + return cst->IsTrue() ? Fold(context, std::move(x.thenValue())) + : Fold(context, std::move(x.elseValue())); + } + return Expr{std::move(x)}; +} + template Expr FoldOperation(FoldingContext &context, Extremum &&x) { if (auto array{ApplyElementwise(context, x, diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp index 5632015857ab3..09cb8b08dda81 100644 --- a/flang/lib/Evaluate/formatting.cpp +++ b/flang/lib/Evaluate/formatting.cpp @@ -587,6 +587,29 @@ llvm::raw_ostream &ArrayConstructor::AsFortran( return o << ']'; } +template +llvm::raw_ostream &ConditionalExpr::AsFortran(llvm::raw_ostream &o) const { + // Iterate over chained else-branches to avoid adding extra parentheses for + // chained conditional expressions. + o << '('; + const ConditionalExpr *node{this}; + while (true) { + node->condition().AsFortran(o); + o << " ? "; + node->thenValue().AsFortran(o); + o << " : "; + // Continue chain for nested ConditionalExpr; else emit terminal value. + if (const auto *nested{ + std::get_if>(&node->elseValue().u)}) { + node = nested; + } else { + node->elseValue().AsFortran(o); + break; + } + } + return o << ')'; +} + template std::string ExpressionBase::AsFortran() const { std::string buf; diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index 9b7d4c758769e..e82e5f749f20c 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1185,6 +1185,9 @@ struct HasVectorSubscriptHelper bool operator()(const ProcedureRef &) const { return false; // don't descend into function call arguments } + template bool operator()(const ConditionalExpr &) const { + return false; // not a variable designator + } }; bool HasVectorSubscript(const Expr &expr) { @@ -1726,6 +1729,14 @@ struct ArgumentExtractor return {operation::OperationCode(x), {AsSomeExpr(x)}}; } + template Result operator()(const ConditionalExpr &x) const { + // Return the condition and then/else branches as immediate operands; + // nested conditionals are not permitted in an OpenMP atomic context. + return {Operator::Conditional, + {AsSomeExpr(x.condition()), AsSomeExpr(x.thenValue()), + AsSomeExpr(x.elseValue())}}; + } + template Result Combine(Result &&result, Rs &&...results) const { // There shouldn't be any combining needed, since we're stopping the @@ -1763,6 +1774,8 @@ std::string operation::ToString(operation::Operator op) { return "ASSOCIATED"; case Operator::Call: return "function-call"; + case Operator::Conditional: + return "conditional"; case Operator::Constant: return "constant"; case Operator::Convert: @@ -1891,6 +1904,13 @@ struct ConvertCollector } } + template Result operator()(const ConditionalExpr &x) const { + // ConvertCollector tracks the typed-value conversion chain (for OMP ATOMIC + // validation); the condition is a LOGICAL(4) selector, not a value output, + // so only the value branches are collected. + return Combine((*this)(x.thenValue()), (*this)(x.elseValue())); + } + template Result Combine(Result &&result, Rs &&...results) const { Result v(std::move(result)); diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index a7e0239d335fd..32cd710e9b5b4 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -927,6 +927,11 @@ class ScalarExprLowering { return builder.createNullConstant(getLoc()); } + template + ExtValue genval(const Fortran::evaluate::ConditionalExpr &) { + fir::emitFatalError(getLoc(), "ConditionalExpr should be lowered to HLFIR"); + } + static bool isDerivedTypeWithLenParameters(const Fortran::semantics::Symbol &sym) { if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType()) @@ -5366,6 +5371,11 @@ class ArrayExprLowering { }; } + template + CC genarr(const Fortran::evaluate::ConditionalExpr &) { + fir::emitFatalError(getLoc(), "ConditionalExpr should be lowered to HLFIR"); + } + template CC genarr(const Fortran::evaluate::Constant &x) { if (x.Rank() == 0) diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp index 0c015bc9a2f1b..b6816ae91e44f 100644 --- a/flang/lib/Lower/ConvertExprToHLFIR.cpp +++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -1821,6 +1821,155 @@ class HlfirBuilder { llvm_unreachable("unknown descriptor inquiry"); } + /// Build nested if-then-else chain by walking the right-skewed + /// ConditionalExpr tree. The assignValue callback generates and assigns + /// each value to avoid evaluating non-taken branches. + template + void + buildConditionalIfChain(const Fortran::evaluate::ConditionalExpr &condExpr, + const Callback &assignValue) { + const mlir::Location loc{getLoc()}; + fir::FirOpBuilder &builder{getBuilder()}; + getStmtCtx().pushScope(); + const hlfir::EntityWithAttributes condEntity{gen(condExpr.condition())}; + mlir::Value condition{hlfir::loadTrivialScalar(loc, builder, condEntity)}; + condition = builder.createConvert(loc, builder.getI1Type(), condition); + builder.genIfOp(loc, {}, condition, /*withElseRegion=*/true) + .genThen([&]() { + getStmtCtx().pushScope(); + assignValue(condExpr.thenValue()); + getStmtCtx().finalizeAndPop(); + }) + .genElse([&]() { + getStmtCtx().pushScope(); + assignValue(condExpr.elseValue()); + getStmtCtx().finalizeAndPop(); + }) + .end(); + getStmtCtx().finalizeAndPop(); + } + + /// Generate scalar conditional with lazy evaluation using assignment. + /// Creates a temporary and assigns the selected branch value to it. + template + hlfir::Entity + genScalarConditional(const Fortran::evaluate::ConditionalExpr &condExpr, + mlir::Type elementType, + const llvm::SmallVector &typeParams) { + const mlir::Location loc{getLoc()}; + fir::FirOpBuilder &builder{getBuilder()}; + const mlir::Value tempStorage{builder.createTemporary( + loc, elementType, ".cond.scalar", + /*shape=*/mlir::ValueRange{}, /*typeParams=*/typeParams)}; + const hlfir::DeclareOp tempDecl{hlfir::DeclareOp::create( + builder, loc, tempStorage, ".cond.result", + /*shape=*/mlir::Value{}, /*typeParams=*/typeParams)}; + const hlfir::Entity temp{tempDecl}; + buildConditionalIfChain( + condExpr, [&](const Fortran::evaluate::Expr &expr) { + hlfir::Entity entity{gen(expr)}; + entity = hlfir::loadTrivialScalar(loc, builder, entity); + hlfir::AssignOp::create(builder, loc, entity, temp); + }); + return temp; + } + + /// Generate conditional expression using an allocatable temporary with lazy + /// evaluation. Creates an unallocated allocatable, then uses assignment to + /// set the value from the chosen branch (allocation/reallocation handled by + /// runtime). + template + hlfir::Entity genAllocatableConditional( + const Fortran::evaluate::ConditionalExpr &condExpr, + mlir::Type resultType, llvm::StringRef debugName) { + const mlir::Location loc{getLoc()}; + fir::FirOpBuilder &builder{getBuilder()}; + const mlir::Type heapType{fir::HeapType::get(resultType)}; + const mlir::Type boxHeapType{fir::BoxType::get(heapType)}; + const mlir::Value tempStorage{ + builder.createTemporary(loc, boxHeapType, debugName)}; + const mlir::Value unallocBox{fir::factory::createUnallocatedBox( + builder, loc, boxHeapType, /*nonDeferredParams=*/{})}; + builder.createStoreWithConvert(loc, unallocBox, tempStorage); + const hlfir::DeclareOp tempDecl{ + hlfir::DeclareOp::create(builder, loc, tempStorage, ".cond.result")}; + const hlfir::Entity temp{tempDecl}; + // Lazy evaluation: only the selected branch is evaluated and assigned. + buildConditionalIfChain( + condExpr, [&](const Fortran::evaluate::Expr &expr) { + const hlfir::Entity entity{gen(expr)}; + hlfir::AssignOp::create(builder, loc, entity, temp, + /*isWholeAllocatableAssignment=*/true, + /*keepLhsLengthIfRealloc=*/false, + /*temporary_lhs=*/true); + }); + fir::FirOpBuilder *const bldr{&builder}; + getStmtCtx().attachCleanup([=]() { + fir::factory::genFreememIfAllocated( + *bldr, loc, + fir::MutableBoxValue{tempStorage, /*lenParams=*/{}, + fir::MutableProperties{}}); + }); + return temp; + } + + /// Generate scalar CHARACTER conditional with proper length handling. + template + std::optional genCharacterConditional( + const Fortran::evaluate::ConditionalExpr &condExpr) { + const mlir::Location loc{getLoc()}; + fir::FirOpBuilder &builder{getBuilder()}; + const mlir::Type resultType{Fortran::lower::translateSomeExprToFIRType( + converter, toEvExpr(condExpr))}; + const mlir::Type elementType{hlfir::getFortranElementType(resultType)}; + if (auto charType = mlir::dyn_cast(elementType)) { + if (charType.hasConstantLen()) { + llvm::SmallVector typeParams; + const mlir::Value len{builder.createIntegerConstant( + loc, builder.getCharacterLengthType(), charType.getLen())}; + typeParams.push_back(len); + return hlfir::EntityWithAttributes{ + genScalarConditional(condExpr, elementType, typeParams)}; + } + // Non-constant/varying length: use allocatable conditional to get length + // from selected branch. + return hlfir::EntityWithAttributes{ + genAllocatableConditional(condExpr, elementType, ".cond.char")}; + } + return std::nullopt; + } + + /// Conditional expression (Fortran 2023) + template + hlfir::EntityWithAttributes + gen(const Fortran::evaluate::ConditionalExpr &condExpr) { + const int rank{condExpr.Rank()}; + mlir::Type resultType{Fortran::lower::translateSomeExprToFIRType( + converter, toEvExpr(condExpr))}; + if (fir::isPolymorphicType(resultType)) + TODO(getLoc(), "polymorphic conditional expression"); + if (fir::isRecordWithTypeParameters( + hlfir::getFortranElementType(resultType))) + TODO(getLoc(), "conditional expression with length-parameterized " + "derived type"); + // Arrays: handle early to avoid unnecessary type checks. + // Per F2023 10.1.4(7), the shape is determined by the chosen branch. + if (rank != 0) { + const mlir::Type condResultType{ + hlfir::getFortranElementOrSequenceType(resultType)}; + return hlfir::EntityWithAttributes{ + genAllocatableConditional(condExpr, condResultType, ".cond.array")}; + } + // CHARACTER scalars require special handling for type parameters. + if constexpr (T::category == Fortran::common::TypeCategory::Character) { + if (auto result = genCharacterConditional(condExpr)) + return *result; + } + // Scalar types (INTEGER, REAL, COMPLEX, LOGICAL, UNSIGNED, Derived). + return hlfir::EntityWithAttributes{genScalarConditional( + condExpr, hlfir::getFortranElementType(resultType), {})}; + } + hlfir::EntityWithAttributes gen(const Fortran::evaluate::ImpliedDoIndex &var) { mlir::Value value = symMap.lookupImpliedDo(toStringRef(var.name)); diff --git a/flang/lib/Lower/IterationSpace.cpp b/flang/lib/Lower/IterationSpace.cpp index 203fec508f795..52a15223bc1e6 100644 --- a/flang/lib/Lower/IterationSpace.cpp +++ b/flang/lib/Lower/IterationSpace.cpp @@ -212,6 +212,14 @@ class ArrayBaseFinder { (void)find(op.right()); return false; } + template + RT find(const Fortran::evaluate::ConditionalExpr &x) { + // Find array bases in condition and values + (void)find(x.condition()); + (void)find(x.thenValue()); + (void)find(x.elseValue()); + return {}; + } RT find(const Fortran::evaluate::Relational &x) { (void)find(x.u); return {}; diff --git a/flang/lib/Lower/Support/Utils.cpp b/flang/lib/Lower/Support/Utils.cpp index 384636a659875..280968975ea96 100644 --- a/flang/lib/Lower/Support/Utils.cpp +++ b/flang/lib/Lower/Support/Utils.cpp @@ -158,6 +158,11 @@ class HashEvaluateExpr { static_cast(TC) + static_cast(KIND) + static_cast(x.ordering) * 7u; } + template + static unsigned getHashValue(const Fortran::evaluate::ConditionalExpr &x) { + return getHashValue(x.condition()) * 151u - + getHashValue(x.thenValue()) * 3u + getHashValue(x.elseValue()); + } template static unsigned getHashValue( const Fortran::evaluate::RealToIntPower> @@ -416,6 +421,13 @@ class IsEqualEvaluateExpr { const Fortran::evaluate::Extremum &y) { return isBinaryEqual(x, y); } + template + static bool isEqual(const Fortran::evaluate::ConditionalExpr &x, + const Fortran::evaluate::ConditionalExpr &y) { + return isEqual(x.condition(), y.condition()) && + isEqual(x.thenValue(), y.thenValue()) && + isEqual(x.elseValue(), y.elseValue()); + } template static bool isEqual(const Fortran::evaluate::RealToIntPower &x, const Fortran::evaluate::RealToIntPower &y) { diff --git a/flang/lib/Parser/expr-parsers.cpp b/flang/lib/Parser/expr-parsers.cpp index b6832a7999c5b..db29b15a1fa05 100644 --- a/flang/lib/Parser/expr-parsers.cpp +++ b/flang/lib/Parser/expr-parsers.cpp @@ -61,15 +61,50 @@ TYPE_PARSER(parenthesized( TYPE_PARSER(construct( maybe(integerTypeSpec / "::"), loopBounds(scalarIntExpr))) +// Conditional expression lookahead helper: checks if input starting with '(' +// contains '?' at nesting level 1. This avoids exponential backtracking when +// parsing deeply nested parentheses that are not conditional expressions. +struct ConditionalExprLookahead { + using resultType = Success; + constexpr ConditionalExprLookahead() {} + std::optional Parse(ParseState &state) const { + ParseState scan{state}; + if (!attempt("("_tok).Parse(scan)) { + return std::nullopt; + } + int nestLevel{1}; + while (!scan.IsAtEnd()) { + if (attempt(charLiteralConstant).Parse(scan)) { + // Skip character literals; don't check contents. + } else if (attempt("("_tok).Parse(scan)) { + ++nestLevel; + } else if (attempt(")"_tok).Parse(scan)) { + if (--nestLevel == 0) { + return std::nullopt; + } + } else if (attempt("?"_tok).Parse(scan)) { + if (nestLevel == 1) { + return {Success{}}; + } + } else { + scan.UncheckedAdvance(); + } + } + return std::nullopt; + } +}; + // R1001 primary -> // literal-constant | designator | array-constructor | // structure-constructor | function-reference | type-param-inquiry | -// type-param-name | ( expr ) +// type-param-name | ( expr ) | conditional-expr // type-param-inquiry is parsed as a structure component, except for // substring%KIND/LEN constexpr auto primary{instrumented("primary"_en_US, first(construct(indirect(charLiteralConstantSubstring)), construct(literalConstant), + construct(ConditionalExprLookahead{} >> + parenthesized(Parser{})), construct(construct("(" >> expr / !","_tok / recovery(")"_tok, SkipPastNested<'(', ')'>{}))), construct(indirect(functionReference) / !"("_tok / !"%"_tok), @@ -94,6 +129,17 @@ constexpr auto level1Expr{sourced( primary || // must come before define op to resolve .TRUE._8 ambiguity construct(construct(definedOpName, primary)))}; +// F2023 R1002 conditional-expr -> +// ( scalar-logical-expr ? expr +// [ : scalar-logical-expr ? expr ]... +// : expr ) +// The chained list form is encoded as a right-associative tree: the else-expr +// is either a chained conditional-expr (which need not be separately +// parenthesized) or a terminal expr. +TYPE_PARSER( + construct(scalarLogicalExpr / "?", indirect(expr) / ":", + indirect(construct(Parser{}) || expr))) + // R1004 mult-operand -> level-1-expr [power-op mult-operand] // R1007 power-op -> ** // Exponentiation (**) is Fortran's only right-associative binary operation. diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp index 9d01bb74d70d3..1e64fec68d007 100644 --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -900,6 +900,17 @@ class UnparseVisitor { void Unparse(const Expr::OR &x) { Walk(x.t, ".OR."); } void Unparse(const Expr::EQV &x) { Walk(x.t, ".EQV."); } void Unparse(const Expr::NEQV &x) { Walk(x.t, ".NEQV."); } + void Unparse(const ConditionalExpr &x) { // F2023 R1002 + // Note: chained conditionals produce extra parentheses due to recursive + // else-expr unparsing; the result is still valid. + Put("( "); + Walk(std::get<0>(x.t)); // scalar-logical-expr + Put(" ? "); + Walk(std::get<1>(x.t)); // then-expr + Put(" : "); + Walk(std::get<2>(x.t)); // else-expr + Put(" )"); + } void Unparse(const Expr::ComplexConstructor &x) { Put('('), Walk(x.t, ","), Put(')'); } diff --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp index de16422b89abd..6f5eb0cb41ccd 100644 --- a/flang/lib/Semantics/definable.cpp +++ b/flang/lib/Semantics/definable.cpp @@ -305,6 +305,10 @@ class DuplicatedSubscriptFinder } return anyVector ? false : (*this)(aRef.base()); } + template bool operator()(const evaluate::ConditionalExpr &) { + // A conditional expression is not a variable and cannot be definable. + return false; + } private: evaluate::FoldingContext &foldingContext_; diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 457c5a3594f6d..55faba5d9a369 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -3880,6 +3880,111 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::PercentLoc &x) { return MakeFunctionRef(loc, ActualArguments{std::move(*arg)}); } +MaybeExpr ExpressionAnalyzer::Analyze(const parser::ConditionalExpr &x) { + // Chained else-expressions recurse automatically through Analyze(Expr). + MaybeExpr condExpr{Analyze(std::get<0>(x.t))}; + MaybeExpr thenExpr{Analyze(std::get<1>(x.t).value())}; + MaybeExpr elseExpr{Analyze(std::get<2>(x.t).value())}; + if (!condExpr || !thenExpr || !elseExpr) { + return std::nullopt; + } + if (std::holds_alternative(thenExpr->u) || + std::holds_alternative(elseExpr->u)) { + Say("BOZ literal constant in conditional expression must have explicit " + "type (e.g., INT(z'FF'), REAL(z'3F800000'))"_err_en_US); + return std::nullopt; + } + if (IsNullPointerOrAllocatable(&*thenExpr) || + IsNullPointerOrAllocatable(&*elseExpr)) { + Say("NULL() not allowed in a conditional expression"_err_en_US); + return std::nullopt; + } + if (semantics::IsAssumedRank(*thenExpr) || + semantics::IsAssumedRank(*elseExpr)) { + Say("An assumed-rank dummy argument may not be used as a value in a conditional expression"_err_en_US); + return std::nullopt; + } + if ((ExtractDataRef(thenExpr) && + ExtractCoarrayRef(*ExtractDataRef(thenExpr))) || + (ExtractDataRef(elseExpr) && + ExtractCoarrayRef(*ExtractDataRef(elseExpr)))) { + Say("Conditional expression values may not be coindexed"_err_en_US); + return std::nullopt; + } + // F2023 C1004: then-expr and else-expr must have the same declared type, + // kind type parameters, and rank. + if (thenExpr->Rank() != elseExpr->Rank()) { + Say("All values in conditional expression must have the same rank; have rank %d and %d"_err_en_US, + thenExpr->Rank(), elseExpr->Rank()); + return std::nullopt; + } + const std::optional thenType{thenExpr->GetType()}; + const std::optional elseType{elseExpr->GetType()}; + if (!thenType || !elseType) { + Say("Cannot determine type of conditional expression"_err_en_US); + return std::nullopt; + } + const TypeCategory thenCat{thenType->category()}; + const TypeCategory elseCat{elseType->category()}; + if (thenCat != elseCat || + (thenCat != TypeCategory::Derived && + thenType->kind() != elseType->kind())) { + Say("All values in conditional expression must have the same type and kind; have %s and %s"_err_en_US, + thenType->AsFortran(), elseType->AsFortran()); + return std::nullopt; + } + if (thenCat == TypeCategory::Derived && + (thenType->IsPolymorphic() || elseType->IsPolymorphic())) { + Say("Conditional expressions with polymorphic types (CLASS) are not yet supported"_todo_en_US); + return std::nullopt; + } + if (thenCat == TypeCategory::Derived && + !AreSameDerivedType( + thenType->GetDerivedTypeSpec(), elseType->GetDerivedTypeSpec())) { + Say("All values in conditional expression must be the same derived type; have %s and %s"_err_en_US, + thenType->AsFortran(), elseType->AsFortran()); + return std::nullopt; + } + + // Dispatch on the else-expr to recover the concrete kind type T. + return common::visit( + common::visitors{ + [&](Expr &&elseVal) -> MaybeExpr { + Expr cond{ConvertToType( + std::move(std::get>(condExpr->u)))}; + Expr thenVal{ + std::move(std::get>(thenExpr->u))}; + return AsGenericExpr( + Expr{evaluate::ConditionalExpr{ + std::move(cond), std::move(thenVal), std::move(elseVal)}}); + }, + [&](auto &&elseCatExpr) -> MaybeExpr { + using CategoryType = std::decay_t; + if constexpr (std::is_same_v || + std::is_same_v || + std::is_same_v || + std::is_same_v) { + DIE("Invalid expression type in conditional expression"); + } else { + return common::visit( + [&](auto &&elseKindExpr) -> MaybeExpr { + using T = + typename std::decay_t::Result; + Expr cond{ConvertToType( + std::move(std::get>(condExpr->u)))}; + Expr thenVal{std::move(std::get>( + std::get(thenExpr->u).u))}; + return AsGenericExpr(CategoryType{ + Expr{evaluate::ConditionalExpr{std::move(cond), + std::move(thenVal), std::move(elseKindExpr)}}}); + }, + elseCatExpr.u); + } + }, + }, + std::move(elseExpr->u)); +} + MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedUnary &x) { const auto &name{std::get(x.t).v}; ArgumentAnalyzer analyzer{*this, name.source}; @@ -5144,6 +5249,12 @@ std::optional ArgumentAnalyzer::AnalyzeExpr( } context_.SayAt(expr.source, "TYPE(*) dummy argument may only be used as an actual argument"_err_en_US); + } else if (isProcedureCall_ && + std::holds_alternative(expr.u)) { + // Check parse tree before analysis to avoid wasted work + context_.SayAt(expr.source, + "Conditional expressions are not yet supported as actual arguments"_todo_en_US); + return std::nullopt; } else if (MaybeExpr argExpr{AnalyzeExprOrWholeAssumedSizeArray(expr)}) { if (isProcedureCall_ || !IsProcedureDesignator(*argExpr)) { // Pad Hollerith actual argument with spaces up to a multiple of 8 diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp index b553fe874a378..f3f034530af9f 100644 --- a/flang/lib/Semantics/openmp-utils.cpp +++ b/flang/lib/Semantics/openmp-utils.cpp @@ -298,6 +298,12 @@ struct LogicalConstantVistor : public evaluate::Traverse + Result operator()(const evaluate::ConditionalExpr &) const { + // A conditional expression is not treated as a constant logical value. + return std::nullopt; + } }; } // namespace diff --git a/flang/test/Evaluate/fold-conditional-expr.f90 b/flang/test/Evaluate/fold-conditional-expr.f90 new file mode 100644 index 0000000000000..0240859cae9ff --- /dev/null +++ b/flang/test/Evaluate/fold-conditional-expr.f90 @@ -0,0 +1,42 @@ +! RUN: %python %S/test_folding.py %s %flang_fc1 +! Tests folding of conditional expressions (Fortran 2023) +module m + ! Basic scalar folding: constant condition selects the chosen branch. + logical, parameter :: test_true_int = (.true. ? 1 : 2) == 1 + logical, parameter :: test_false_int = (.false. ? 1 : 2) == 2 + logical, parameter :: test_true_real = (.true. ? 1.0 : 2.0) == 1.0 + logical, parameter :: test_false_real = (.false. ? 1.0 : 2.0) == 2.0 + logical, parameter :: test_true_logical = (.true. ? .true. : .false.) + logical, parameter :: test_false_logical = (.false. ? .false. : .true.) + + ! Multi-branch: right-skewed tree folds correctly. + ! (.true. ? 10 : .false. ? 20 : 30) == 10 + logical, parameter :: test_multi_first = (.true. ? 10 : .false. ? 20 : 30) == 10 + ! (.false. ? 10 : .true. ? 20 : 30) == 20 + logical, parameter :: test_multi_second = (.false. ? 10 : .true. ? 20 : 30) == 20 + ! (.false. ? 10 : .false. ? 20 : 30) == 30 + logical, parameter :: test_multi_third = (.false. ? 10 : .false. ? 20 : 30) == 30 + + ! Named constant expressions in branches are folded. + integer, parameter :: x = 5 + logical, parameter :: test_branch_fold = (.true. ? x + 1 : x + 2) == 6 + + ! Named constant as condition. + logical, parameter :: cond = .true. + logical, parameter :: test_named_cond = (cond ? 42 : 0) == 42 + + ! Character: constant condition selects the branch value. + logical, parameter :: test_char = (.true. ? 'yes' : 'no') == 'yes' + + ! Non-constant branch: only the selected branch need be constant (F2023 10.1.12). + integer :: non_const = 99 + logical, parameter :: test_true_const_else_nonconstant = (.true. ? 10 : non_const) == 10 + logical, parameter :: test_false_const_then_nonconstant = (.false. ? non_const : 10) == 10 + + ! Named constant condition with a non-constant branch. + logical, parameter :: flag = .true. + logical, parameter :: test_named_cond_nonconstant = (flag ? 1 : non_const) == 1 + logical, parameter :: flag_false = .false. + logical, parameter :: test_named_cond_false_nonconstant = (flag_false ? non_const : 1) == 1 + +end module diff --git a/flang/test/Lower/HLFIR/conditional-expr.f90 b/flang/test/Lower/HLFIR/conditional-expr.f90 new file mode 100644 index 0000000000000..d0d7f41a92124 --- /dev/null +++ b/flang/test/Lower/HLFIR/conditional-expr.f90 @@ -0,0 +1,273 @@ +! Test lowering of conditional expressions (Fortran 2023) +! RUN: %flang_fc1 -emit-hlfir -o - %s 2>&1 | FileCheck %s + +! CHECK-LABEL: func.func @_QPtest_scalar_integer( +! CHECK-SAME: %[[FLAG:.*]]: !fir.ref> {fir.bindc_name = "flag"}, +! CHECK-SAME: %[[X:.*]]: !fir.ref {fir.bindc_name = "x"}, +! CHECK-SAME: %[[Y:.*]]: !fir.ref {fir.bindc_name = "y"}) +subroutine test_scalar_integer(flag, x, y) + logical :: flag + integer :: x, y, result + ! CHECK: %[[TEMP:.*]] = fir.alloca i32 {bindc_name = ".cond.scalar" + ! CHECK-DAG: %[[FLAG_DECL:.*]]:2 = hlfir.declare %[[FLAG]] + ! CHECK-DAG: %[[X_DECL:.*]]:2 = hlfir.declare %[[X]] + ! CHECK-DAG: %[[Y_DECL:.*]]:2 = hlfir.declare %[[Y]] + ! CHECK: %[[TEMP_DECL:.*]]:2 = hlfir.declare %[[TEMP]] {uniq_name = ".cond.result"} + + result = (flag ? x : y) + ! CHECK: %[[FLAG_LOAD:.*]] = fir.load %[[FLAG_DECL]]#0 + ! CHECK: %[[FLAG_CONV:.*]] = fir.convert %[[FLAG_LOAD]] : (!fir.logical<4>) -> i1 + ! CHECK: fir.if %[[FLAG_CONV]] { + ! CHECK: %[[X_LOAD:.*]] = fir.load %[[X_DECL]]#0 : !fir.ref + ! CHECK: hlfir.assign %[[X_LOAD]] to %[[TEMP_DECL]]#0 : i32, !fir.ref + ! CHECK: } else { + ! CHECK: %[[Y_LOAD:.*]] = fir.load %[[Y_DECL]]#0 : !fir.ref + ! CHECK: hlfir.assign %[[Y_LOAD]] to %[[TEMP_DECL]]#0 : i32, !fir.ref + ! CHECK: } + ! CHECK: %[[LOAD:.*]] = fir.load %[[TEMP_DECL]]#0 + ! CHECK: hlfir.assign %[[LOAD]] to %{{.*}} : i32, !fir.ref +end subroutine + +! CHECK-LABEL: func.func @_QPtest_scalar_real( +subroutine test_scalar_real(flag, x, y) + logical :: flag + real :: x, y, result + result = (flag ? x : y) + ! CHECK: %[[TEMP:.*]] = fir.alloca f32 {bindc_name = ".cond.scalar" + ! CHECK: %[[TEMP_DECL:.*]]:2 = hlfir.declare %[[TEMP]] {uniq_name = ".cond.result"} + ! CHECK: fir.if + ! CHECK: hlfir.assign {{.*}} to %[[TEMP_DECL]]#0 : f32, !fir.ref + ! CHECK: } else { + ! CHECK: hlfir.assign {{.*}} to %[[TEMP_DECL]]#0 : f32, !fir.ref + ! CHECK: } +end subroutine + +! CHECK-LABEL: func.func @_QPtest_scalar_complex( +subroutine test_scalar_complex(flag, x, y) + logical :: flag + complex :: x, y, result + result = (flag ? x : y) + ! CHECK: %[[TEMP:.*]] = fir.alloca complex {bindc_name = ".cond.scalar" + ! CHECK: %[[TEMP_DECL:.*]]:2 = hlfir.declare %[[TEMP]] {uniq_name = ".cond.result"} + ! CHECK: fir.if + ! CHECK: hlfir.assign {{.*}} to %[[TEMP_DECL]]#0 : complex, !fir.ref> + ! CHECK: } else { + ! CHECK: hlfir.assign {{.*}} to %[[TEMP_DECL]]#0 : complex, !fir.ref> + ! CHECK: } +end subroutine + +! CHECK-LABEL: func.func @_QPtest_scalar_logical( +subroutine test_scalar_logical(flag, x, y) + logical :: flag, x, y, result + result = (flag ? x : y) + ! CHECK: %[[TEMP:.*]] = fir.alloca !fir.logical<4> {bindc_name = ".cond.scalar" + ! CHECK: fir.if + ! CHECK: } else { + ! CHECK: } +end subroutine + +! CHECK-LABEL: func.func @_QPtest_multi_branch( +subroutine test_multi_branch(x) + integer :: x, result + ! Multi-branch: x > 10 ? 100 : x > 5 ? 50 : 0 + result = (x > 10 ? 100 : x > 5 ? 50 : 0) + ! Both outer and inner temps are hoisted to function entry. + ! CHECK-DAG: fir.alloca i32 {bindc_name = ".cond.scalar" + ! CHECK-DAG: fir.alloca i32 {bindc_name = ".cond.scalar" + ! Outer temp declaration and first condition: x > 10 + ! CHECK: hlfir.declare {{.*}} {uniq_name = ".cond.result"} + ! CHECK: arith.cmpi sgt + ! CHECK: fir.if {{.*}} { + ! CHECK: hlfir.assign {{.*}} + ! CHECK: } else { + ! Inner temp for the nested conditional: x > 5 ? 50 : 0 + ! CHECK: hlfir.declare {{.*}} {uniq_name = ".cond.result"} + ! CHECK: arith.cmpi sgt + ! CHECK: fir.if {{.*}} { + ! CHECK: hlfir.assign {{.*}} + ! CHECK: } else { + ! CHECK: hlfir.assign {{.*}} + ! CHECK: } + ! CHECK: fir.load + ! CHECK: hlfir.assign {{.*}} + ! CHECK: } +end subroutine + +! CHECK-LABEL: func.func @_QPtest_char_constant_len( +subroutine test_char_constant_len(flag) + logical :: flag + character(len=5) :: str1, str2, result + str1 = "HELLO" + str2 = "WORLD" + result = (flag ? str1 : str2) + ! Constant length: use scalar temp path. + ! CHECK: %[[TEMP:.*]] = fir.alloca !fir.char<1,5> {bindc_name = ".cond.scalar" + ! CHECK: %[[TEMP_DECL:.*]]:2 = hlfir.declare %[[TEMP]] typeparams {{.*}} {uniq_name = ".cond.result"} + ! CHECK: fir.if + ! CHECK: hlfir.assign {{.*}} to %[[TEMP_DECL]]#0 + ! CHECK: } else { + ! CHECK: hlfir.assign {{.*}} to %[[TEMP_DECL]]#0 + ! CHECK: } +end subroutine + +! CHECK-LABEL: func.func @_QPtest_char_deferred_len( +subroutine test_char_deferred_len(flag) + logical :: flag + character(len=:), allocatable :: str1, str2, result + str1 = "SHORT" + str2 = "A MUCH LONGER STRING" + ! Result length comes from selected branch + result = (flag ? str1 : str2) + ! CHECK-DAG: %[[BOX_ALLOC:.*]] = fir.alloca !fir.box>> {bindc_name = ".cond.char" + ! CHECK-DAG: %[[UNALLOC:.*]] = fir.zero_bits !fir.heap> + ! CHECK-DAG: %[[C0:.*]] = arith.constant 0 : index + ! CHECK: %[[BOX:.*]] = fir.embox %[[UNALLOC]] typeparams %[[C0]] + ! CHECK: fir.store %[[BOX]] to %{{.*}} : !fir.ref>>> + ! CHECK: %[[BOX_DECL:.*]]:2 = hlfir.declare %[[BOX_ALLOC]] {uniq_name = ".cond.result"} + ! CHECK: fir.if + ! CHECK: hlfir.assign {{.*}} to %[[BOX_DECL]]#0 realloc temporary_lhs + ! CHECK: } else { + ! CHECK: hlfir.assign {{.*}} to %[[BOX_DECL]]#0 realloc temporary_lhs + ! CHECK: } +end subroutine + +! CHECK-LABEL: func.func @_QPtest_array( +subroutine test_array(flag) + logical :: flag + integer :: arr1(10), arr2(10), result(10) + arr1 = 1 + arr2 = 2 + result = (flag ? arr1 : arr2) + ! CHECK: %[[BOX_ALLOC:.*]] = fir.alloca !fir.box>> {bindc_name = ".cond.array" + ! CHECK: %[[UNALLOC:.*]] = fir.zero_bits !fir.heap> + ! CHECK: %[[SHAPE:.*]] = fir.shape + ! CHECK: %[[BOX:.*]] = fir.embox %[[UNALLOC]](%[[SHAPE]]) + ! CHECK: fir.store %[[BOX]] to %[[BOX_ALLOC]] + ! CHECK: %[[BOX_DECL:.*]]:2 = hlfir.declare %[[BOX_ALLOC]] {uniq_name = ".cond.result"} + ! CHECK: fir.if + ! CHECK: hlfir.assign {{.*}} to %[[BOX_DECL]]#0 realloc temporary_lhs + ! CHECK: } else { + ! CHECK: hlfir.assign {{.*}} to %[[BOX_DECL]]#0 realloc temporary_lhs + ! CHECK: } +end subroutine + +! CHECK-LABEL: func.func @_QPtest_derived_type( +subroutine test_derived_type(flag) + type :: point + real :: x, y + end type + logical :: flag + type(point) :: p1, p2, result + p1 = point(1.0, 2.0) + p2 = point(3.0, 4.0) + result = (flag ? p1 : p2) + ! CHECK: %[[TEMP:.*]] = fir.alloca !fir.type<_QFtest_derived_typeTpoint{x:f32,y:f32}> {bindc_name = ".cond.scalar" + ! CHECK: %[[TEMP_DECL:.*]]:2 = hlfir.declare %[[TEMP]] {uniq_name = ".cond.result"} + ! CHECK: fir.if + ! CHECK: hlfir.assign {{.*}} to %[[TEMP_DECL]]#0 : !fir.ref>, !fir.ref> + ! CHECK: } else { + ! CHECK: hlfir.assign {{.*}} to %[[TEMP_DECL]]#0 : !fir.ref>, !fir.ref> + ! CHECK: } +end subroutine + +! CHECK-LABEL: func.func @_QPtest_nested_conditionals( +subroutine test_nested_conditionals(flag1, flag2, x, y, z) + logical :: flag1, flag2 + integer :: x, y, z, result + ! Nested: flag1 ? (flag2 ? x : y) : z + result = (flag1 ? (flag2 ? x : y) : z) + ! Both outer and inner temps are hoisted to function entry. + ! CHECK-DAG: fir.alloca i32 {bindc_name = ".cond.scalar" + ! CHECK-DAG: fir.alloca i32 {bindc_name = ".cond.scalar" + ! Outer temp declaration and conditional + ! CHECK: hlfir.declare {{.*}} {uniq_name = ".cond.result"} + ! CHECK: fir.if {{%.*}} { + ! Inner temp declaration and conditional + ! CHECK: hlfir.declare {{.*}} {uniq_name = ".cond.result"} + ! CHECK: fir.if {{%.*}} { + ! CHECK: hlfir.assign {{.*}} + ! CHECK: } else { + ! CHECK: hlfir.assign {{.*}} + ! CHECK: } + ! CHECK: hlfir.assign {{.*}} + ! CHECK: } else { + ! CHECK: hlfir.assign {{.*}} + ! CHECK: } +end subroutine + +! CHECK-LABEL: func.func @_QPtest_in_expression( +subroutine test_in_expression(flag, x, y) + logical :: flag + integer :: x, y, z + ! Conditional in larger expression: (flag ? x : y) + 10 + z = (flag ? x : y) + 10 + ! CHECK: %[[TEMP:.*]] = fir.alloca i32 {bindc_name = ".cond.scalar" + ! CHECK: fir.if + ! CHECK: } else { + ! CHECK: } + ! CHECK: %[[COND_RESULT:.*]] = fir.load + ! CHECK: %[[C10:.*]] = arith.constant 10 + ! CHECK: %[[SUM:.*]] = arith.addi %[[COND_RESULT]], %[[C10]] + ! CHECK: hlfir.assign %[[SUM]] +end subroutine + +! CHECK-LABEL: func.func @_QPtest_assumed_length_char( +subroutine test_assumed_length_char(flag, str1, str2) + logical :: flag + character(len=*) :: str1, str2 + character(len=100) :: result + result = (flag ? str1 : str2) + ! Deferred length path since len=* is not constant + ! CHECK: %[[BOX_ALLOC:.*]] = fir.alloca !fir.box>> {bindc_name = ".cond.char" + ! CHECK: fir.if + ! CHECK: hlfir.assign {{.*}} to {{.*}} realloc temporary_lhs + ! CHECK: } else { + ! CHECK: hlfir.assign {{.*}} to {{.*}} realloc temporary_lhs + ! CHECK: } +end subroutine + +! CHECK-LABEL: func.func @_QPtest_different_kinds( +subroutine test_different_kinds(flag) + logical :: flag + integer(kind=4) :: i4_1, i4_2, i4_result + integer(kind=8) :: i8_1, i8_2, i8_result + + ! Both temps allocated at function start + ! CHECK-DAG: %{{.*}} = fir.alloca i64 {bindc_name = ".cond.scalar"} + ! CHECK-DAG: %{{.*}} = fir.alloca i32 {bindc_name = ".cond.scalar"} + + i4_1 = 1 + i4_2 = 2 + i4_result = (flag ? i4_1 : i4_2) + + i8_1 = 3 + i8_2 = 4 + i8_result = (flag ? i8_1 : i8_2) +end subroutine + +! CHECK-LABEL: func.func @_QPtest_array_section( +subroutine test_array_section(flag) + logical :: flag + integer :: arr1(20), arr2(20), result(10) + result = (flag ? arr1(1:10) : arr2(11:20)) + ! CHECK: %[[BOX_ALLOC:.*]] = fir.alloca !fir.box>> {bindc_name = ".cond.array" + ! CHECK: fir.if + ! CHECK: hlfir.assign {{.*}} to {{.*}} realloc temporary_lhs + ! CHECK: } else { + ! CHECK: hlfir.assign {{.*}} to {{.*}} realloc temporary_lhs + ! CHECK: } +end subroutine + +! CHECK-LABEL: func.func @_QPtest_noncontiguous_section( +subroutine test_noncontiguous_section(flag) + logical :: flag + integer :: arr1(20), arr2(20), result(5) + ! Non-contiguous stride-2 sections: result must be contiguous. + result = (flag ? arr1(1:10:2) : arr2(2:10:2)) + ! CHECK: %[[BOX_ALLOC:.*]] = fir.alloca !fir.box>> {bindc_name = ".cond.array" + ! CHECK: fir.if + ! CHECK: hlfir.assign {{.*}} to {{.*}} realloc temporary_lhs + ! CHECK: } else { + ! CHECK: hlfir.assign {{.*}} to {{.*}} realloc temporary_lhs + ! CHECK: } +end subroutine diff --git a/flang/test/Parser/conditional-expr.f90 b/flang/test/Parser/conditional-expr.f90 new file mode 100644 index 0000000000000..f16472f486d42 --- /dev/null +++ b/flang/test/Parser/conditional-expr.f90 @@ -0,0 +1,286 @@ +! RUN: %flang_fc1 -fdebug-unparse-no-sema %s 2>&1 | FileCheck %s +! RUN: %flang_fc1 -fdebug-dump-parse-tree-no-sema %s 2>&1 | FileCheck %s -check-prefix=TREE + +! Test parsing of conditional expressions (Fortran 2023 R1002) + +! Simple two-branch conditional +subroutine simple_conditional(x, y, z) + integer :: x, y, z + ! CHECK-LABEL: simple_conditional + ! CHECK: z = ( x>5 ? y : 10 ) + ! TREE: ConditionalExpr + ! TREE-NEXT: Scalar -> Logical -> Expr + ! TREE: Expr -> Designator -> DataRef -> Name = 'y' + ! TREE: Expr -> LiteralConstant -> IntLiteralConstant = '10' + z = (x > 5 ? y : 10) +end subroutine + +! Three-branch conditional (multiple conditions) +subroutine multi_branch_conditional(x, y, z) + integer :: x, y, z + ! CHECK-LABEL: multi_branch_conditional + ! CHECK: z = ( x>10 ? 100 : ( y<5 ? 50 : 0 ) ) + ! TREE: ConditionalExpr + ! TREE-NEXT: Scalar -> Logical -> Expr + ! TREE: Expr -> LiteralConstant -> IntLiteralConstant = '100' + ! TREE: Expr -> ConditionalExpr + ! TREE: Scalar -> Logical -> Expr + ! TREE: Expr -> LiteralConstant -> IntLiteralConstant = '50' + ! TREE: Expr -> LiteralConstant -> IntLiteralConstant = '0' + z = (x > 10 ? 100 : y < 5 ? 50 : 0) +end subroutine + +! Nested conditionals +subroutine nested_conditionals(x, y, w, z, flag1, flag2) + integer :: x, y, w, z + logical :: flag1, flag2 + ! CHECK-LABEL: nested_conditionals + ! Nested in value position + ! CHECK: z = ( flag1 ? ( x>y ? x : y ) : 0 ) + ! TREE: ConditionalExpr + ! TREE-NEXT: Scalar -> Logical -> Expr + ! TREE: Expr -> ConditionalExpr + ! TREE: Scalar -> Logical -> Expr + ! TREE: Expr -> Designator -> DataRef -> Name = 'x' + ! TREE: Expr -> Designator -> DataRef -> Name = 'y' + ! TREE: Expr -> LiteralConstant -> IntLiteralConstant = '0' + z = (flag1 ? (x > y ? x : y) : 0) + ! Nested in condition + ! CHECK: z = ( ( x>5 ? flag1 : flag2 ) ? y : 10 ) + z = ((x > 5 ? flag1 : flag2) ? y : 10) + ! Multiple nested + ! CHECK: z = ( x>10 ? ( y>20 ? 1 : 2 ) : ( w>30 ? 3 : 4 ) ) + z = (x > 10 ? (y > 20 ? 1 : 2) : (w > 30 ? 3 : 4)) +end subroutine + +! Basic type conditionals +subroutine basic_types(x, a, b, c, flag1, str1) + integer :: x + real :: a, b, c + logical :: flag1 + character(len=10) :: str1 + ! CHECK-LABEL: basic_types + ! Real type + ! CHECK: c = ( a>b ? a : b ) + c = (a > b ? a : b) + ! Logical type + ! CHECK: flag1 = ( x>5 ? .TRUE. : .FALSE. ) + flag1 = (x > 5 ? .true. : .false.) + ! Character type + ! CHECK: str1 = ( flag1 ? "HELLO" : "WORLD" ) + str1 = (flag1 ? "HELLO" : "WORLD") +end subroutine + +! Complex expressions in conditions and branches +subroutine complex_expressions(x, y, z, flag1) + integer :: x, y, z + logical :: flag1 + ! CHECK-LABEL: complex_expressions + ! Complex expressions in branches + ! CHECK: z = ( x>y ? x*2+1 : y*3-2 ) + z = (x > y ? x*2+1 : y*3-2) + ! Complex logical condition + ! CHECK: z = ( x>5.AND.y<10 ? x+y : x-y ) + z = (x > 5 .and. y < 10 ? x+y : x-y) + ! Logical NOT + ! CHECK: z = ( .NOT.flag1 ? x : y ) + z = (.not. flag1 ? x : y) + ! Comparison chains + ! CHECK: z = ( x>5.AND.x<10 ? x : 0 ) + z = (x > 5 .and. x < 10 ? x : 0) + ! Parenthesized expressions in branches + ! CHECK: z = ( x>5 ? (y+z) : (y-z) ) + z = (x > 5 ? (y+z) : (y-z)) +end subroutine + +! Many-branch conditionals +subroutine many_branches(x, z) + integer :: x, z + ! CHECK-LABEL: many_branches + ! Four branches + ! CHECK: z = ( x>10 ? 100 : ( x>5 ? 50 : ( x>0 ? 10 : 0 ) ) ) + z = (x > 10 ? 100 : x > 5 ? 50 : x > 0 ? 10 : 0) + ! Five branches + ! CHECK: z = ( x>20 ? 1 : ( x>15 ? 2 : ( x>10 ? 3 : ( x>5 ? 4 : 5 ) ) ) ) + z = (x > 20 ? 1 : x > 15 ? 2 : x > 10 ? 3 : x > 5 ? 4 : 5) +end subroutine + +! Conditionals with arrays and functions +subroutine arrays_and_functions(x, y, z, arr, flag1) + integer :: x, y, z, arr(5) + logical :: flag1 + ! CHECK-LABEL: arrays_and_functions + ! Array element in conditional + ! CHECK: z = ( arr(1)>arr(2) ? arr(1) : arr(2) ) + z = (arr(1) > arr(2) ? arr(1) : arr(2)) + ! Function calls in conditional + ! CHECK: x = ( abs(y)>10 ? abs(y) : y ) + x = (abs(y) > 10 ? abs(y) : y) + ! Array constructor elements + ! CHECK: arr(1:3) = [( flag1 ? x : y ), ( .NOT.flag1 ? x : y ), ( x>y ? x : y )] + arr(1:3) = [(flag1 ? x : y), (.not. flag1 ? x : y), (x > y ? x : y)] +end subroutine + +! Literals in conditionals +subroutine literals(x, z, a, c) + integer :: x, z + real :: a, c + ! CHECK-LABEL: literals + ! Real literals + ! CHECK: c = ( a>0.0 ? 1.5 : 2.5 ) + c = (a > 0.0 ? 1.5 : 2.5) + ! Negative values + ! CHECK: z = ( x<0 ? -1 : 1 ) + z = (x < 0 ? -1 : 1) +end subroutine + +! Conditional in specification expression context +function spec_expr_conditional(n, flag) result(res) + integer, intent(in) :: n + logical, intent(in) :: flag + integer :: res + ! CHECK-LABEL: spec_expr_conditional + ! CHECK: res = ( flag ? n*2 : n ) + res = (flag ? n*2 : n) +end function + +! Conditional with different integer kinds +subroutine integer_kinds(cond) + integer(kind=4) :: i4a, i4b, i4c + integer(kind=8) :: i8a, i8b, i8c + logical :: cond + ! CHECK-LABEL: integer_kinds + ! CHECK: i4c = ( cond ? i4a : i4b ) + i4c = (cond ? i4a : i4b) + ! CHECK: i8c = ( cond ? i8a : i8b ) + i8c = (cond ? i8a : i8b) +end subroutine + +! Conditional with different real kinds +subroutine real_kinds(cond) + real(kind=4) :: r4a, r4b, r4c + real(kind=8) :: r8a, r8b, r8c + logical :: cond + ! CHECK-LABEL: real_kinds + ! CHECK: r4c = ( cond ? r4a : r4b ) + r4c = (cond ? r4a : r4b) + ! CHECK: r8c = ( cond ? r8a : r8b ) + r8c = (cond ? r8a : r8b) +end subroutine + +! Conditional in various statement contexts +subroutine statement_contexts(flag) + integer :: x, y, arr(10) + logical :: flag + ! CHECK-LABEL: statement_contexts + ! In array constructor + ! CHECK: arr(1:3) = [1, ( flag ? x : y ), 3] + arr(1:3) = [1, (flag ? x : y), 3] + ! In if statement condition + ! CHECK: IF (( flag ? x : y )>5) THEN + if ((flag ? x : y) > 5) then + x = 1 + end if + ! In print statement + ! CHECK: PRINT *, ( flag ? x : y ) + print *, (flag ? x : y) + ! In assignment to array element + ! CHECK: arr(5) = ( flag ? x : y ) + arr(5) = (flag ? x : y) +end subroutine + +! Complex type conditionals +subroutine complex_type(flag) + complex :: c1, c2, c3 + complex(kind=8) :: c8a, c8b, c8c + logical :: flag + ! CHECK-LABEL: complex_type + ! CHECK: c3 = ( flag ? c1 : c2 ) + c3 = (flag ? c1 : c2) + ! CHECK: c8c = ( flag ? c8a : c8b ) + c8c = (flag ? c8a : c8b) + ! With complex literals + ! CHECK: c3 = ( flag ? (1.0,2.0) : (3.0,4.0) ) + c3 = (flag ? (1.0, 2.0) : (3.0, 4.0)) +end subroutine + +! Array-valued conditionals (F2023 10.1.4) +subroutine array_valued(flag) + integer :: arr1(5), arr2(5), arr3(5) + real :: mat1(3,3), mat2(3,3), mat3(3,3) + logical :: flag + ! CHECK-LABEL: array_valued + ! Whole array conditional + ! CHECK: arr3 = ( flag ? arr1 : arr2 ) + ! TREE: ConditionalExpr + ! TREE-NEXT: Scalar -> Logical -> Expr + ! TREE: Expr -> Designator -> DataRef -> Name = 'arr1' + ! TREE: Expr -> Designator -> DataRef -> Name = 'arr2' + arr3 = (flag ? arr1 : arr2) + ! Multidimensional array conditional + ! CHECK: mat3 = ( flag ? mat1 : mat2 ) + mat3 = (flag ? mat1 : mat2) + ! Array section conditional + ! CHECK: arr3(1:3) = ( flag ? arr1(1:3) : arr2(1:3) ) + arr3(1:3) = (flag ? arr1(1:3) : arr2(1:3)) +end subroutine + +! Derived type conditionals +subroutine derived_types(flag) + type :: point + real :: x, y + end type + type(point) :: p1, p2, p3 + logical :: flag + ! CHECK-LABEL: derived_types + ! CHECK: p3 = ( flag ? p1 : p2 ) + p3 = (flag ? p1 : p2) +end subroutine + +! Character with different lengths +subroutine character_lengths(flag) + character(len=5) :: short1, short2 + character(len=10) :: medium1, medium2 + character(len=20) :: long_result + logical :: flag + ! CHECK-LABEL: character_lengths + ! Same length characters + ! CHECK: short1 = ( flag ? "HELLO" : "WORLD" ) + short1 = (flag ? "HELLO" : "WORLD") + ! Different length literals (type conformance rules apply) + ! CHECK: long_result = ( flag ? "SHORT" : "MUCH LONGER STRING" ) + long_result = (flag ? "SHORT" : "MUCH LONGER STRING") + ! Mixed variables and literals + ! CHECK: medium1 = ( flag ? short1 : medium2 ) + medium1 = (flag ? short1 : medium2) +end subroutine + +! Verify that '?' inside string literals and comments does not interfere +! with conditional expression parsing. +subroutine question_mark_chars(flag, str1, str2, str3) + logical :: flag + character(len=20) :: str1, str2, str3 + ! CHECK-LABEL: question_mark_chars + ! CHECK: str1 = "HELLO?" + str1 = "HELLO?" + ! CHECK: str2 = ( flag ? "YES?" : "NO?" ) + str2 = (flag ? "YES?" : "NO?") + ! CHECK: str3 = "WHAT? WHY? HOW?" + str3 = "WHAT? WHY? HOW?" ! ? in a comment + ! CHECK: str2 = ( flag ? "MAYBE?" : "NOPE" ) + str2 = (flag ? "MAYBE?" : "NOPE") ! ? in a trailing comment +end subroutine + +! Verify that '(' and ')' inside character literals are handled correctly by +! ConditionalExprLookahead. +subroutine paren_in_char_literal(c, i) + character(*), intent(in) :: c + integer, intent(out) :: i + ! CHECK-LABEL: paren_in_char_literal + ! CHECK: i = ( c==")" ? 1 : 2 ) + i = (c == ")" ? 1 : 2) + ! CHECK: i = ( c=="(" ? 1 : 2 ) + i = (c == "(" ? 1 : 2) + ! CHECK: i = ( c=="()" ? 1 : 2 ) + i = (c == "()" ? 1 : 2) +end subroutine diff --git a/flang/test/Semantics/conditional-expr.f90 b/flang/test/Semantics/conditional-expr.f90 new file mode 100644 index 0000000000000..12fbea7e86488 --- /dev/null +++ b/flang/test/Semantics/conditional-expr.f90 @@ -0,0 +1,429 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +! Test semantic analysis of conditional expressions (Fortran 2023) + +! Valid cases with basic types +subroutine valid_basic_types(flag) + logical :: flag + integer :: i1, i2, i3 + real :: r1, r2, r3 + complex :: c1, c2, c3 + logical :: l1, l2, l3 + character(len=5) :: ch1, ch2, ch3 + + ! INTEGER conditionals + i3 = (flag ? i1 : i2) + + ! REAL conditionals + r3 = (flag ? r1 : r2) + + ! COMPLEX conditionals + c3 = (flag ? c1 : c2) + + ! LOGICAL conditionals + l3 = (flag ? l1 : l2) + + ! CHARACTER conditionals + ch3 = (flag ? ch1 : ch2) +end subroutine + +! Valid cases with same kind +subroutine valid_same_kind(flag) + logical :: flag + integer(kind=4) :: i4a, i4b, i4c + integer(kind=8) :: i8a, i8b, i8c + real(kind=4) :: r4a, r4b, r4c + real(kind=8) :: r8a, r8b, r8c + + ! Same kind - valid + i4c = (flag ? i4a : i4b) + i8c = (flag ? i8a : i8b) + r4c = (flag ? r4a : r4b) + r8c = (flag ? r8a : r8b) +end subroutine + +! Valid cases with literals +subroutine valid_literals(flag) + logical :: flag + integer :: i + real :: r + character(len=10) :: ch + + i = (flag ? 10 : 20) + r = (flag ? 1.0 : 2.0) + ch = (flag ? "HELLO" : "WORLD") +end subroutine + +! Valid cases with nested conditionals +subroutine valid_nested(flag1, flag2, x, y, z, w) + logical :: flag1, flag2 + integer :: x, y, z, w, result + + ! Nested in value position + result = (flag1 ? (flag2 ? x : y) : z) + + ! Nested in condition (condition is logical) + result = ((x > y ? flag1 : flag2) ? w : z) + + ! Multi-branch + result = (x > 10 ? 100 : x > 5 ? 50 : 0) +end subroutine + +! Valid cases with arrays +subroutine valid_arrays(flag) + logical :: flag + integer :: arr1(10), arr2(10), arr3(10) + real :: mat1(3,3), mat2(3,3), mat3(3,3) + + ! Whole array conditional + arr3 = (flag ? arr1 : arr2) + + ! Multidimensional arrays + mat3 = (flag ? mat1 : mat2) + + ! Array sections + arr3(1:5) = (flag ? arr1(1:5) : arr2(1:5)) +end subroutine + +! Valid cases with derived types +subroutine valid_derived_types(flag) + type :: point + real :: x, y + end type + + logical :: flag + type(point) :: p1, p2, p3 + + p3 = (flag ? p1 : p2) +end subroutine + +! Valid cases with character lengths +subroutine valid_character_lengths(flag) + logical :: flag + character(len=5) :: short1, short2, short3 + character(len=10) :: medium + character(len=20) :: long + + ! Same length + short3 = (flag ? short1 : short2) + + ! Different lengths - padding/truncation applies + medium = (flag ? short1 : medium) + long = (flag ? short1 : "A LONGER STRING") +end subroutine + +! Valid: deferred-length character scalars +subroutine valid_deferred_length_character(flag) + logical :: flag + character(len=:), allocatable :: str1, str2, result + + str1 = "SHORT" + str2 = "A MUCH LONGER STRING" + ! Result length is determined by selected branch + result = (flag ? str1 : str2) +end subroutine + +! Valid: assumed-length character arguments +subroutine valid_assumed_length_character(flag, str1, str2) + logical :: flag + character(len=*) :: str1, str2 + character(len=100) :: result + + result = (flag ? str1 : str2) +end subroutine + +! Error: condition must be logical +subroutine error_non_logical_condition() + integer :: i, x, y + real :: r + character :: ch + + !ERROR: Must have LOGICAL type, but is INTEGER(4) + i = (i ? x : y) + + !ERROR: Must have LOGICAL type, but is REAL(4) + i = (r ? x : y) + + !ERROR: Must have LOGICAL type, but is CHARACTER(KIND=1,LEN=1_8) + i = (ch ? x : y) +end subroutine + +! Error: type mismatch between branches +subroutine error_type_mismatch(flag) + logical :: flag + integer :: i1, i2 + real :: r + character :: ch + complex :: c + + !ERROR: All values in conditional expression must have the same type and kind; have INTEGER(4) and REAL(4) + i1 = (flag ? i2 : r) + + !ERROR: All values in conditional expression must have the same type and kind; have INTEGER(4) and CHARACTER(KIND=1,LEN=1_8) + i1 = (flag ? i2 : ch) + + !ERROR: All values in conditional expression must have the same type and kind; have REAL(4) and COMPLEX(4) + r = (flag ? r : c) + + !ERROR: All values in conditional expression must have the same type and kind; have LOGICAL(4) and INTEGER(4) + flag = (flag ? flag : i1) +end subroutine + +! Error: kind mismatch (F2023 C1004) +subroutine error_kind_mismatch(flag) + logical :: flag + integer(kind=4) :: i4 + integer(kind=8) :: i8 + real(kind=4) :: r4 + real(kind=8) :: r8 + complex(kind=4) :: c4 + complex(kind=8) :: c8 + + !ERROR: All values in conditional expression must have the same type and kind; have INTEGER(4) and INTEGER(8) + i4 = (flag ? i4 : i8) + + !ERROR: All values in conditional expression must have the same type and kind; have REAL(4) and REAL(8) + r4 = (flag ? r4 : r8) + + !ERROR: All values in conditional expression must have the same type and kind; have COMPLEX(4) and COMPLEX(8) + c4 = (flag ? c4 : c8) +end subroutine + +! Error: derived type mismatch +subroutine error_derived_type_mismatch(flag) + type :: type1 + integer :: i + end type + + type :: type2 + integer :: i + end type + + logical :: flag + type(type1) :: t1 + type(type2) :: t2 + + !ERROR: All values in conditional expression must be the same derived type; have type1 and type2 + t1 = (flag ? t1 : t2) +end subroutine + +! Error: derived type vs intrinsic type mismatch +subroutine error_derived_vs_intrinsic(flag) + type :: my_type + integer :: i + end type + + logical :: flag + type(my_type) :: t + integer :: i + real :: r + + !ERROR: All values in conditional expression must have the same type and kind; have my_type and INTEGER(4) + t = (flag ? t : i) + + !ERROR: All values in conditional expression must have the same type and kind; have INTEGER(4) and my_type + t = (flag ? i : t) + + !ERROR: All values in conditional expression must have the same type and kind; have my_type and REAL(4) + t = (flag ? t : r) +end subroutine + +! Error: array rank mismatch +subroutine error_array_rank_mismatch(flag) + logical :: flag + integer :: arr1(10), mat1(3,3), result(10) + + !ERROR: All values in conditional expression must have the same rank; have rank 1 and 2 + result = (flag ? arr1 : mat1) +end subroutine + +! Error: scalar vs array mismatch +subroutine error_scalar_array_mismatch(flag) + logical :: flag + integer :: scalar, arr(10), result(10) + + !ERROR: All values in conditional expression must have the same rank; have rank 0 and 1 + result = (flag ? scalar : arr) +end subroutine + +! Error: condition must be scalar +subroutine error_array_condition() + logical :: flags(5) + integer :: x(5), y(5), result(5) + + !ERROR: Must be a scalar value, but is a rank-1 array + result = (flags ? x : y) +end subroutine + +! Valid cases with intrinsic functions +subroutine valid_intrinsic_functions(x, y, flag) + integer :: x, y + logical :: flag + integer :: result + + result = (flag ? abs(x) : abs(y)) + result = (flag ? max(x, y) : min(x, y)) +end subroutine + +! Valid: conditional in array constructor +subroutine valid_in_array_constructor(flag, x, y) + logical :: flag + integer :: x, y, arr(3) + + arr = [(flag ? x : y), (flag ? x + 1 : y + 1), (flag ? x + 2 : y + 2)] +end subroutine + +! Valid: conditional in expression context +subroutine valid_in_expression(flag, x, y) + logical :: flag + integer :: x, y, z + + z = (flag ? x : y) + 10 + z = 2 * (flag ? x : y) + + if ((flag ? x : y) > 5) then + z = 1 + end if +end subroutine + +! Note: allocatable/pointer differences are handled by assignment semantics +! The conditional expression just requires matching types + +! Valid: both branches allocatable +subroutine valid_both_allocatable(flag) + logical :: flag + integer, allocatable :: alloc1, alloc2, result + + allocate(result) + result = (flag ? alloc1 : alloc2) +end subroutine + +! Valid: both branches pointer +subroutine valid_both_pointer(flag) + logical :: flag + integer, pointer :: ptr1, ptr2, result + + result = (flag ? ptr1 : ptr2) +end subroutine + +! Valid: elemental context +elemental integer function conditional_elemental(flag, x, y) + logical, intent(in) :: flag + integer, intent(in) :: x, y + + conditional_elemental = (flag ? x : y) +end function + +! Valid: pure context +pure integer function conditional_pure(flag, x, y) + logical, intent(in) :: flag + integer, intent(in) :: x, y + + conditional_pure = (flag ? x : y) +end function + +! Valid: recursive context +recursive integer function conditional_recursive(n, flag, x, y) result(res) + integer, intent(in) :: n + logical, intent(in) :: flag + integer, intent(in) :: x, y + + if (n <= 0) then + res = (flag ? x : y) + else + res = conditional_recursive(n - 1, flag, x, y) + end if +end function + +! Valid: nested multi-branch +subroutine valid_multi_branch(x) + integer :: x, result + + ! Five-branch conditional + result = (x > 20 ? 1 : x > 15 ? 2 : x > 10 ? 3 : x > 5 ? 4 : 5) +end subroutine + +! Error: polymorphic types not yet supported +subroutine error_polymorphic(flag) + type :: base_t + integer :: i + end type + + logical :: flag + class(base_t), allocatable :: poly1, poly2, result + + !ERROR: not yet implemented: Conditional expressions with polymorphic types (CLASS) are not yet supported + result = (flag ? poly1 : poly2) +end subroutine + +! Error: mismatched character kinds +subroutine error_character_kind_mismatch(flag) + logical :: flag + character(kind=1, len=5) :: ch1 + character(kind=4, len=5) :: ch4 + + !ERROR: All values in conditional expression must have the same type and kind; have CHARACTER(KIND=1,LEN=5_8) and CHARACTER(KIND=4,LEN=5_8) + ch1 = (flag ? ch1 : ch4) +end subroutine + +! Valid: optional arguments +subroutine valid_optional_args(flag, opt_x, opt_y) + logical :: flag + integer, optional :: opt_x, opt_y + integer :: result + + if (present(opt_x) .and. present(opt_y)) then + result = (flag ? opt_x : opt_y) + end if +end subroutine + +! Valid: mix of expressions and designators +subroutine valid_mixed_expressions(flag, x, y) + logical :: flag + integer :: x, y, result + + result = (flag ? x + y : x - y) + result = (flag ? 2 * x : y / 2) +end subroutine + +! Constant-folding: when the condition is a constant, only the selected +! branch must be a constant expression (F2023 10.1.12). +subroutine constant_folding_cases() + integer :: non_const = 99 + + ! Valid: .true. selects 10; non_const is in the unselected else-branch. + integer, parameter :: p_true_const = (.true. ? 10 : non_const) + + ! Valid: .false. selects 10; non_const is in the unselected then-branch. + integer, parameter :: p_false_const = (.false. ? non_const : 10) + + ! Error: .false. selects non_const — not a constant expression. + !ERROR: Must be a constant value + integer, parameter :: p_false_nconst = (.false. ? 10 : non_const) + + ! Error: .true. selects non_const — not a constant expression. + !ERROR: Must be a constant value + integer, parameter :: p_true_nconst = (.true. ? non_const : 10) +end subroutine + +! Module serialization: conditional expressions in a module must be correctly +! written to and read back from the .mod file. +module conditional_expr_mod + implicit none +contains + subroutine mod_mixed_expressions(flag, x, y, result) + logical, intent(in) :: flag + integer, intent(in) :: x, y + integer, intent(out) :: result + + result = (flag ? x + y : x - y) + result = (flag ? 2 * x : y / 2) + end subroutine +end module + +subroutine valid_use_from_module(flag, x, y) + use conditional_expr_mod + logical :: flag + integer :: x, y, result + + call mod_mixed_expressions(flag, x, y, result) +end subroutine