[flang-commits] [flang] [flang] Add parser support for Fortran 2023 conditional arguments (F2023 R1526-R1528) (PR #195345)
Vineet Kumar via flang-commits
flang-commits at lists.llvm.org
Fri May 1 13:20:12 PDT 2026
https://github.com/vntkmr created https://github.com/llvm/llvm-project/pull/195345
This PR
- Adds semantic analysis for F2023 conditional arguments (F2023 R1526-R1528), enforcing constraints F2023 C1538-C1545.
- Adds shape handling and folding for conditional args.
- Adds semantic tests.
(More details in commit messages)
This PR does not implement lowering to HLFIR; That will be a separate PR.
AI use disclaimer: The changes in this PR were substantially
generated with the assistance of AI (claude opus 4.6 via Github
CoPilot). In accordance with the LLVM project’s AI use policy, I have
reviewed and tested the code to the best of my ability.
>From 55ce6e1e991c362eb0bd5e3741a26786175d25ae Mon Sep 17 00:00:00 2001
From: Vineet Kumar <vineetk at hpe.com>
Date: Thu, 30 Apr 2026 10:15:03 -0500
Subject: [PATCH 1/2] [flang] Implement F2023 conditional argument semantics
(F2023 C1538-C1545)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Add semantic analysis for F2023 conditional arguments (F2023
R1526-R1528),
enforcing constraints F2023 C1538-C1545.
Add recursive ConditionalArg representation to ActualArgument with
VisitTail() dispatch helper
Enforce C1538 (type/kind), C1539 (rank), C1540 (.NIL./optional),
C1541 (INTENT(OUT/INOUT)), C1542 (coarray), C1543 (assumed-rank),
C1545 (corank/allocatable/pointer consistency among consequent-args)
C1544 (consequent-arg expr shall not be a variable) is a grammar
disambiguation rule, automatically satisfied by parsing both
alternatives
as a single Expr production — no semantic check needed.
Reject conditional arguments with implicit interfaces
Extend traverse.h, formatting.cpp, and characteristics.cpp for
ConditionalArg
Add positive and negative semantic test cases
AI use disclaimer: The changes in this commit were substantially
generated
with the assistance of AI (claude opus 4.6 via Github CoPilot). In
accordance
with the LLVM project's AI use policy, I have reviewed and tested the
code to
the best of my ability.
---
flang/include/flang/Evaluate/call.h | 92 +++-
flang/include/flang/Evaluate/traverse.h | 26 +-
flang/lib/Evaluate/call.cpp | 56 ++-
flang/lib/Evaluate/characteristics.cpp | 24 +-
flang/lib/Evaluate/formatting.cpp | 33 ++
flang/lib/Parser/program-parsers.cpp | 8 +
flang/lib/Semantics/check-call.cpp | 131 ++++-
flang/lib/Semantics/expression.cpp | 246 ++++++++-
flang/test/Semantics/conditional-arg.f90 | 610 ++++++++++++++++++++++-
9 files changed, 1169 insertions(+), 57 deletions(-)
diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h
index 93e36f64fe591..1c691130449ae 100644
--- a/flang/include/flang/Evaluate/call.h
+++ b/flang/include/flang/Evaluate/call.h
@@ -73,11 +73,88 @@ class ActualArgument {
SymbolRef symbol_;
};
+ // F2023 R1526 conditional-arg: runtime selection of actual arguments.
+ // Recursive structure mirroring the parser: each ConditionalArg holds
+ // a condition, a consequent, and a tail that is either another
+ // ConditionalArg (continuing the chain) or a terminal Consequent.
+ // std::nullopt represents .NIL. (absent optional argument).
+ class ConditionalArg {
+ public:
+ using Consequent =
+ std::optional<common::CopyableIndirection<Expr<SomeType>>>;
+ using ConditionalArgPartOrConsequent =
+ std::variant<common::CopyableIndirection<ConditionalArg>, Consequent>;
+
+ ConditionalArg(Expr<SomeLogical> &&condition, Consequent &&consequent,
+ ConditionalArgPartOrConsequent &&tail);
+ DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(ConditionalArg)
+
+ const Expr<SomeLogical> &condition() const { return condition_.value(); }
+ const Consequent &consequent() const { return consequent_; }
+ Consequent &consequent() { return consequent_; }
+ const ConditionalArgPartOrConsequent &tail() const { return tail_; }
+
+ // Dispatch on the tail: calls onConditionalArg(const ConditionalArg &)
+ // if the tail continues the chain, or onConsequent(const Consequent &)
+ // if the tail is the terminal consequent.
+ template <typename F, typename G>
+ auto VisitTail(F onConditionalArg, G onConsequent) const {
+ return common::visit(
+ common::visitors{
+ [&](const common::CopyableIndirection<ConditionalArg> &inner) {
+ return onConditionalArg(inner.value());
+ },
+ [&](const Consequent &cons) { return onConsequent(cons); },
+ },
+ tail_);
+ }
+
+ template <typename F, typename G>
+ auto VisitTail(F onConditionalArg, G onConsequent) {
+ return common::visit(
+ common::visitors{
+ [&](common::CopyableIndirection<ConditionalArg> &inner) {
+ return onConditionalArg(inner.value());
+ },
+ [&](Consequent &cons) { return onConsequent(cons); },
+ },
+ tail_);
+ }
+
+ // Apply a callback to every Consequent in the chain (including .NIL.
+ // entries). This encapsulates the recurring "process consequent, then
+ // VisitTail with recursion" pattern.
+ template <typename F> void ForEachConsequent(F f) const {
+ f(consequent_);
+ VisitTail(
+ [&](const ConditionalArg &inner) { inner.ForEachConsequent(f); },
+ [&](const Consequent &cons) { f(cons); });
+ }
+ template <typename F> void ForEachConsequent(F f) {
+ f(consequent_);
+ VisitTail([&](ConditionalArg &inner) { inner.ForEachConsequent(f); },
+ [&](Consequent &cons) { f(cons); });
+ }
+
+ // Returns the first non-.NIL. consequent expression, or nullptr.
+ const Expr<SomeType> *FirstNonNilConsequent() const;
+ bool HasNilConsequent() const;
+
+ bool operator==(const ConditionalArg &) const;
+ llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
+
+ private:
+ common::CopyableIndirection<Expr<SomeLogical>> condition_;
+ Consequent consequent_;
+ ConditionalArgPartOrConsequent tail_;
+ };
+
DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(ActualArgument)
explicit ActualArgument(Expr<SomeType> &&);
explicit ActualArgument(common::CopyableIndirection<Expr<SomeType>> &&);
explicit ActualArgument(AssumedType);
explicit ActualArgument(common::Label);
+ explicit ActualArgument(ConditionalArg &&);
~ActualArgument();
ActualArgument &operator=(Expr<SomeType> &&);
@@ -122,6 +199,19 @@ class ActualArgument {
bool isAlternateReturn() const {
return std::holds_alternative<common::Label>(u_);
}
+ bool isConditionalArg() const {
+ return std::holds_alternative<ConditionalArg>(u_);
+ }
+ const ConditionalArg *GetConditionalArg() const {
+ return std::get_if<ConditionalArg>(&u_);
+ }
+ ConditionalArg *GetConditionalArg() {
+ return std::get_if<ConditionalArg>(&u_);
+ }
+ const Expr<SomeType> *GetConditionalArgExpr() const {
+ const auto *condArg{GetConditionalArg()};
+ return condArg ? condArg->FirstNonNilConsequent() : nullptr;
+ }
bool isPassedObject() const { return attrs_.test(Attr::PassedObject); }
ActualArgument &set_isPassedObject(bool yes = true) {
if (yes) {
@@ -169,7 +259,7 @@ class ActualArgument {
// first as a variable, then as an expression, and the distinction appears
// in the parse tree.
std::variant<common::CopyableIndirection<Expr<SomeType>>, AssumedType,
- common::Label>
+ common::Label, ConditionalArg>
u_;
std::optional<parser::CharBlock> keyword_;
Attrs attrs_;
diff --git a/flang/include/flang/Evaluate/traverse.h b/flang/include/flang/Evaluate/traverse.h
index 44cfaa2a7073d..3c51666486b59 100644
--- a/flang/include/flang/Evaluate/traverse.h
+++ b/flang/include/flang/Evaluate/traverse.h
@@ -178,9 +178,31 @@ class Traverse {
Result operator()(const ActualArgument &x) const {
if (const auto *symbol{x.GetAssumedTypeDummy()}) {
return visitor_(*symbol);
- } else {
- return visitor_(x.UnwrapExpr());
}
+ if (const auto *condArg{x.GetConditionalArg()}) {
+ return TraverseConditionalArg(*condArg);
+ }
+ return visitor_(x.UnwrapExpr());
+ }
+ Result TraverseConditionalArg(
+ const ActualArgument::ConditionalArg &ca) const {
+ Result result{visitor_.Default()};
+ result = visitor_.Combine(std::move(result), visitor_(ca.condition()));
+ if (ca.consequent()) {
+ result = visitor_.Combine(
+ std::move(result), visitor_(ca.consequent()->value()));
+ }
+ return ca.VisitTail(
+ [&](const ActualArgument::ConditionalArg &inner) {
+ return visitor_.Combine(
+ std::move(result), TraverseConditionalArg(inner));
+ },
+ [&](const ActualArgument::ConditionalArg::Consequent &cons) -> Result {
+ if (cons) {
+ return visitor_.Combine(std::move(result), visitor_(cons->value()));
+ }
+ return result;
+ });
}
Result operator()(const ProcedureRef &x) const {
return Combine(x.proc(), x.arguments());
diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp
index f77df92a7597a..03e0199769025 100644
--- a/flang/lib/Evaluate/call.cpp
+++ b/flang/lib/Evaluate/call.cpp
@@ -23,6 +23,12 @@ ActualArgument::ActualArgument(common::CopyableIndirection<Expr<SomeType>> &&v)
: u_{std::move(v)} {}
ActualArgument::ActualArgument(AssumedType x) : u_{x} {}
ActualArgument::ActualArgument(common::Label x) : u_{x} {}
+ActualArgument::ActualArgument(ConditionalArg &&x) : u_{std::move(x)} {}
+
+ActualArgument::ConditionalArg::ConditionalArg(Expr<SomeLogical> &&condition,
+ Consequent &&consequent, ConditionalArgPartOrConsequent &&tail)
+ : condition_{std::move(condition)}, consequent_{std::move(consequent)},
+ tail_{std::move(tail)} {}
ActualArgument::~ActualArgument() {}
ActualArgument::AssumedType::AssumedType(const Symbol &symbol)
@@ -41,19 +47,30 @@ ActualArgument &ActualArgument::operator=(Expr<SomeType> &&expr) {
std::optional<DynamicType> ActualArgument::GetType() const {
if (const Expr<SomeType> *expr{UnwrapExpr()}) {
return expr->GetType();
- } else if (std::holds_alternative<AssumedType>(u_)) {
+ }
+ if (std::holds_alternative<AssumedType>(u_)) {
return DynamicType::AssumedType();
- } else {
- return std::nullopt;
}
+ if (const auto *condArg{std::get_if<ConditionalArg>(&u_)}) {
+ if (const auto *expr{condArg->FirstNonNilConsequent()}) {
+ return expr->GetType();
+ }
+ }
+ return std::nullopt;
}
int ActualArgument::Rank() const {
if (const Expr<SomeType> *expr{UnwrapExpr()}) {
return expr->Rank();
- } else {
- return std::get<AssumedType>(u_).Rank();
}
+ if (const auto *condArg{std::get_if<ConditionalArg>(&u_)}) {
+ if (const auto *expr{condArg->FirstNonNilConsequent()}) {
+ return expr->Rank();
+ }
+ // all-.NIL. error caught earlier by F2023 C1540 check
+ DIE("all-.NIL. conditional arg should have been rejected");
+ }
+ return std::get<AssumedType>(u_).Rank();
}
bool ActualArgument::operator==(const ActualArgument &that) const {
@@ -64,6 +81,35 @@ void ActualArgument::Parenthesize() {
u_ = evaluate::Parenthesize(std::move(DEREF(UnwrapExpr())));
}
+bool ActualArgument::ConditionalArg::operator==(
+ const ConditionalArg &that) const {
+ return condition_ == that.condition_ && consequent_ == that.consequent_ &&
+ tail_ == that.tail_;
+}
+
+const Expr<SomeType> *
+ActualArgument::ConditionalArg::FirstNonNilConsequent() const {
+ if (consequent_) {
+ return &consequent_->value();
+ }
+ return VisitTail(
+ [](const ConditionalArg &inner) -> const Expr<SomeType> * {
+ return inner.FirstNonNilConsequent();
+ },
+ [](const Consequent &cons) -> const Expr<SomeType> * {
+ return cons ? &cons->value() : nullptr;
+ });
+}
+
+bool ActualArgument::ConditionalArg::HasNilConsequent() const {
+ if (!consequent_) {
+ return true;
+ }
+ return VisitTail(
+ [](const ConditionalArg &inner) { return inner.HasNilConsequent(); },
+ [](const Consequent &cons) { return !cons.has_value(); });
+}
+
SpecificIntrinsic::SpecificIntrinsic(
IntrinsicProcedure n, characteristics::Procedure &&chars)
: name{n}, characteristics{
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 50f5f91fe60d6..23b3f54dcb1f4 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -165,11 +165,14 @@ std::optional<TypeAndShape> TypeAndShape::Characterize(
const ActualArgument &arg, FoldingContext &context, bool invariantOnly) {
if (const auto *expr{arg.UnwrapExpr()}) {
return Characterize(*expr, context, invariantOnly);
- } else if (const Symbol * assumed{arg.GetAssumedTypeDummy()}) {
+ }
+ if (const Symbol *assumed{arg.GetAssumedTypeDummy()}) {
return Characterize(*assumed, context, invariantOnly);
- } else {
- return std::nullopt;
}
+ if (const auto *expr{arg.GetConditionalArgExpr()}) {
+ return Characterize(*expr, context, invariantOnly);
+ }
+ return std::nullopt;
}
bool TypeAndShape::IsCompatibleWith(parser::ContextualMessages &messages,
@@ -958,11 +961,20 @@ std::optional<DummyArgument> DummyArgument::FromActual(std::string &&name,
bool forImplicitInterface) {
if (const auto *expr{arg.UnwrapExpr()}) {
return FromActual(std::move(name), *expr, context, forImplicitInterface);
- } else if (arg.GetAssumedTypeDummy()) {
+ }
+ if (arg.GetAssumedTypeDummy()) {
return std::nullopt;
- } else {
- return DummyArgument{AlternateReturn{}};
}
+ if (const auto *expr{arg.GetConditionalArgExpr()}) {
+ return FromActual(std::move(name), *expr, context, forImplicitInterface);
+ }
+ // Guard: GetArgExpr() returns the first non-NIL consequent for a
+ // ConditionalArg, so normal conditional args are handled above. An
+ // all-.NIL. ConditionalArg would reach here (GetArgExpr() returns nullptr),
+ // but that case is rejected earlier by the F2023 C1540 check. Only a true
+ // alternate-return label should reach this point.
+ CHECK(arg.isAlternateReturn());
+ return DummyArgument{AlternateReturn{}};
}
bool DummyArgument::IsOptional() const {
diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp
index 09cb8b08dda81..2aaed58128cd9 100644
--- a/flang/lib/Evaluate/formatting.cpp
+++ b/flang/lib/Evaluate/formatting.cpp
@@ -244,6 +244,7 @@ llvm::raw_ostream &ActualArgument::AsFortran(llvm::raw_ostream &o) const {
},
[&](const AssumedType &assumedType) { assumedType.AsFortran(o); },
[&](const common::Label &label) { o << '*' << label; },
+ [&](const ConditionalArg &condArg) { condArg.AsFortran(o); },
},
u_);
if (isPercentVal() || isPercentRef()) {
@@ -259,6 +260,38 @@ std::string ActualArgument::AsFortran() const {
return result;
}
+// Helper: emit the inner part of a conditional arg without outer parens
+static void EmitConditionalArgInner(
+ llvm::raw_ostream &o, const ActualArgument::ConditionalArg &ca) {
+ auto emitConsequent{
+ [&](const ActualArgument::ConditionalArg::Consequent &cons) {
+ if (cons) {
+ cons->value().AsFortran(o);
+ } else {
+ o << ".NIL.";
+ }
+ }};
+ ca.condition().AsFortran(o);
+ o << " ? ";
+ emitConsequent(ca.consequent());
+ o << " : ";
+ ca.VisitTail(
+ [&](const ActualArgument::ConditionalArg &inner) {
+ EmitConditionalArgInner(o, inner);
+ },
+ [&](const ActualArgument::ConditionalArg::Consequent &cons) {
+ emitConsequent(cons);
+ });
+}
+
+llvm::raw_ostream &ActualArgument::ConditionalArg::AsFortran(
+ llvm::raw_ostream &o) const {
+ o << "( ";
+ EmitConditionalArgInner(o, *this);
+ o << " )";
+ return o;
+}
+
llvm::raw_ostream &SpecificIntrinsic::AsFortran(llvm::raw_ostream &o) const {
return o << name;
}
diff --git a/flang/lib/Parser/program-parsers.cpp b/flang/lib/Parser/program-parsers.cpp
index b4e56213d9f02..516b8c1680544 100644
--- a/flang/lib/Parser/program-parsers.cpp
+++ b/flang/lib/Parser/program-parsers.cpp
@@ -514,6 +514,14 @@ TYPE_PARSER(construct<ActualArgSpec>(
// F2023 R1528 consequent-arg -> expr | variable
// N.B. "variable" is subsumed by "expr" in the parser;
// semantics determines the distinction.
+// C1544: "A consequent-arg that is an expr shall not be a variable."
+// This is a grammar disambiguation rule making the two alternatives of
+// R1528 mutually exclusive. It is automatically satisfied here because
+// "variable" is subsumed by "expr" in the parser — there is only one
+// production, so no consequent-arg can accidentally match the wrong
+// alternative. Semantics uses IsVariable() to distinguish the two
+// cases when it matters (e.g. C1541 requires variables for INTENT(OUT/
+// INOUT) dummies).
constexpr auto consequent{construct<ConditionalArg::Consequent>(
".NIL." >> construct<ConditionalArgNil>()) ||
construct<ConditionalArg::Consequent>(indirect(expr))};
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 2dd47508a0b3f..325c281c879fd 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -36,6 +36,11 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
"Keyword '%s=' may not appear in a reference to a procedure with an implicit interface"_err_en_US,
*kw);
}
+ if (arg.isConditionalArg()) {
+ messages.Say(
+ "Conditional argument requires an explicit interface"_err_en_US);
+ return;
+ }
auto type{arg.GetType()};
if (type) {
if (type->IsAssumedType()) {
@@ -1388,6 +1393,88 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
}
}
+// F2023 C1540-C1543, C1545: Check conditional argument against dummy data
+// object
+static void CheckConditionalArg(
+ const evaluate::ActualArgument::ConditionalArg &condArg,
+ const characteristics::DummyDataObject &object,
+ const std::string &dummyName, parser::ContextualMessages &messages) {
+ // C1540: .NIL. shall not appear if dummy is not optional
+ if (condArg.HasNilConsequent() &&
+ !object.attrs.test(characteristics::DummyDataObject::Attr::Optional)) {
+ messages.Say(
+ ".NIL. in conditional argument associated with non-optional %s"_err_en_US,
+ dummyName);
+ }
+ // Check a single consequent for C1541, C1543, C1542
+ auto checkOneConsequent{[&](const evaluate::ActualArgument::ConditionalArg::
+ Consequent &cons) {
+ if (!cons) {
+ return;
+ }
+ const auto &consExpr{cons->value()};
+ // C1541: INTENT(OUT/INOUT) requires variable
+ if ((object.intent == common::Intent::Out ||
+ object.intent == common::Intent::InOut) &&
+ !evaluate::IsVariable(consExpr)) {
+ messages.Say(
+ "Each consequent-arg in conditional argument associated with INTENT(%s) %s must be a variable"_err_en_US,
+ object.intent == common::Intent::Out ? "OUT" : "IN OUT", dummyName);
+ }
+ // C1543: assumed-rank consequent-arg requires assumed-rank dummy
+ if (semantics::IsAssumedRank(consExpr) &&
+ !object.type.attrs().test(
+ characteristics::TypeAndShape::Attr::AssumedRank)) {
+ messages.Say(
+ "Assumed-rank consequent-arg in conditional argument may only be associated with assumed-rank %s"_err_en_US,
+ dummyName);
+ }
+ // C1542: coarray attribute
+ if (object.type.corank() > 0 && !evaluate::IsCoarray(consExpr)) {
+ messages.Say(
+ "Each consequent-arg in conditional argument associated with a coarray %s must be a coarray"_err_en_US,
+ dummyName);
+ }
+ }};
+ condArg.ForEachConsequent(checkOneConsequent);
+ // C1545: each consequent-arg shall have the same corank, and if any
+ // has the ALLOCATABLE or POINTER attribute, each shall have it.
+ // (Strictly applies only to generic procedure references, but enforced
+ // unconditionally for consistency.)
+ std::optional<int> firstCorank;
+ std::optional<bool> firstIsAllocatable;
+ std::optional<bool> firstIsPointer;
+ auto checkConsistency{[&](const evaluate::ActualArgument::ConditionalArg::
+ Consequent &cons) {
+ if (!cons) {
+ return;
+ }
+ auto &consExpr{cons->value()};
+ int corank{evaluate::GetCorank(consExpr)};
+ bool isAlloc{evaluate::IsAllocatableDesignator(consExpr)};
+ bool isPtr{evaluate::IsObjectPointer(consExpr)};
+ if (!firstCorank) {
+ firstCorank = corank;
+ firstIsAllocatable = isAlloc;
+ firstIsPointer = isPtr;
+ } else {
+ if (corank != *firstCorank) {
+ messages.Say(
+ "All consequent-args in a conditional argument must have the same corank"_err_en_US);
+ }
+ if (isAlloc != *firstIsAllocatable) {
+ messages.Say(
+ "If any consequent-arg in a conditional argument has the ALLOCATABLE attribute, each must have it"_err_en_US);
+ }
+ if (isPtr != *firstIsPointer) {
+ messages.Say(
+ "If any consequent-arg in a conditional argument has the POINTER attribute, each must have it"_err_en_US);
+ }
+ }
+ }};
+ condArg.ForEachConsequent(checkConsistency);
+}
+
// Allow BOZ literal actual arguments when they can be converted to a known
// dummy argument type
static void ConvertBOZLiteralArg(
@@ -1421,34 +1508,34 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
"Alternate return label '%d' cannot be associated with %s"_err_en_US,
arg.GetLabel(), dummyName);
return false;
- } else {
- return true;
}
+ return true;
};
common::visit(
common::visitors{
[&](const characteristics::DummyDataObject &object) {
if (CheckActualArgForLabel(arg)) {
ConvertBOZLiteralArg(arg, object.type.type());
- if (auto *expr{arg.UnwrapExpr()}) {
+ // Check a single actual expression against the dummy object.
+ auto checkOneExpr{[&](evaluate::Expr<evaluate::SomeType> &expr) {
if (auto type{characteristics::TypeAndShape::Characterize(
- *expr, foldingContext)}) {
+ expr, foldingContext)}) {
arg.set_dummyIntent(object.intent);
bool isElemental{
object.type.Rank() == 0 && proc.IsElemental()};
- CheckExplicitDataArg(object, dummyName, *expr, *type,
+ CheckExplicitDataArg(object, dummyName, expr, *type,
isElemental, context, foldingContext, scope, intrinsic,
allowActualArgumentConversions, extentErrors, proc, arg,
dummy);
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
- IsBOZLiteral(*expr)) {
+ IsBOZLiteral(expr)) {
// ok
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
- evaluate::IsNullObjectPointer(expr)) {
+ evaluate::IsNullObjectPointer(&expr)) {
// ok, ASSOCIATED(NULL(without MOLD=))
} else if (object.type.attrs().test(characteristics::
TypeAndShape::Attr::AssumedRank) &&
- evaluate::IsNullObjectPointer(expr) &&
+ evaluate::IsNullObjectPointer(&expr) &&
(object.attrs.test(
characteristics::DummyDataObject::Attr::Allocatable) ||
object.attrs.test(
@@ -1461,7 +1548,7 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
Attr::Pointer) ||
object.attrs.test(characteristics::
DummyDataObject::Attr::Optional)) &&
- evaluate::IsNullObjectPointer(expr)) {
+ evaluate::IsNullObjectPointer(&expr)) {
// FOO(NULL(without MOLD=))
if (object.type.type().IsAssumedLengthCharacter()) {
messages.Say(
@@ -1480,30 +1567,44 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
}
} else if (object.attrs.test(characteristics::DummyDataObject::
Attr::Allocatable) &&
- (evaluate::IsNullAllocatable(expr) ||
- evaluate::IsBareNullPointer(expr))) {
+ (evaluate::IsNullAllocatable(&expr) ||
+ evaluate::IsBareNullPointer(&expr))) {
if (object.intent == common::Intent::Out ||
object.intent == common::Intent::InOut) {
messages.Say(
"NULL() actual argument '%s' may not be associated with allocatable dummy argument %s that is INTENT(OUT) or INTENT(IN OUT)"_err_en_US,
- expr->AsFortran(), dummyName);
+ expr.AsFortran(), dummyName);
} else if (object.intent == common::Intent::Default) {
foldingContext.Warn(
common::UsageWarning::
NullActualForDefaultIntentAllocatable,
"NULL() actual argument '%s' should not be associated with allocatable dummy argument %s without INTENT(IN)"_warn_en_US,
- expr->AsFortran(), dummyName);
+ expr.AsFortran(), dummyName);
} else {
foldingContext.Warn(
common::LanguageFeature::NullActualForAllocatable,
"Allocatable %s is associated with %s"_port_en_US,
- dummyName, expr->AsFortran());
+ dummyName, expr.AsFortran());
}
} else {
messages.Say(
"Actual argument '%s' associated with %s is not a variable or typed expression"_err_en_US,
- expr->AsFortran(), dummyName);
+ expr.AsFortran(), dummyName);
}
+ }};
+ if (auto *condArg{arg.GetConditionalArg()}) {
+ CheckConditionalArg(*condArg, object, dummyName, messages);
+ // Also run standard explicit-interface checks on each
+ // non-.NIL. consequent expression (recursive).
+ condArg->ForEachConsequent(
+ [&](evaluate::ActualArgument::ConditionalArg::Consequent
+ &cons) {
+ if (cons) {
+ checkOneExpr(cons->value());
+ }
+ });
+ } else if (auto *expr{arg.UnwrapExpr()}) {
+ checkOneExpr(*expr);
} else {
const Symbol &assumed{DEREF(arg.GetAssumedTypeDummy())};
if (!object.type.type().IsAssumedType()) {
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index ab0bb5a921be0..f8075b7d65ac3 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -162,6 +162,8 @@ class ArgumentAnalyzer {
bool CheckConformance();
bool CheckAssignmentConformance();
+ bool CheckConsequentTypesAndRanks(
+ const ActualArgument::ConditionalArg &condArg);
bool CheckForNullPointer(const char *where = "as an operand here");
bool CheckForAssumedRank(const char *where = "as an operand here");
@@ -4773,9 +4775,121 @@ void ArgumentAnalyzer::Analyze(
actual->set_isPercentVal();
}
},
- [&](const parser::ConditionalArg &) {
- context_.Say(
- "Fortran 2023 conditional arguments are not yet supported"_todo_en_US);
+ [&](const parser::ConditionalArg &condArg) {
+ // F2023 R1526 conditional-arg analysis (recursive)
+ using EvalConsequent = ActualArgument::ConditionalArg::Consequent;
+ using EvalConditionalArg = ActualArgument::ConditionalArg;
+ using EvalTail =
+ ActualArgument::ConditionalArg::ConditionalArgPartOrConsequent;
+
+ // Analyze a single parser::Consequent into an evaluate Consequent
+ auto analyzeConsequent{[&](const parser::ConditionalArg::Consequent
+ &consequent) -> EvalConsequent {
+ EvalConsequent result;
+ common::visit(
+ common::visitors{
+ [&](const common::Indirection<parser::Expr> &expr) {
+ if (MaybeExpr valExpr{context_.Analyze(expr.value())}) {
+ if (!valExpr->GetType()) {
+ context_.Say(
+ "Typeless expression is not allowed as a consequent in a conditional argument"_err_en_US);
+ fatalErrors_ = true;
+ } else {
+ result =
+ common::CopyableIndirection<Expr<SomeType>>{
+ std::move(*valExpr)};
+ }
+ } else {
+ fatalErrors_ = true;
+ }
+ },
+ [&](const parser::ConditionalArgNil &) {
+ // .NIL. -> std::nullopt (the default)
+ },
+ },
+ consequent.u);
+ return result;
+ }};
+
+ // Recursively analyze a parser::ConditionalArg into an evaluate
+ // ConditionalArg
+ auto analyzeCondArg{[&](const parser::ConditionalArg &ca,
+ auto &self)
+ -> std::optional<EvalConditionalArg> {
+ // Analyze the condition
+ const auto &condition{std::get<parser::ScalarLogicalExpr>(ca.t)};
+ MaybeExpr condExpr{
+ context_.Analyze(condition.thing.thing.value())};
+ if (!condExpr) {
+ fatalErrors_ = true;
+ return std::nullopt;
+ }
+ auto *logicalExpr{std::get_if<Expr<SomeLogical>>(&condExpr->u)};
+ if (!logicalExpr) {
+ context_.Say(
+ "Condition in conditional argument must be logical"_err_en_US);
+ fatalErrors_ = true;
+ return std::nullopt;
+ }
+
+ // Analyze the consequent
+ EvalConsequent consequent{analyzeConsequent(
+ std::get<parser::ConditionalArg::Consequent>(ca.t))};
+ if (fatalErrors_) {
+ return std::nullopt;
+ }
+
+ // Analyze the tail (recursive)
+ const auto &tailNode{
+ std::get<common::Indirection<parser::ConditionalArgTail>>(
+ ca.t)
+ .value()};
+ EvalTail tail{EvalConsequent{}}; // default: terminal NIL
+ common::visit(
+ common::visitors{
+ [&](const parser::ConditionalArg &innerCA) {
+ auto innerResult{self(innerCA, self)};
+ if (innerResult) {
+ tail =
+ common::CopyableIndirection<EvalConditionalArg>{
+ std::move(*innerResult)};
+ } else {
+ fatalErrors_ = true;
+ }
+ },
+ [&](const parser::ConditionalArg::Consequent &cons) {
+ tail = analyzeConsequent(cons);
+ },
+ },
+ tailNode.u);
+ if (fatalErrors_) {
+ return std::nullopt;
+ }
+
+ return EvalConditionalArg{std::move(*logicalExpr),
+ std::move(consequent), std::move(tail)};
+ }};
+
+ auto result{analyzeCondArg(condArg, analyzeCondArg)};
+ if (!result) {
+ return;
+ }
+
+ // C1540: At least one consequent shall be a consequent-arg
+ if (!result->FirstNonNilConsequent()) {
+ context_.Say(
+ "At least one consequent in a conditional argument must not be .NIL."_err_en_US);
+ fatalErrors_ = true;
+ return;
+ }
+
+ // C1538: same type and kind; C1539: same rank or assumed-rank
+ if (!CheckConsequentTypesAndRanks(*result)) {
+ fatalErrors_ = true;
+ return;
+ }
+
+ actual = ActualArgument{std::move(*result)};
},
},
std::get<parser::ActualArg>(arg.t).u);
@@ -4789,6 +4903,126 @@ void ArgumentAnalyzer::Analyze(
}
}
+// C1538: Each consequent-arg shall have the same declared type and kind
+// C1539: Each consequent-arg shall have the same rank or be assumed-rank
+bool ArgumentAnalyzer::CheckConsequentTypesAndRanks(
+ const ActualArgument::ConditionalArg &condArg) {
+ const Expr<SomeType> *refExpr{condArg.FirstNonNilConsequent()};
+ if (!refExpr) {
+ return true; // all .NIL.; caller checks separately
+ }
+ auto refType{refExpr->GetType()};
+ if (!refType) {
+ return true; // typeless; should have been caught earlier
+ }
+ int refRank{-1};
+ bool allSameRank{true};
+ bool hasAssumedRank{false};
+ bool hasNonAssumedRank{false};
+
+ // Check a single consequent against the reference type and rank
+ auto checkOne{[&](const ActualArgument::ConditionalArg::Consequent &cons)
+ -> bool {
+ if (!cons) {
+ return true; // .NIL. is ok
+ }
+ auto thisType{cons->value().GetType()};
+ if (thisType) {
+ if (refType->category() != thisType->category() ||
+ (refType->category() != TypeCategory::Derived &&
+ refType->kind() != thisType->kind())) {
+ context_.Say(
+ "All consequent-args in a conditional argument must have the same type and kind; have %s and %s"_err_en_US,
+ refType->AsFortran(), thisType->AsFortran());
+ return false;
+ }
+ if (refType->category() == TypeCategory::Derived) {
+ // C1538: same declared type required. Unlimited polymorphic
+ // (CLASS(*)) and assumed type (TYPE(*)) have no declared type,
+ // so mixing them with other types is invalid.
+ if (refType->IsUnlimitedPolymorphic() !=
+ thisType->IsUnlimitedPolymorphic()) {
+ context_.Say(
+ "All consequent-args in a conditional argument must have the same type and kind; have %s and %s"_err_en_US,
+ refType->AsFortran(), thisType->AsFortran());
+ return false;
+ }
+ if (refType->IsAssumedType() != thisType->IsAssumedType()) {
+ context_.Say(
+ "All consequent-args in a conditional argument must have the same type and kind; have %s and %s"_err_en_US,
+ refType->AsFortran(), thisType->AsFortran());
+ return false;
+ }
+ if (!refType->IsUnlimitedPolymorphic() && !refType->IsAssumedType()) {
+ const auto &resSpec{refType->GetDerivedTypeSpec()};
+ const auto &thisSpec{thisType->GetDerivedTypeSpec()};
+ if (&resSpec.typeSymbol() != &thisSpec.typeSymbol()) {
+ context_.Say(
+ "All consequent-args in a conditional argument must be the same derived type; have %s and %s"_err_en_US,
+ refType->AsFortran(), thisType->AsFortran());
+ return false;
+ }
+ for (const auto &[pName, pValue] : resSpec.parameters()) {
+ if (pValue.isKind()) {
+ auto it{thisSpec.parameters().find(pName)};
+ if (it == thisSpec.parameters().end() || pValue != it->second) {
+ context_.Say(
+ "All consequent-args in a conditional argument must have the same kind type parameters; have %s and %s"_err_en_US,
+ refType->AsFortran(), thisType->AsFortran());
+ return false;
+ }
+ }
+ }
+ }
+ }
+ }
+ if (semantics::IsAssumedRank(cons->value())) {
+ hasAssumedRank = true;
+ } else {
+ hasNonAssumedRank = true;
+ int thisRank{cons->value().Rank()};
+ if (refRank < 0) {
+ refRank = thisRank;
+ } else if (thisRank != refRank) {
+ allSameRank = false;
+ }
+ }
+ return true;
+ }};
+
+ // Recursively check all consequents in the tree
+ auto checkAll{
+ [&](const ActualArgument::ConditionalArg &ca, auto &self) -> bool {
+ if (!checkOne(ca.consequent())) {
+ return false;
+ }
+ return ca.VisitTail(
+ [&](const ActualArgument::ConditionalArg &inner) {
+ return self(inner, self);
+ },
+ [&](const ActualArgument::ConditionalArg::Consequent &cons) {
+ return checkOne(cons);
+ });
+ }};
+
+ if (!checkAll(condArg, checkAll)) {
+ return false;
+ }
+
+ // C1539: final rank consistency check
+ if (hasAssumedRank && hasNonAssumedRank) {
+ context_.Say(
+ "All consequent-args in a conditional argument must have the same rank or all must be assumed-rank"_err_en_US);
+ return false;
+ }
+ if (hasNonAssumedRank && !allSameRank) {
+ context_.Say(
+ "All consequent-args in a conditional argument must have the same rank"_err_en_US);
+ return false;
+ }
+ return true;
+}
+
bool ArgumentAnalyzer::IsIntrinsicRelational(RelationalOperator opr,
const DynamicType &leftType, const DynamicType &rightType) const {
CHECK(actuals_.size() == 2);
@@ -5282,12 +5516,6 @@ std::optional<ActualArgument> 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<parser::ConditionalExpr>(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/test/Semantics/conditional-arg.f90 b/flang/test/Semantics/conditional-arg.f90
index 552e74a3d58e4..57cd9a797b1dc 100644
--- a/flang/test/Semantics/conditional-arg.f90
+++ b/flang/test/Semantics/conditional-arg.f90
@@ -1,29 +1,601 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
-! Test semantic analysis of conditional arguments (F2023 R1526-R1528)
+! Test semantic analysis of conditional arguments (F2023:R1526-R1528)
+! Constraints F2023:C1538-C1545
-subroutine test_conditional_arg
+module m_conditional_arg
implicit none
- integer :: a, b, c
- logical :: flag, flag2
- ! Simple conditional arg
- !ERROR: not yet implemented: Fortran 2023 conditional arguments are not yet supported
- call sub((flag ? a : b))
+ interface
+ subroutine sub_int(x)
+ integer, intent(in) :: x
+ end subroutine
+ subroutine sub_real(x)
+ real, intent(in) :: x
+ end subroutine
+ subroutine sub_int_out(x)
+ integer, intent(out) :: x
+ end subroutine
+ subroutine sub_int_inout(x)
+ integer, intent(inout) :: x
+ end subroutine
+ subroutine sub_optional(x)
+ integer, intent(in), optional :: x
+ end subroutine
+ subroutine sub_not_optional(x)
+ integer, intent(in) :: x
+ end subroutine
+ subroutine sub_alloc(x)
+ integer, intent(inout), allocatable :: x
+ end subroutine
+ subroutine sub_pointer(x)
+ integer, intent(inout), pointer :: x
+ end subroutine
+ subroutine sub_array(x)
+ integer, intent(in) :: x(:)
+ end subroutine
+ subroutine sub_assumed_rank(x)
+ integer, intent(in) :: x(..)
+ end subroutine
+ subroutine sub_coarray(x)
+ integer, intent(inout) :: x[*]
+ end subroutine
+ subroutine sub_two(x, y)
+ integer, intent(in) :: x, y
+ end subroutine
+ end interface
- ! Multi-branch conditional arg
- !ERROR: not yet implemented: Fortran 2023 conditional arguments are not yet supported
- call sub((flag ? a : flag2 ? b : c))
+contains
- ! .NIL. in else position
- !ERROR: not yet implemented: Fortran 2023 conditional arguments are not yet supported
- call sub((flag ? a : .NIL.))
+ ! =========================================================================
+ ! Positive tests: valid conditional arguments
+ ! =========================================================================
- ! Keyword argument with conditional arg
- !ERROR: not yet implemented: Fortran 2023 conditional arguments are not yet supported
- call sub(arg = (flag ? a : b))
+ subroutine test_valid_simple
+ integer :: a, b
+ logical :: flag
+ ! Simple two-branch conditional arg with explicit interface
+ call sub_int((flag ? a : b))
+ end subroutine
- ! .NIL. in both branches
- !ERROR: not yet implemented: Fortran 2023 conditional arguments are not yet supported
- call sub((flag ? .NIL. : .NIL.))
+ subroutine test_valid_multi_branch
+ integer :: a, b, c
+ logical :: flag, flag2
+ ! Multi-branch conditional arg
+ call sub_int((flag ? a : flag2 ? b : c))
+ end subroutine
+ subroutine test_valid_nil_optional
+ integer :: a
+ logical :: flag
+ ! .NIL. is allowed with optional dummy
+ call sub_optional((flag ? a : .NIL.))
+ end subroutine
+
+ subroutine test_valid_nil_middle
+ integer :: a, b
+ logical :: flag, flag2
+ ! .NIL. in middle branch with optional dummy
+ call sub_optional((flag ? .NIL. : flag2 ? a : b))
+ end subroutine
+
+ subroutine test_valid_expressions
+ integer :: a, b
+ logical :: flag
+ ! Expression consequent-args with INTENT(IN)
+ call sub_int((flag ? a + 1 : b * 2))
+ end subroutine
+
+ subroutine test_valid_intent_out
+ integer :: a, b
+ logical :: flag
+ ! Variable consequent-args with INTENT(OUT)
+ call sub_int_out((flag ? a : b))
+ end subroutine
+
+ subroutine test_valid_intent_inout
+ integer :: a, b
+ logical :: flag
+ ! Variable consequent-args with INTENT(INOUT)
+ call sub_int_inout((flag ? a : b))
+ end subroutine
+
+ subroutine test_valid_two_args
+ integer :: a, b, c, d
+ logical :: flag, flag2
+ ! Multiple arguments, one conditional
+ call sub_two(a, (flag ? b : c))
+ end subroutine
+
+ ! =========================================================================
+ ! F2023:R1526: The condition in a conditional argument must be a
+ ! scalar-logical-expr.
+ ! =========================================================================
+
+ subroutine test_nonlogical_condition
+ integer :: a, b, icond
+ real :: rcond
+ character :: ccond
+ logical :: flag
+ !ERROR: Condition in conditional argument must be logical
+ call sub_int((icond ? a : b))
+ !ERROR: Condition in conditional argument must be logical
+ call sub_int((rcond ? a : b))
+ !ERROR: Condition in conditional argument must be logical
+ call sub_int((ccond ? a : b))
+ ! Valid: logical condition
+ call sub_int((flag ? a : b))
+ end subroutine
+
+ ! =========================================================================
+ ! F2023:C1538: Each consequent-arg shall have the same declared type and
+ ! kind type parameters.
+ ! =========================================================================
+
+ subroutine test_f2023_c1538_different_type
+ integer :: a
+ real :: r
+ logical :: flag
+ !ERROR: All consequent-args in a conditional argument must have the same type and kind; have INTEGER(4) and REAL(4)
+ call sub_int((flag ? a : r))
+ end subroutine
+
+ subroutine test_f2023_c1538_different_kind
+ integer(4) :: a
+ integer(8) :: b
+ logical :: flag
+ !ERROR: All consequent-args in a conditional argument must have the same type and kind; have INTEGER(4) and INTEGER(8)
+ call sub_int((flag ? a : b))
+ end subroutine
+
+ subroutine test_f2023_c1538_three_branch_mismatch
+ integer :: a, b
+ real :: r
+ logical :: flag, flag2
+ !ERROR: All consequent-args in a conditional argument must have the same type and kind; have INTEGER(4) and REAL(4)
+ call sub_int((flag ? a : flag2 ? b : r))
+ end subroutine
+
+ ! =========================================================================
+ ! F2023:C1539: Either all consequent-args shall have the same rank, or be
+ ! assumed-rank.
+ ! =========================================================================
+
+ subroutine test_f2023_c1539_rank_mismatch
+ integer :: a
+ integer :: arr(5)
+ logical :: flag
+ !ERROR: All consequent-args in a conditional argument must have the same rank
+ call sub_int((flag ? a : arr))
+ end subroutine
+
+ subroutine test_f2023_c1539_mixed_assumed_rank_and_fixed_rank(x)
+ integer, intent(in) :: x(..)
+ logical :: flag
+ integer :: a
+ ! Mixing assumed-rank and non-assumed-rank violates F2023:C1539
+ !ERROR: All consequent-args in a conditional argument must have the same rank or all must be assumed-rank
+ call sub_int((flag ? x : a))
+ end subroutine
+
+ ! =========================================================================
+ ! F2023:C1540: At least one consequent shall be a consequent-arg.
+ ! If the corresponding dummy argument is not optional, .NIL.
+ ! shall not appear.
+ ! =========================================================================
+
+ subroutine test_f2023_c1540_all_nil
+ logical :: flag
+ !ERROR: At least one consequent in a conditional argument must not be .NIL.
+ call sub_optional((flag ? .NIL. : .NIL.))
+ end subroutine
+
+ subroutine test_f2023_c1540_nil_non_optional
+ integer :: a
+ logical :: flag
+ !ERROR: .NIL. in conditional argument associated with non-optional dummy argument 'x='
+ call sub_not_optional((flag ? a : .NIL.))
+ end subroutine
+
+ ! =========================================================================
+ ! F2023:C1541: If its corresponding dummy argument is INTENT(OUT) or
+ ! INTENT(INOUT), each consequent-arg shall be a variable.
+ ! =========================================================================
+
+ subroutine test_f2023_c1541_intent_out_expr
+ integer :: a
+ logical :: flag
+ !ERROR: Each consequent-arg in conditional argument associated with INTENT(OUT) dummy argument 'x=' must be a variable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+ !ERROR: 'a+1_4' is not a variable or pointer
+ call sub_int_out((flag ? a + 1 : a))
+ end subroutine
+
+ subroutine test_f2023_c1541_intent_inout_expr
+ integer :: a
+ logical :: flag
+ !ERROR: Each consequent-arg in conditional argument associated with INTENT(IN OUT) dummy argument 'x=' must be a variable
+ !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'x=' is not definable
+ !ERROR: 'a+1_4' is not a variable or pointer
+ call sub_int_inout((flag ? a + 1 : a))
+ end subroutine
+
+ ! =========================================================================
+ ! F2023:C1542: If its corresponding dummy argument is allocatable, a
+ ! pointer, or a coarray, the attributes of each
+ ! consequent-arg shall satisfy the requirements of that dummy
+ ! argument.
+ ! =========================================================================
+
+ subroutine test_f2023_c1542_non_allocatable
+ integer :: a, b
+ logical :: flag
+ !ERROR: ALLOCATABLE dummy argument 'x=' must be associated with an ALLOCATABLE actual argument
+ call sub_alloc((flag ? a : b))
+ end subroutine
+
+ subroutine test_f2023_c1542_non_pointer
+ integer :: a, b
+ logical :: flag
+ !ERROR: Actual argument associated with POINTER dummy argument 'x=' must also be POINTER unless INTENT(IN)
+ call sub_pointer((flag ? a : b))
+ end subroutine
+
+ subroutine test_f2023_c1542_non_coarray
+ integer :: a, b
+ logical :: flag
+ ! Non-coarray consequent-args passed to a coarray dummy violates F2023:C1542
+ !ERROR: Each consequent-arg in conditional argument associated with a coarray dummy argument 'x=' must be a coarray
+ !ERROR: Actual argument associated with coarray dummy argument 'x=' must be a coarray
+ call sub_coarray((flag ? a : b))
+ end subroutine
+
+ ! =========================================================================
+ ! F2023:C1543: A consequent-arg shall not be assumed-rank unless its
+ ! corresponding dummy argument is also assumed-rank.
+ ! =========================================================================
+
+ subroutine test_f2023_c1543_assumed_rank_to_non_assumed_rank_dummy(x, y)
+ integer, intent(in) :: x(..), y(..)
+ logical :: flag
+ ! Both consequents are assumed-rank (satisfies F2023:C1539) but the
+ ! dummy is not assumed-rank — violates F2023:C1543.
+ !ERROR: Assumed-rank consequent-arg in conditional argument may only be associated with assumed-rank dummy argument 'x='
+ !ERROR: Assumed-rank actual argument may not be associated with a dummy argument 'x=' that is not also assumed-rank
+ call sub_int((flag ? x : y))
+ end subroutine
+
+ ! =========================================================================
+ ! F2023:C1544: A consequent-arg that is an expr shall not be a variable.
+ !
+ ! This is a grammar disambiguation rule making the "expr" and "variable"
+ ! alternatives of R1528 mutually exclusive. It is automatically satisfied
+ ! because the parser collapses both alternatives into a single Expr
+ ! production; IsVariable() determines the distinction at the semantic
+ ! level. The tests below demonstrate that the distinction works correctly:
+ ! variables are accepted where variables are required (C1541), expressions
+ ! are accepted where expressions suffice (INTENT(IN)), and non-variable
+ ! expressions are rejected where variables are required.
+ ! =========================================================================
+
+ subroutine test_f2023_c1544_variable_with_intent_in
+ integer :: a, b
+ logical :: flag
+ ! A variable consequent-arg is valid with INTENT(IN): it matched the
+ ! "variable" alternative of R1528, satisfying C1544.
+ call sub_int((flag ? a : b))
+ end subroutine
+
+ subroutine test_f2023_c1544_expr_with_intent_in
+ integer :: a, b
+ logical :: flag
+ ! A non-variable expression is valid with INTENT(IN): it matched the
+ ! "expr" alternative of R1528 and is not a variable, satisfying C1544.
+ call sub_int((flag ? a + 1 : b * 2))
+ end subroutine
+
+ subroutine test_f2023_c1544_variable_with_intent_out
+ integer :: a, b
+ logical :: flag
+ ! A variable consequent-arg is valid with INTENT(OUT): it matched the
+ ! "variable" alternative, satisfying both C1544 and C1541.
+ call sub_int_out((flag ? a : b))
+ end subroutine
+
+ subroutine test_f2023_c1544_expr_with_intent_out
+ integer :: a
+ logical :: flag
+ ! A non-variable expression with INTENT(OUT) satisfies C1544 (it is an
+ ! expr and not a variable) but violates C1541 (INTENT(OUT) requires a
+ ! variable). The C1541 error demonstrates the disambiguation works.
+ !ERROR: Each consequent-arg in conditional argument associated with INTENT(OUT) dummy argument 'x=' must be a variable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+ !ERROR: 'a+1_4' is not a variable or pointer
+ call sub_int_out((flag ? a + 1 : a))
+ end subroutine
+
+ subroutine test_f2023_c1544_mixed_variable_and_expr
+ integer :: a
+ logical :: flag
+ ! One consequent-arg is a variable, the other is an expression.
+ ! Both are valid with INTENT(IN): each independently satisfies C1544
+ ! (variable matched "variable", expression matched "expr").
+ call sub_int((flag ? a : a + 1))
+ end subroutine
+
+ ! =========================================================================
+ ! Typeless consequent-args: BOZ literals and NULL() without MOLD=
+ ! are not allowed as consequent-args because they have no type.
+ ! =========================================================================
+
+ subroutine test_typeless_boz_consequent
+ integer :: a
+ logical :: flag
+ !ERROR: Typeless expression is not allowed as a consequent in a conditional argument
+ call sub_int((flag ? a : z'FF'))
+ end subroutine
+
+ subroutine test_typeless_boz_first_consequent
+ integer :: a
+ logical :: flag
+ !ERROR: Typeless expression is not allowed as a consequent in a conditional argument
+ call sub_int((flag ? z'FF' : a))
+ end subroutine
+
+ subroutine test_typeless_boz_both_consequents
+ logical :: flag
+ !ERROR: Typeless expression is not allowed as a consequent in a conditional argument
+ call sub_int((flag ? z'FF' : z'00'))
+ end subroutine
+
+ subroutine test_typeless_boz_multi_branch
+ integer :: a, b
+ logical :: flag, flag2
+ !ERROR: Typeless expression is not allowed as a consequent in a conditional argument
+ call sub_int((flag ? a : flag2 ? b'101' : b))
+ end subroutine
+
+ subroutine test_typeless_null_consequent
+ integer :: a
+ logical :: flag
+ !ERROR: Typeless expression is not allowed as a consequent in a conditional argument
+ !ERROR: NULL() may not be used as an expression in this context
+ call sub_int((flag ? a : null()))
+ end subroutine
+
+ subroutine test_typeless_null_first_consequent
+ integer :: a
+ logical :: flag
+ !ERROR: Typeless expression is not allowed as a consequent in a conditional argument
+ !ERROR: NULL() may not be used as an expression in this context
+ call sub_int((flag ? null() : a))
+ end subroutine
+
+ subroutine test_typeless_null_both_consequents
+ logical :: flag
+ !ERROR: Typeless expression is not allowed as a consequent in a conditional argument
+ !ERROR: NULL() may not be used as an expression in this context
+ call sub_optional((flag ? null() : null()))
+ end subroutine
+
+ ! =========================================================================
+ ! F2023:C1545: In a reference to a generic procedure, each consequent-arg
+ ! shall have the same corank, and if any consequent-arg has the
+ ! ALLOCATABLE or POINTER attribute, each consequent-arg shall
+ ! have that attribute.
+ ! =========================================================================
+
+ subroutine test_f2023_c1545_allocatable_inconsistency
+ integer, allocatable :: a
+ integer :: b
+ logical :: flag
+ !ERROR: If any consequent-arg in a conditional argument has the ALLOCATABLE attribute, each must have it
+ !ERROR: ALLOCATABLE dummy argument 'x=' must be associated with an ALLOCATABLE actual argument
+ call sub_alloc((flag ? a : b))
+ end subroutine
+
+ subroutine test_f2023_c1545_pointer_inconsistency
+ integer, pointer :: p
+ integer :: b
+ logical :: flag
+ !ERROR: If any consequent-arg in a conditional argument has the POINTER attribute, each must have it
+ !ERROR: Actual argument associated with POINTER dummy argument 'x=' must also be POINTER unless INTENT(IN)
+ call sub_pointer((flag ? p : b))
+ end subroutine
+
+ subroutine test_f2023_c1545_allocatable_consistent_valid
+ integer, allocatable :: a, b
+ logical :: flag
+ ! Both consequent-args are allocatable -- no C1545 error
+ call sub_alloc((flag ? a : b))
+ end subroutine
+
+ subroutine test_f2023_c1545_pointer_consistent_valid
+ integer, pointer :: p, q
+ logical :: flag
+ ! Both consequent-args are pointer -- no C1545 error
+ call sub_pointer((flag ? p : q))
+ end subroutine
+
+end module
+
+! ===========================================================================
+! Test conditional arguments used across module boundaries via USE
+! ===========================================================================
+
+module m_cond_arg_provider
+ implicit none
+
+ interface
+ subroutine ext_sub_int(x)
+ integer, intent(in) :: x
+ end subroutine
+ subroutine ext_sub_optional(x)
+ integer, intent(in), optional :: x
+ end subroutine
+ subroutine ext_sub_real(x)
+ real, intent(in) :: x
+ end subroutine
+ subroutine ext_sub_int_out(x)
+ integer, intent(out) :: x
+ end subroutine
+ end interface
+
+contains
+
+ subroutine provider_valid(a, b, flag)
+ integer, intent(in) :: a, b
+ logical, intent(in) :: flag
+ call ext_sub_int((flag ? a : b))
+ end subroutine
+
+ subroutine provider_valid_optional(a, flag)
+ integer, intent(in) :: a
+ logical, intent(in) :: flag
+ call ext_sub_optional((flag ? a : .NIL.))
+ end subroutine
+
+end module
+
+subroutine test_use_module_conditional_arg
+ use m_cond_arg_provider
+ implicit none
+ integer :: x, y
+ logical :: cond
+ ! Valid: use procedures from a module with conditional args
+ call provider_valid(x, y, cond)
+ call provider_valid_optional(x, cond)
+ ! Valid: use module interfaces directly with conditional args
+ call ext_sub_int((cond ? x : y))
+ call ext_sub_optional((cond ? x : .NIL.))
+end subroutine
+
+subroutine test_use_module_type_mismatch
+ use m_cond_arg_provider
+ implicit none
+ integer :: a
+ real :: r
+ logical :: flag
+ !ERROR: All consequent-args in a conditional argument must have the same type and kind; have INTEGER(4) and REAL(4)
+ call ext_sub_int((flag ? a : r))
+end subroutine
+
+subroutine test_use_module_boz
+ use m_cond_arg_provider
+ implicit none
+ integer :: a
+ logical :: flag
+ !ERROR: Typeless expression is not allowed as a consequent in a conditional argument
+ call ext_sub_int((flag ? a : z'FF'))
+end subroutine
+
+subroutine test_use_module_null
+ use m_cond_arg_provider
+ implicit none
+ integer :: a
+ logical :: flag
+ !ERROR: Typeless expression is not allowed as a consequent in a conditional argument
+ !ERROR: NULL() may not be used as an expression in this context
+ call ext_sub_int((flag ? null() : a))
+end subroutine
+
+subroutine test_use_module_nil_non_optional
+ use m_cond_arg_provider
+ implicit none
+ integer :: a
+ logical :: flag
+ !ERROR: .NIL. in conditional argument associated with non-optional dummy argument 'x='
+ call ext_sub_int((flag ? a : .NIL.))
+end subroutine
+
+subroutine test_use_module_intent_out_expr
+ use m_cond_arg_provider
+ implicit none
+ integer :: a
+ logical :: flag
+ !ERROR: Each consequent-arg in conditional argument associated with INTENT(OUT) dummy argument 'x=' must be a variable
+ !ERROR: Actual argument associated with INTENT(OUT) dummy argument 'x=' is not definable
+ !ERROR: 'a+1_4' is not a variable or pointer
+ call ext_sub_int_out((flag ? a + 1 : a))
+end subroutine
+
+! =========================================================================
+! Derived type tests
+! =========================================================================
+
+module m_derived_types
+ implicit none
+ type :: t1
+ integer :: x
+ end type
+ type :: t2
+ integer :: x
+ end type
+ type, extends(t1) :: t1_ext
+ integer :: y
+ end type
+ interface
+ subroutine sub_t1(x)
+ import :: t1
+ type(t1), intent(in) :: x
+ end subroutine
+ subroutine sub_class_t1(x)
+ import :: t1
+ class(t1), intent(in) :: x
+ end subroutine
+ subroutine sub_class_star(x)
+ class(*), intent(in) :: x
+ end subroutine
+ end interface
+end module
+
+subroutine test_derived_same_type
+ use m_derived_types
+ implicit none
+ type(t1) :: a, b
+ logical :: flag
+ ! Valid: same declared type
+ call sub_t1((flag ? a : b))
+end subroutine
+
+subroutine test_derived_mismatched_type
+ use m_derived_types
+ implicit none
+ type(t1) :: a
+ type(t2) :: b
+ logical :: flag
+ !ERROR: All consequent-args in a conditional argument must be the same derived type; have t1 and t2
+ call sub_t1((flag ? a : b))
+end subroutine
+
+! Per F2023 15.5.2.3p4, mixing CLASS(t) and TYPE(t) with the same t is valid —
+! the conditional arg becomes polymorphic.
+subroutine test_polymorphic_class_and_type
+ use m_derived_types
+ implicit none
+ type(t1), allocatable :: a
+ class(t1), allocatable :: b
+ logical :: flag
+ ! Valid: CLASS(t1) mixed with TYPE(t1), same declared type per C1538
+ call sub_class_t1((flag ? b : a))
+end subroutine
+
+! CLASS(*) mixed with non-CLASS(*) is invalid — no declared type to compare.
+subroutine test_unlimited_poly_mismatch
+ use m_derived_types
+ implicit none
+ type(t1) :: a
+ class(*), allocatable :: b
+ logical :: flag
+ !ERROR: All consequent-args in a conditional argument must have the same type and kind; have CLASS(*) and t1
+ call sub_class_star((flag ? b : a))
+end subroutine
+
+! Both CLASS(*) is valid.
+subroutine test_unlimited_poly_both
+ use m_derived_types
+ implicit none
+ class(*), allocatable :: a, b
+ logical :: flag
+ ! Valid: both unlimited polymorphic
+ call sub_class_star((flag ? a : b))
end subroutine
>From 07e1677144afc2b63b2453c4f88f3da9d89236e0 Mon Sep 17 00:00:00 2001
From: Vineet Kumar <vineetk at hpe.com>
Date: Thu, 30 Apr 2026 15:07:54 -0500
Subject: [PATCH 2/2] [flang] Folding and shape analysis for conditional
arguments
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
- Add FoldConditionalArg to fold conditional arguments with constant
conditions, resolving to the selected consequent or .NIL. as appropriate.
- Update folding logic for function/intrinsic calls to invoke
FoldConditionalArg and skip intrinsic folding if any argument remains
conditional.
- Add GetArgExpr to ActualArgument to consistently extract the
expression for shape/corank queries.
- Update shape and corank helpers to handle conditional arguments.
- Add tests for folding conditional arguments with constant and
runtime conditions, including chain-peeling and multi-branch cases.
AI use disclaimer: The changes in this commit were substantially
generated with the assistance of AI (claude opus 4.6 via Github
CoPilot). In accordance with the LLVM project’s AI use policy, I have
reviewed and tested the code to the best of my ability.
---
flang/include/flang/Evaluate/call.h | 10 +
flang/include/flang/Evaluate/fold.h | 8 +
flang/include/flang/Evaluate/shape.h | 1 +
flang/lib/Evaluate/characteristics.cpp | 10 +-
flang/lib/Evaluate/fold-implementation.h | 26 +-
flang/lib/Evaluate/fold.cpp | 89 +++++++
flang/lib/Evaluate/intrinsics.cpp | 2 +-
flang/lib/Evaluate/shape.cpp | 40 +++
flang/lib/Evaluate/tools.cpp | 6 +-
flang/lib/Lower/ConvertCall.cpp | 4 +
flang/test/Evaluate/fold-conditional-arg.f90 | 248 +++++++++++++++++
flang/test/Semantics/conditional-arg.f90 | 263 ++++++++++++++++++-
12 files changed, 694 insertions(+), 13 deletions(-)
create mode 100644 flang/test/Evaluate/fold-conditional-arg.f90
diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h
index 1c691130449ae..1b121b33338b7 100644
--- a/flang/include/flang/Evaluate/call.h
+++ b/flang/include/flang/Evaluate/call.h
@@ -89,9 +89,11 @@ class ActualArgument {
ConditionalArgPartOrConsequent &&tail);
DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(ConditionalArg)
+ Expr<SomeLogical> &condition() { return condition_.value(); }
const Expr<SomeLogical> &condition() const { return condition_.value(); }
const Consequent &consequent() const { return consequent_; }
Consequent &consequent() { return consequent_; }
+ ConditionalArgPartOrConsequent &tail() { return tail_; }
const ConditionalArgPartOrConsequent &tail() const { return tail_; }
// Dispatch on the tail: calls onConditionalArg(const ConditionalArg &)
@@ -212,6 +214,14 @@ class ActualArgument {
const auto *condArg{GetConditionalArg()};
return condArg ? condArg->FirstNonNilConsequent() : nullptr;
}
+ // Returns the expression from a direct Expr argument or, failing that,
+ // the first non-NIL consequent from a ConditionalArg.
+ const Expr<SomeType> *GetArgExpr() const {
+ if (const auto *expr{UnwrapExpr()}) {
+ return expr;
+ }
+ return GetConditionalArgExpr();
+ }
bool isPassedObject() const { return attrs_.test(Attr::PassedObject); }
ActualArgument &set_isPassedObject(bool yes = true) {
if (yes) {
diff --git a/flang/include/flang/Evaluate/fold.h b/flang/include/flang/Evaluate/fold.h
index df43489aa679c..dafa004479ded 100644
--- a/flang/include/flang/Evaluate/fold.h
+++ b/flang/include/flang/Evaluate/fold.h
@@ -131,5 +131,13 @@ template <typename A> std::optional<std::int64_t> ToInt64(A *p) {
}
}
+// Fold a conditional argument (F2023 R1526). Folds all sub-expressions
+// and simplifies constant conditions: .TRUE. selects the consequent,
+// .FALSE. skips to the tail. If fully resolved, replaces the
+// ActualArgument with a plain expression or sets it to std::nullopt
+// for .NIL.
+void FoldConditionalArg(
+ FoldingContext &context, std::optional<ActualArgument> &arg);
+
} // namespace Fortran::evaluate
#endif // FORTRAN_EVALUATE_FOLD_H_
diff --git a/flang/include/flang/Evaluate/shape.h b/flang/include/flang/Evaluate/shape.h
index e5c2d6e8cb63d..861ca64928079 100644
--- a/flang/include/flang/Evaluate/shape.h
+++ b/flang/include/flang/Evaluate/shape.h
@@ -184,6 +184,7 @@ class GetShapeHelper
Result operator()(const CoarrayRef &) const;
Result operator()(const Substring &) const;
Result operator()(const ProcedureRef &) const;
+ Result operator()(const ActualArgument &) const;
template <typename T>
Result operator()(const ArrayConstructor<T> &aconst) const {
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 23b3f54dcb1f4..0ec0056607273 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -163,15 +163,12 @@ std::optional<TypeAndShape> TypeAndShape::Characterize(
std::optional<TypeAndShape> TypeAndShape::Characterize(
const ActualArgument &arg, FoldingContext &context, bool invariantOnly) {
- if (const auto *expr{arg.UnwrapExpr()}) {
+ if (const auto *expr{arg.GetArgExpr()}) {
return Characterize(*expr, context, invariantOnly);
}
if (const Symbol *assumed{arg.GetAssumedTypeDummy()}) {
return Characterize(*assumed, context, invariantOnly);
}
- if (const auto *expr{arg.GetConditionalArgExpr()}) {
- return Characterize(*expr, context, invariantOnly);
- }
return std::nullopt;
}
@@ -959,15 +956,12 @@ std::optional<DummyArgument> DummyArgument::FromActual(std::string &&name,
std::optional<DummyArgument> DummyArgument::FromActual(std::string &&name,
const ActualArgument &arg, FoldingContext &context,
bool forImplicitInterface) {
- if (const auto *expr{arg.UnwrapExpr()}) {
+ if (const auto *expr{arg.GetArgExpr()}) {
return FromActual(std::move(name), *expr, context, forImplicitInterface);
}
if (arg.GetAssumedTypeDummy()) {
return std::nullopt;
}
- if (const auto *expr{arg.GetConditionalArgExpr()}) {
- return FromActual(std::move(name), *expr, context, forImplicitInterface);
- }
// Guard: GetArgExpr() returns the first non-NIL consequent for a
// ConditionalArg, so normal conditional args are handled above. An
// all-.NIL. ConditionalArg would reach here (GetArgExpr() returns nullptr),
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index 2df2b9e5a300b..5e4fe0b5fa5ff 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -1263,12 +1263,36 @@ Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) {
// Don't fold the argument to KIND(); it might be a TypeParamInquiry
// with a forced result type that doesn't match the parameter.
for (std::optional<ActualArgument> &arg : args) {
- if (auto *expr{UnwrapExpr<Expr<SomeType>>(arg)}) {
+ if (arg && arg->GetConditionalArg()) {
+ FoldConditionalArg(context, arg);
+ } else if (auto *expr{UnwrapExpr<Expr<SomeType>>(arg)}) {
*expr = Fold(context, std::move(*expr));
}
}
}
if (intrinsic) {
+ // Skip intrinsic folding if any argument is still a conditional arg
+ // (i.e. its condition was not a compile-time constant). When the
+ // condition is a compile-time constant, FoldConditionalArg already resolved
+ // it to a plain Expr above, and intrinsic folding proceeds normally.
+ //
+ // TODO:
+ // For elemental/pure intrinsics, distribute the call over each
+ // consequent of the conditional arg and fold each branch independently:
+ // abs((c1 ? a : c2 ? b : c))
+ // → (c1 ? abs(a) : c2 ? abs(b) : abs(c))
+ // Use ForEachConsequent to walk the chain, clone the call per
+ // consequent, fold each clone, and reassemble into a new ConditionalArg.
+ // When multiple arguments are conditional args, distribute one at a
+ // time to avoid a combinatorial cross-product expansion.
+ // This is NOT valid for non-elemental intrinsics like RESHAPE or
+ // TRANSFER whose results depend on seeing all arguments together.
+ //
+ for (const std::optional<ActualArgument> &arg : args) {
+ if (arg && arg->isConditionalArg()) {
+ return Expr<T>{std::move(funcRef)};
+ }
+ }
const std::string name{intrinsic->name};
if (name == "cshift") {
return Folder<T>{context}.CSHIFT(std::move(funcRef));
diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp
index a2f6bc0f2ae51..f20d32077602d 100644
--- a/flang/lib/Evaluate/fold.cpp
+++ b/flang/lib/Evaluate/fold.cpp
@@ -298,6 +298,95 @@ std::optional<Expr<SomeType>> FoldTransfer(
return std::nullopt;
}
+// Fold a Consequent expression in place.
+static void FoldConsequent(
+ FoldingContext &context, ActualArgument::ConditionalArg::Consequent &cons) {
+ if (cons) {
+ cons->value() = Fold(context, std::move(cons->value()));
+ }
+}
+
+// Returned by FoldConditionalArgImpl when the entire ConditionalArg chain
+// resolves to a single consequent. Wraps Consequent in a named type so
+// callers can distinguish "fully resolved" from std::nullopt, which means
+// "chain still has at least one non-constant condition".
+// Note: a ResolvedConsequent whose value is std::nullopt represents .NIL.
+// (an absent optional argument), which is a valid resolved outcome.
+namespace {
+struct ResolvedConsequent {
+ ActualArgument::ConditionalArg::Consequent value;
+};
+} // namespace
+
+// Recursively fold a ConditionalArg chain.
+// Returns ResolvedConsequent — entire chain resolved to one consequent.
+// Returns std::nullopt — chain still has non-constant conditions;
+// all reachable sub-expressions folded in
+// place.
+static std::optional<ResolvedConsequent> FoldConditionalArgImpl(
+ FoldingContext &context, ActualArgument::ConditionalArg &condArg) {
+ using ConditionalArg = ActualArgument::ConditionalArg;
+ using Consequent = ConditionalArg::Consequent;
+
+ condArg.condition() = Fold(context, std::move(condArg.condition()));
+
+ // Condition is constant - select appropriate branch and recursively fold it.
+ if (auto constCond{
+ GetScalarConstantValue<LogicalResult>(condArg.condition())}) {
+ if (constCond->IsTrue()) {
+ // .TRUE. — select this consequent.
+ FoldConsequent(context, condArg.consequent());
+ return ResolvedConsequent{std::move(condArg.consequent())};
+ }
+ // .FALSE. — skip to the tail.
+ return condArg.VisitTail(
+ [&](ConditionalArg &inner) -> std::optional<ResolvedConsequent> {
+ auto folded{FoldConditionalArgImpl(context, inner)};
+ if (!folded) {
+ // Inner chain not fully resolved — promote it to replace
+ // the current condArg (peeling off the .FALSE. prefix).
+ // Move to a local first to avoid self-referential assignment.
+ auto promoted{std::move(inner)};
+ condArg = std::move(promoted);
+ }
+ return folded;
+ },
+ [&](Consequent &cons) -> std::optional<ResolvedConsequent> {
+ FoldConsequent(context, cons);
+ return ResolvedConsequent{std::move(cons)};
+ });
+ }
+
+ // Condition is not constant — fold all sub-expressions in place.
+ FoldConsequent(context, condArg.consequent());
+ condArg.VisitTail(
+ [&](ConditionalArg &inner) {
+ if (auto resolved{FoldConditionalArgImpl(context, inner)}) {
+ // Inner chain fully resolved — replace tail with its consequent.
+ condArg.tail() = std::move(resolved->value);
+ }
+ },
+ [&](Consequent &cons) { FoldConsequent(context, cons); });
+
+ // The condition was not a compile-time constant, so the chain could not be
+ // collapsed. All reachable sub-expressions have been folded in place above.
+ return std::nullopt;
+}
+
+void FoldConditionalArg(
+ FoldingContext &context, std::optional<ActualArgument> &arg) {
+ auto *condArg{arg ? arg->GetConditionalArg() : nullptr};
+ if (!condArg) {
+ return;
+ }
+ if (auto resolved{FoldConditionalArgImpl(context, *condArg)}) {
+ // Fully resolved to a single consequent.
+ // operator=(Expr&&) preserves keyword_, attrs_, and dummyIntent_.
+ resolved->value ? void(*arg = std::move(resolved->value->value()))
+ : void(arg = std::nullopt); // .NIL. — absent argument
+ }
+}
+
template class ExpressionBase<SomeDerived>;
template class ExpressionBase<SomeType>;
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 84cd2288fcd0b..0b7b0f01c26f5 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2788,7 +2788,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
for (std::size_t j{0}; j < dummies; ++j) {
const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]};
if (const auto &arg{rearranged[j]}) {
- if (const Expr<SomeType> *expr{arg->UnwrapExpr()}) {
+ if (const auto *expr{arg->GetArgExpr()}) {
std::string kw{d.keyword};
if (arg->keyword()) {
kw = arg->keyword()->ToString();
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index 27913c3559c71..924b6cbdddd5e 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -900,6 +900,46 @@ auto GetShapeHelper::operator()(const Substring &substring) const -> Result {
return (*this)(substring.parent());
}
+auto GetShapeHelper::operator()(const ActualArgument &arg) const -> Result {
+ // For ConditionalArg, compare shapes of all non-.NIL. consequent-args.
+ // C1539 requires the same rank. If all branches also have the same
+ // static extents, return the common concrete shape; this preserves
+ // useful compile-time checks (e.g. elemental cross-argument conformance,
+ // intrinsic result derivation). Otherwise return Shape(rank, nullopt) —
+ // correct rank, deferred extents. Per-consequent checking in
+ // CheckExplicitDataArg handles the primary dummy-vs-actual conformance
+ // regardless.
+ if (const auto *condArg{arg.GetConditionalArg()}) {
+ const auto *firstExpr{condArg->FirstNonNilConsequent()};
+ if (!firstExpr) {
+ return std::nullopt;
+ }
+ Result commonShape{(*this)(*firstExpr)};
+ bool allMatch{true};
+ condArg->ForEachConsequent(
+ [&](const ActualArgument::ConditionalArg::Consequent &cons) {
+ if (!cons || !allMatch) {
+ return;
+ }
+ Result thisShape{(*this)(cons->value())};
+ if (commonShape != thisShape) {
+ allMatch = false;
+ }
+ });
+ if (allMatch && commonShape) {
+ return commonShape;
+ }
+ return Shape(firstExpr->Rank(), std::nullopt);
+ }
+ if (const auto *expr{arg.UnwrapExpr()}) {
+ return (*this)(*expr);
+ }
+ if (const auto *assumed{arg.GetAssumedTypeDummy()}) {
+ return (*this)(*assumed);
+ }
+ return std::nullopt;
+}
+
auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
if (call.Rank() == 0) {
return ScalarShape();
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 6357de0fe0d91..3ecac6a86016a 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -887,8 +887,10 @@ std::optional<Expr<SomeType>> ConvertToType(
}
int GetCorank(const ActualArgument &arg) {
- const auto *expr{arg.UnwrapExpr()};
- return GetCorank(*expr);
+ if (const auto *expr{arg.GetArgExpr()}) {
+ return GetCorank(*expr);
+ }
+ return 0;
}
bool IsProcedureDesignator(const Expr<SomeType> &expr) {
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 54d08bb420755..fe95ed569c9a5 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -3019,6 +3019,8 @@ genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
loweredActuals.push_back(std::nullopt);
continue;
}
+ if (arg.value()->isConditionalArg())
+ TODO(loc, "lowering conditional arguments to HLFIR");
auto *expr =
Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg.value());
if (!expr) {
@@ -3144,6 +3146,8 @@ genProcedureRef(CallContext &callContext) {
Fortran::lower::CallerInterface>::PassedEntity &arg :
caller.getPassedArguments())
if (const auto *actual = arg.entity) {
+ if (actual->isConditionalArg())
+ TODO(loc, "lowering conditional arguments to HLFIR");
const auto *expr = actual->UnwrapExpr();
if (!expr) {
// TYPE(*) actual argument.
diff --git a/flang/test/Evaluate/fold-conditional-arg.f90 b/flang/test/Evaluate/fold-conditional-arg.f90
new file mode 100644
index 0000000000000..b34d332b4dee3
--- /dev/null
+++ b/flang/test/Evaluate/fold-conditional-arg.f90
@@ -0,0 +1,248 @@
+! RUN: %python %S/test_folding.py %s %flang_fc1
+! Tests folding of conditional arguments (F2023 R1526-R1528)
+! When a condition in a conditional-arg is a compile-time constant,
+! the conditional-arg should be folded to the selected consequent,
+! enabling further constant folding of the enclosing expression.
+
+module m_funcs
+ implicit none
+ interface
+ pure integer function func_int(x)
+ integer, intent(in) :: x
+ end function
+ pure real function func_real(x)
+ real, intent(in) :: x
+ end function
+ pure integer function func_two(x, y)
+ integer, intent(in) :: x, y
+ end function
+ subroutine sub_optional(x)
+ integer, intent(in), optional :: x
+ end subroutine
+ end interface
+end module
+
+module m
+ use m_funcs
+ implicit none
+
+ ! Basic: .TRUE. selects the first consequent.
+ logical, parameter :: test_true_int = abs((.true. ? -5 : -3)) == 5
+ logical, parameter :: test_true_real = abs((.true. ? -2.0 : -4.0)) == 2.0
+
+ ! Basic: .FALSE. selects the second consequent (tail).
+ logical, parameter :: test_false_int = abs((.false. ? -5 : -3)) == 3
+ logical, parameter :: test_false_real = abs((.false. ? -2.0 : -4.0)) == 4.0
+
+ ! Multi-branch: first condition .TRUE. selects first consequent.
+ logical, parameter :: test_multi_first = &
+ abs((.true. ? -10 : .false. ? -20 : -30)) == 10
+
+ ! Multi-branch: first .FALSE., second .TRUE. selects second consequent.
+ logical, parameter :: test_multi_second = &
+ abs((.false. ? -10 : .true. ? -20 : -30)) == 20
+
+ ! Multi-branch: all conditions .FALSE. selects final consequent.
+ logical, parameter :: test_multi_third = &
+ abs((.false. ? -10 : .false. ? -20 : -30)) == 30
+
+ ! Named constant as condition.
+ logical, parameter :: cond_t = .true.
+ logical, parameter :: cond_f = .false.
+ logical, parameter :: test_named_cond_true = abs((cond_t ? -7 : -9)) == 7
+ logical, parameter :: test_named_cond_false = abs((cond_f ? -7 : -9)) == 9
+
+ ! Consequent expressions themselves are folded.
+ integer, parameter :: k = 3
+ logical, parameter :: test_consequent_fold = abs((.true. ? -(k*k) : -1)) == 9
+
+ ! .TRUE. selecting a simple arithmetic consequent.
+ logical, parameter :: test_true_arith = abs((.true. ? -(1+2) : -99)) == 3
+
+ ! .FALSE. selecting a foldable tail expression.
+ logical, parameter :: test_false_arith = abs((.false. ? -99 : -(2*3))) == 6
+
+ ! Both consequents are foldable; .TRUE. picks the first.
+ logical, parameter :: test_both_foldable_true = &
+ abs((.true. ? -(1+2) : -(4+5))) == 3
+
+ ! Both consequents are foldable; .FALSE. picks the second.
+ logical, parameter :: test_both_foldable_false = &
+ abs((.false. ? -(1+2) : -(4+5))) == 9
+
+ ! Multi-branch with foldable consequent expressions.
+ logical, parameter :: test_multi_foldable = &
+ abs((.false. ? -(1+1) : .true. ? -(2+2) : -(3+3))) == 4
+
+ ! Character consequent folding.
+ logical, parameter :: test_char_true = len_trim((.true. ? 'hello' : 'world')) == 5
+ logical, parameter :: test_char_false = len_trim((.false. ? 'hi ' : 'world')) == 5
+
+ ! Named constants as both conditions and consequents.
+ integer, parameter :: val_a = -11, val_b = -22
+ logical, parameter :: test_named_cons_true = abs((cond_t ? val_a : val_b)) == 11
+ logical, parameter :: test_named_cons_false = abs((cond_f ? val_a : val_b)) == 22
+ logical, parameter :: test_named_all = abs((cond_t ? val_a : val_b)) /= 22
+
+ ! Condition is a constant expression (not a literal .TRUE./.FALSE.).
+ integer, parameter :: n = 5
+ logical, parameter :: test_expr_cond_true = abs((n > 3 ? -10 : -20)) == 10
+ logical, parameter :: test_expr_cond_false = abs((n < 3 ? -10 : -20)) == 20
+ logical, parameter :: test_expr_cond_eq = abs((n == 5 ? -42 : -99)) == 42
+ logical, parameter :: test_expr_cond_multi = &
+ abs((n > 10 ? -1 : n > 3 ? -2 : -3)) == 2
+
+ ! Negative cases: verify the WRONG branch is NOT selected.
+ logical, parameter :: test_neg_true_not_tail = abs((.true. ? -5 : -3)) /= 3
+ logical, parameter :: test_neg_false_not_first = abs((.false. ? -5 : -3)) /= 5
+ logical, parameter :: test_neg_multi_not_third = &
+ abs((.true. ? -10 : .false. ? -20 : -30)) /= 30
+ logical, parameter :: test_neg_multi_not_first = &
+ abs((.false. ? -10 : .true. ? -20 : -30)) /= 10
+ logical, parameter :: test_neg_expr_cond = abs((n > 3 ? -10 : -20)) /= 20
+
+ ! Double-parenthesized conditional: parsed as a ConditionalExpr (not a
+ ! ConditionalArg), so intrinsic folding works through the expression tree.
+ logical, parameter :: test_double_paren_true = abs(((.true. ? -7 : -3))) == 7
+ logical, parameter :: test_double_paren_false = abs(((.false. ? -7 : -3))) == 3
+ logical, parameter :: test_double_paren_multi = &
+ abs(((.false. ? -10 : .true. ? -20 : -30))) == 20
+
+contains
+
+ ! Non-intrinsic (user-defined) function calls with conditional args.
+ ! The conditional arg is folded when the condition is constant, and the
+ ! resolved consequent is passed to the function. The function call itself
+ ! is not folded (only intrinsics are), but the conditional arg folding
+ ! must not crash.
+
+ subroutine test_user_func_const_cond
+ integer :: r
+ ! Constant condition: conditional arg folds to -5, passed to func_int.
+ r = func_int((.true. ? -5 : -3))
+ r = func_int((.false. ? -5 : -3))
+ end subroutine
+
+ subroutine test_user_func_real_const_cond
+ real :: r
+ r = func_real((.true. ? -2.0 : -4.0))
+ r = func_real((.false. ? -2.0 : -4.0))
+ end subroutine
+
+ subroutine test_user_func_multi_branch
+ integer :: r
+ ! Multi-branch with constant conditions.
+ r = func_int((.false. ? -10 : .true. ? -20 : -30))
+ end subroutine
+
+ subroutine test_user_func_named_const
+ integer :: r
+ logical, parameter :: flag = .true.
+ integer, parameter :: a = -11, b = -22
+ r = func_int((flag ? a : b))
+ end subroutine
+
+ subroutine test_user_func_two_args
+ integer :: r
+ ! One conditional arg and one plain arg.
+ r = func_two((.true. ? -5 : -3), 10)
+ end subroutine
+
+ subroutine test_user_func_runtime_cond
+ integer :: r, a, b
+ logical :: flag
+ ! Runtime condition: conditional arg is NOT folded, passed through as-is.
+ r = func_int((flag ? a : b))
+ r = func_two((flag ? a : b), a)
+ end subroutine
+
+ ! Chain-peeling: leading constant-.FALSE. conditions are peeled off,
+ ! and constant conditions after the runtime one are folded.
+ ! FoldConditionalArgImpl promotes the inner chain to replace the
+ ! peeled-off prefix, so the runtime condition becomes the first.
+
+ subroutine test_chain_peel_false_then_runtime(flag)
+ logical, intent(in) :: flag
+ integer :: a, b, c, d, r
+ ! (.false. ? a : .false. ? b : flag ? c : d)
+ ! → peels two .FALSE. prefixes → (flag ? c : d)
+ r = func_int((.false. ? a : .false. ? b : flag ? c : d))
+ end subroutine
+
+ subroutine test_chain_peel_false_runtime_true(flag)
+ logical, intent(in) :: flag
+ integer :: a, b, c, d, e, r
+ ! (.false. ? a : .false. ? b : flag ? c : .true. ? d : e)
+ ! → peels two .FALSE. prefixes, folds trailing .TRUE. → (flag ? c : d)
+ r = func_int((.false. ? a : .false. ? b : flag ? c : .true. ? d : e))
+ end subroutine
+
+ subroutine test_chain_peel_single_false(flag)
+ logical, intent(in) :: flag
+ integer :: a, b, c, r
+ ! (.false. ? a : flag ? b : c)
+ ! → peels one .FALSE. prefix → (flag ? b : c)
+ r = func_int((.false. ? a : flag ? b : c))
+ end subroutine
+
+ subroutine test_chain_peel_deep(flag)
+ logical, intent(in) :: flag
+ integer :: a, b, c, d, e, f, g, r
+ ! (.false. ? a : .false. ? b : .false. ? c : .false. ? d : flag ? e : .true. ? f : g)
+ ! → peels four .FALSE. prefixes, folds trailing .TRUE. → (flag ? e : f)
+ r = func_int(( &
+ .false. ? a : .false. ? b : .false. ? c : .false. ? d : &
+ flag ? e : .true. ? f : g))
+ end subroutine
+
+ subroutine test_chain_peel_false_then_true
+ integer :: a, b, c, r
+ ! All conditions constant — fully resolved (no runtime condition).
+ ! (.false. ? a : .false. ? b : .true. ? c : a)
+ ! → peels two .FALSE., then .TRUE. selects c → fully folded.
+ ! This must not crash and the call receives a plain expression.
+ r = func_int((.false. ? a : .false. ? b : .true. ? c : a))
+ end subroutine
+
+ ! .NIL. folding tests: conditional args with .NIL. and optional dummies.
+ ! When the condition is constant, .NIL. branches fold to absent arguments
+ ! and non-.NIL. branches fold to plain expressions.
+
+ subroutine test_nil_false_selects_nil
+ integer :: a
+ ! (.FALSE. ? a : .NIL.) → folds to .NIL. (absent)
+ call sub_optional((.false. ? a : .nil.))
+ end subroutine
+
+ subroutine test_nil_false_selects_value
+ integer :: a
+ ! (.FALSE. ? .NIL. : a) → folds to a
+ call sub_optional((.false. ? .nil. : a))
+ end subroutine
+
+ subroutine test_nil_true_selects_nil
+ integer :: a
+ ! (.TRUE. ? .NIL. : a) → folds to .NIL. (absent)
+ call sub_optional((.true. ? .nil. : a))
+ end subroutine
+
+ subroutine test_nil_true_selects_value
+ integer :: a
+ ! (.TRUE. ? a : .NIL.) → folds to a
+ call sub_optional((.true. ? a : .nil.))
+ end subroutine
+
+ subroutine test_nil_runtime_no_fold(flag)
+ logical, intent(in) :: flag
+ integer :: a
+ ! (flag ? a : .NIL.) → no fold (runtime condition)
+ call sub_optional((flag ? a : .nil.))
+ end subroutine
+
+ subroutine test_nil_chain_folds_to_nil
+ integer :: a, b
+ ! (.FALSE. ? a : .TRUE. ? .NIL. : b) → chain folds to .NIL. (absent)
+ call sub_optional((.false. ? a : .true. ? .nil. : b))
+ end subroutine
+
+end module
\ No newline at end of file
diff --git a/flang/test/Semantics/conditional-arg.f90 b/flang/test/Semantics/conditional-arg.f90
index 57cd9a797b1dc..aaa109b05ec98 100644
--- a/flang/test/Semantics/conditional-arg.f90
+++ b/flang/test/Semantics/conditional-arg.f90
@@ -42,6 +42,30 @@ subroutine sub_coarray(x)
subroutine sub_two(x, y)
integer, intent(in) :: x, y
end subroutine
+ subroutine sub_array_fixed(x)
+ integer, intent(in) :: x(5)
+ end subroutine
+ subroutine sub_array_two(x, y)
+ integer, intent(in) :: x(:), y(:)
+ end subroutine
+ subroutine sub_matrix(x)
+ integer, intent(in) :: x(:,:)
+ end subroutine
+ subroutine sub_array_optional(x)
+ integer, intent(in), optional :: x(:)
+ end subroutine
+ subroutine sub_matrix_optional(x)
+ integer, intent(in), optional :: x(:,:)
+ end subroutine
+ pure integer function func_int(x)
+ integer, intent(in) :: x
+ end function
+ pure real function func_real(x)
+ real, intent(in) :: x
+ end function
+ pure integer function func_two(x, y)
+ integer, intent(in) :: x, y
+ end function
end interface
contains
@@ -416,6 +440,244 @@ subroutine test_f2023_c1545_pointer_consistent_valid
call sub_pointer((flag ? p : q))
end subroutine
+ ! =========================================================================
+ ! Shape analysis: verify that conditional args with array consequent-args
+ ! get their shape from the consequents, not from the scalar condition.
+ ! Without the GetShapeHelper(ActualArgument) override, the Traverse base
+ ! class would return the scalar shape of the condition via CombineAnyOf,
+ ! causing spurious shape mismatches.
+ ! =========================================================================
+
+ subroutine test_shape_array_conditional_arg
+ integer :: a(5), b(5)
+ logical :: flag
+ ! Array conditional arg passed to assumed-shape dummy — shape comes
+ ! from the consequent-args (rank 1), not the scalar condition.
+ call sub_array((flag ? a : b))
+ end subroutine
+
+ subroutine test_shape_array_fixed_extent
+ integer :: a(5), b(5)
+ logical :: flag
+ ! Array conditional arg with fixed-extent dummy.
+ call sub_array_fixed((flag ? a : b))
+ end subroutine
+
+ subroutine test_shape_matrix_conditional_arg
+ integer :: m1(3,4), m2(3,4)
+ logical :: flag
+ ! Rank-2 array conditional arg.
+ call sub_matrix((flag ? m1 : m2))
+ end subroutine
+
+ subroutine test_shape_two_array_args
+ integer :: a(5), b(5), c(5), d(5)
+ logical :: f1, f2
+ ! Two independent array conditional args in the same call.
+ call sub_array_two((f1 ? a : b), (f2 ? c : d))
+ end subroutine
+
+ subroutine test_shape_nil_with_array
+ integer :: a(5), b(5)
+ logical :: flag, flag2
+ ! .NIL. mixed with rank-1 array consequent-args passed to an optional
+ ! array dummy. If the shape analysis fails to extract rank from the
+ ! first non-.NIL. consequent, this will produce a rank mismatch error.
+ call sub_array_optional((flag ? .NIL. : flag2 ? a : b))
+ end subroutine
+
+ subroutine test_shape_nil_scalar_to_array_dummy
+ integer :: a, b
+ logical :: flag, flag2
+ ! .NIL. with scalar consequent-args passed to an optional array dummy.
+ ! Shape analysis extracts rank 0 from the first non-.NIL. consequent,
+ ! which mismatches the assumed-shape array dummy.
+ !ERROR: Scalar actual argument may not be associated with assumed-shape dummy argument 'x='
+ call sub_array_optional((flag ? .NIL. : flag2 ? a : b))
+ end subroutine
+
+ subroutine test_shape_nil_skipped_rank_mismatch
+ integer :: a(5), b(5)
+ logical :: flag, flag2
+ ! .NIL. is the first consequent; non-.NIL. consequents are rank-1 arrays.
+ ! Dummy is a rank-2 matrix. If shape were extracted from .NIL. (no shape),
+ ! this might silently pass. Instead, shape comes from the rank-1 array,
+ ! producing a rank mismatch — proving .NIL. was correctly skipped.
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 1
+ call sub_matrix_optional((flag ? .NIL. : flag2 ? a : b))
+ end subroutine
+
+ subroutine test_shape_nil_forced_rank_match
+ integer :: a(5)
+ ! .TRUE. forces .NIL. to be selected — after folding, the arg becomes
+ ! absent. But shape analysis runs on the unfolded conditional arg and
+ ! still checks the rank of the non-.NIL. consequent (a, rank 1) against
+ ! the dummy (rank 1). No error because ranks match.
+ call sub_array_optional((.true. ? .NIL. : a))
+ end subroutine
+
+ subroutine test_shape_nil_forced_rank_mismatch
+ integer :: a(5)
+ ! .TRUE. forces .NIL. to be selected, but shape analysis still extracts
+ ! rank from the non-.NIL. consequent (a, rank 1). The dummy is rank 2,
+ ! so this errors — proving shape is NOT extracted from .NIL. even when
+ ! .NIL. is the branch that will be selected at compile time.
+ !ERROR: Rank of dummy argument is 2, but actual argument has rank 1
+ call sub_matrix_optional((.true. ? .NIL. : a))
+ end subroutine
+
+ subroutine test_shape_nil_with_array_optional
+ integer :: a(5), b(5)
+ logical :: flag, flag2
+ ! .NIL. with array consequent-args and an optional scalar dummy.
+ ! Shape comes from the first non-.NIL. consequent (a(1), scalar).
+ call sub_optional((flag ? .NIL. : flag2 ? a(1) : b(1)))
+ end subroutine
+
+ subroutine test_shape_multi_branch_array
+ integer :: a(5), b(5), c(5)
+ logical :: f1, f2
+ ! Multi-branch conditional arg with arrays — all same rank.
+ call sub_array((f1 ? a : f2 ? b : c))
+ end subroutine
+
+ ! =========================================================================
+ ! Intrinsic characterization: conditional args with intrinsic procedures.
+ ! Verifies that intrinsic argument matching correctly extracts the type
+ ! and kind from a conditional arg via GetArgExpr().
+ ! =========================================================================
+
+ subroutine test_intrinsic_abs_int
+ integer :: a, b, r
+ logical :: flag
+ ! ABS with integer conditional arg — runtime condition exercises
+ ! the GetArgExpr() path in intrinsic characterization.
+ r = abs((flag ? a : b))
+ end subroutine
+
+ subroutine test_intrinsic_abs_real
+ real :: a, b, r
+ logical :: flag
+ r = abs((flag ? a : b))
+ end subroutine
+
+ subroutine test_intrinsic_max_conditional
+ integer :: a, b, c, r
+ logical :: flag
+ ! MAX with a mix of conditional and plain args.
+ r = max((flag ? a : b), c)
+ end subroutine
+
+ subroutine test_intrinsic_min_multi_conditional
+ integer :: a, b, c, d, r
+ logical :: f1, f2
+ ! MIN with multiple conditional args.
+ r = min((f1 ? a : b), (f2 ? c : d))
+ end subroutine
+
+ subroutine test_intrinsic_len_trim_char
+ character(10) :: s1, s2
+ logical :: flag
+ integer :: r
+ r = len_trim((flag ? s1 : s2))
+ end subroutine
+
+ subroutine test_intrinsic_multi_branch
+ integer :: a, b, c, r
+ logical :: f1, f2
+ ! Multi-branch conditional arg in intrinsic call.
+ r = abs((f1 ? a : f2 ? b : c))
+ end subroutine
+
+ ! =========================================================================
+ ! Coarray: conditional args with coarray consequent-args.
+ ! Verifies that GetCorank (via GetArgExpr()) correctly extracts the
+ ! corank from a conditional arg's consequent.
+ ! =========================================================================
+
+ subroutine test_valid_coarray_conditional(a, b, flag)
+ integer, intent(inout) :: a[*], b[*]
+ logical, intent(in) :: flag
+ ! Both consequent-args are coarrays — matches coarray dummy.
+ call sub_coarray((flag ? a : b))
+ end subroutine
+
+ subroutine test_valid_coarray_multi_branch(a, b, c, f1, f2)
+ integer, intent(inout) :: a[*], b[*], c[*]
+ logical, intent(in) :: f1, f2
+ ! Multi-branch with all coarray consequent-args.
+ call sub_coarray((f1 ? a : f2 ? b : c))
+ end subroutine
+
+ ! =========================================================================
+ ! Double-parenthesized conditional: the extra parens cause the parser to
+ ! treat it as a ConditionalExpr (expression-level) rather than a
+ ! ConditionalArg (argument-level). This exercises the expression folding
+ ! path for intrinsics instead of the ConditionalArg path.
+ ! =========================================================================
+
+ subroutine test_double_paren_abs_int
+ integer :: a, b, r
+ logical :: flag
+ r = abs(((flag ? a : b)))
+ end subroutine
+
+ subroutine test_double_paren_abs_real
+ real :: a, b, r
+ logical :: flag
+ r = abs(((flag ? a : b)))
+ end subroutine
+
+ subroutine test_double_paren_max
+ integer :: a, b, c, r
+ logical :: flag
+ r = max(((flag ? a : b)), c)
+ end subroutine
+
+ subroutine test_double_paren_multi_branch
+ integer :: a, b, c, r
+ logical :: f1, f2
+ r = abs(((f1 ? a : f2 ? b : c)))
+ end subroutine
+
+ ! =========================================================================
+ ! Non-intrinsic (user-defined) function calls with conditional args.
+ ! Unlike intrinsics, these skip the intrinsic folding path entirely,
+ ! so the ConditionalArg in ActualArgument::u_ is passed through as-is.
+ ! =========================================================================
+
+ subroutine test_user_func_int
+ integer :: a, b, r
+ logical :: flag
+ r = func_int((flag ? a : b))
+ end subroutine
+
+ subroutine test_user_func_real
+ real :: a, b, r
+ logical :: flag
+ r = func_real((flag ? a : b))
+ end subroutine
+
+ subroutine test_user_func_multi_branch
+ integer :: a, b, c, r
+ logical :: f1, f2
+ r = func_int((f1 ? a : f2 ? b : c))
+ end subroutine
+
+ subroutine test_user_func_two_args
+ integer :: a, b, c, d, r
+ logical :: f1, f2
+ ! One conditional arg and one plain arg.
+ r = func_two((f1 ? a : b), c)
+ end subroutine
+
+ subroutine test_user_func_two_conditional
+ integer :: a, b, c, d, r
+ logical :: f1, f2
+ ! Both arguments are conditional args.
+ r = func_two((f1 ? a : b), (f2 ? c : d))
+ end subroutine
+
end module
! ===========================================================================
@@ -517,7 +779,6 @@ subroutine test_use_module_intent_out_expr
!ERROR: 'a+1_4' is not a variable or pointer
call ext_sub_int_out((flag ? a + 1 : a))
end subroutine
-
! =========================================================================
! Derived type tests
! =========================================================================
More information about the flang-commits
mailing list