Hi all,
This patch introduces support for conditional expressions (also known as
ternary operators in some languages) to Fortran. I decided to implement
this feature after discovering that this common functionality, widely
used in C/C++, wasn't available until the Fortran 2023 standard. This
was also a great opportunity to learn more about gfortran's internals,
as it required touching both the front-end and back-end.
For the front-end, I manually parsed the right-associative conditional
expression, which required some special logic. On the back-end, I simply
forwarded it to COND_EXPR. I also added support for tools like the
parse-tree dump.
I'm not sure if we need to handle constant folding ourselves, or if
COND_EXPR will take care of it.
I plan to add more tests and polish the patch. However, I want to get
some early feedback on the general approach. Please take a look when you
have a moment.
Thanks in advance,
Yuao
From 8b0312442ade17f64ae7c8059daa3af46a0bceda Mon Sep 17 00:00:00 2001
From: Yuao Ma <c...@outlook.com>
Date: Wed, 30 Jul 2025 22:38:57 +0800
Subject: [PATCH] fortran: implement conditional expression for fortran 2023
TBD
gcc/fortran/ChangeLog:
* dump-parse-tree.cc (show_expr):
* expr.cc (gfc_get_conditional_expr):
(gfc_copy_expr):
(free_expr0):
* gfortran.h (enum expr_t):
(gfc_get_operator_expr):
(gfc_get_conditional_expr):
* matchexp.cc (gfc_match_expr):
(match_binary):
* resolve.cc (resolve_conditional):
(gfc_resolve_expr):
* trans-expr.cc (gfc_conv_conditional_expr):
(gfc_conv_expr):
gcc/testsuite/ChangeLog:
* gfortran.dg/conditional_1.f90: New test.
---
gcc/fortran/dump-parse-tree.cc | 10 ++++
gcc/fortran/expr.cc | 34 +++++++++++++
gcc/fortran/gfortran.h | 30 +++++++++--
gcc/fortran/matchexp.cc | 55 +++++++++++++++++++--
gcc/fortran/resolve.cc | 39 +++++++++++++++
gcc/fortran/trans-expr.cc | 35 +++++++++++++
gcc/testsuite/gfortran.dg/conditional_1.f90 | 12 +++++
7 files changed, 206 insertions(+), 9 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/conditional_1.f90
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 3cd2eeef11a..eda0659d6e2 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -767,6 +767,16 @@ show_expr (gfc_expr *p)
break;
+ case EXPR_CONDITIONAL:
+ fputc ('(', dumpfile);
+ show_expr (p->value.conditional.condition);
+ fputs (" ? ", dumpfile);
+ show_expr (p->value.conditional.true_expr);
+ fputs (" : ", dumpfile);
+ show_expr (p->value.conditional.false_expr);
+ fputc (')', dumpfile);
+ break;
+
case EXPR_COMPCALL:
show_compcall (p);
break;
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index b8d04ff6f36..2ccd8248a8a 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -116,6 +116,25 @@ gfc_get_operator_expr (locus *where, gfc_intrinsic_op op,
return e;
}
+/* Get a new expression node that is an conditional expression node. */
+
+gfc_expr *
+gfc_get_conditional_expr (locus *where, gfc_expr *condition,
+ gfc_expr *true_expr, gfc_expr *false_expr)
+{
+ gfc_expr *e;
+
+ e = gfc_get_expr ();
+ e->expr_type = EXPR_CONDITIONAL;
+ e->value.conditional.condition = condition;
+ e->value.conditional.true_expr = true_expr;
+ e->value.conditional.false_expr = false_expr;
+
+ if (where)
+ e->where = *where;
+
+ return e;
+}
/* Get a new expression node that is an structure constructor
of given type and kind. */
@@ -393,6 +412,15 @@ gfc_copy_expr (gfc_expr *p)
break;
+ case EXPR_CONDITIONAL:
+ q->value.conditional.condition
+ = gfc_copy_expr (p->value.conditional.condition);
+ q->value.conditional.true_expr
+ = gfc_copy_expr (p->value.conditional.true_expr);
+ q->value.conditional.false_expr
+ = gfc_copy_expr (p->value.conditional.false_expr);
+ break;
+
case EXPR_FUNCTION:
q->value.function.actual =
gfc_copy_actual_arglist (p->value.function.actual);
@@ -502,6 +530,12 @@ free_expr0 (gfc_expr *e)
gfc_free_expr (e->value.op.op2);
break;
+ case EXPR_CONDITIONAL:
+ gfc_free_expr (e->value.conditional.condition);
+ gfc_free_expr (e->value.conditional.true_expr);
+ gfc_free_expr (e->value.conditional.false_expr);
+ break;
+
case EXPR_FUNCTION:
gfc_free_actual_arglist (e->value.function.actual);
break;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index d9dcd1b504f..dde892d235a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -176,8 +176,19 @@ enum gfc_source_form
/* Expression node types. */
enum expr_t
- { EXPR_UNKNOWN = 0, EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE,
- EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL, EXPR_COMPCALL,
EXPR_PPC
+{
+ EXPR_UNKNOWN = 0,
+ EXPR_OP = 1,
+ EXPR_FUNCTION,
+ EXPR_CONSTANT,
+ EXPR_VARIABLE,
+ EXPR_SUBSTRING,
+ EXPR_STRUCTURE,
+ EXPR_ARRAY,
+ EXPR_NULL,
+ EXPR_COMPCALL,
+ EXPR_PPC,
+ EXPR_CONDITIONAL,
};
/* Array types. */
@@ -2808,8 +2819,14 @@ typedef struct gfc_expr
character;
gfc_constructor_base constructor;
- }
- value;
+
+ struct
+ {
+ struct gfc_expr *condition;
+ struct gfc_expr *true_expr;
+ struct gfc_expr *false_expr;
+ } conditional;
+ } value;
/* Used to store PDT expression lists associated with expressions. */
gfc_actual_arglist *param_list;
@@ -3924,7 +3941,10 @@ bool gfc_is_ptr_fcn (gfc_expr *);
gfc_expr *gfc_get_expr (void);
gfc_expr *gfc_get_array_expr (bt type, int kind, locus *);
gfc_expr *gfc_get_null_expr (locus *);
-gfc_expr *gfc_get_operator_expr (locus *, gfc_intrinsic_op,gfc_expr *,
gfc_expr *);
+gfc_expr *gfc_get_operator_expr (locus *, gfc_intrinsic_op, gfc_expr *,
+ gfc_expr *);
+gfc_expr *gfc_get_conditional_expr (locus *, gfc_expr *, gfc_expr *,
+ gfc_expr *);
gfc_expr *gfc_get_structure_constructor_expr (bt, int, locus *);
gfc_expr *gfc_get_constant_expr (bt, int, locus *);
gfc_expr *gfc_get_character_expr (int, locus *, const char *, gfc_charlen_t
len);
diff --git a/gcc/fortran/matchexp.cc b/gcc/fortran/matchexp.cc
index 9b66243b4fa..83b37cfaf6a 100644
--- a/gcc/fortran/matchexp.cc
+++ b/gcc/fortran/matchexp.cc
@@ -856,12 +856,11 @@ match_level_5 (gfc_expr **result)
return MATCH_YES;
}
-
-/* Match an expression. At this level, we are stringing together
+/* Match a binary expression. At this level, we are stringing together
level 5 expressions separated by binary operators. */
-match
-gfc_match_expr (gfc_expr **result)
+static match
+match_binary (gfc_expr **result)
{
gfc_expr *all, *e;
gfc_user_op *uop;
@@ -902,3 +901,51 @@ gfc_match_expr (gfc_expr **result)
*result = all;
return MATCH_YES;
}
+
+/* Match an expression. */
+
+match
+gfc_match_expr (gfc_expr **result)
+{
+ gfc_expr *condition, *true_expr, *false_expr;
+ locus where;
+ match m;
+
+ m = match_binary (&condition);
+ if (m != MATCH_YES)
+ return m;
+
+ if (gfc_match_char ('?') != MATCH_YES)
+ {
+ *result = condition;
+ return MATCH_YES;
+ }
+ where = gfc_current_locus;
+
+ m = match_binary (&true_expr);
+ if (m != MATCH_YES)
+ {
+ gfc_free_expr (condition);
+ return m;
+ }
+
+ if (gfc_match_char (':') != MATCH_YES)
+ {
+ gfc_error ("Expected ':' in conditional expression at %C");
+ gfc_free_expr (condition);
+ gfc_free_expr (true_expr);
+ return MATCH_ERROR;
+ }
+ where = gfc_current_locus;
+
+ m = gfc_match_expr (&false_expr);
+ if (m != MATCH_YES)
+ {
+ gfc_free_expr (condition);
+ gfc_free_expr (true_expr);
+ return m;
+ }
+
+ *result = gfc_get_conditional_expr (&where, condition, true_expr,
false_expr);
+ return MATCH_YES;
+}
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index c33bd17da2d..a9b2f57f360 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -4989,6 +4989,41 @@ simplify_op:
return t;
}
+static bool
+resolve_conditional (gfc_expr *expr)
+{
+ gfc_expr *condition, *true_expr, *false_expr;
+
+ condition = expr->value.conditional.condition;
+ true_expr = expr->value.conditional.true_expr;
+ false_expr = expr->value.conditional.false_expr;
+
+ if (!gfc_resolve_expr (condition) || !gfc_resolve_expr (true_expr)
+ || !gfc_resolve_expr (false_expr))
+ return false;
+
+ if (condition->ts.type != BT_LOGICAL)
+ {
+ gfc_error ("Condition in conditional expression must be logical at %L",
+ &condition->where);
+ return false;
+ }
+
+ if (!gfc_type_compatible (&true_expr->ts, &false_expr->ts))
+ {
+ if (!gfc_convert_type (true_expr, &false_expr->ts, 2)
+ && !gfc_convert_type (false_expr, &true_expr->ts, 2))
+ {
+ gfc_error ("Incompatible types in conditional expression at %L",
+ &expr->where);
+ return false;
+ }
+ }
+
+ expr->ts = true_expr->ts;
+ expr->rank = MAX (true_expr->rank, false_expr->rank);
+ return true;
+}
/************** Array resolution subroutines **************/
@@ -7980,6 +8015,10 @@ gfc_resolve_expr (gfc_expr *e)
t = resolve_operator (e);
break;
+ case EXPR_CONDITIONAL:
+ t = resolve_conditional (e);
+ break;
+
case EXPR_FUNCTION:
case EXPR_VARIABLE:
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 0db7ba3fd52..56e0dbf1808 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -4369,6 +4369,37 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
gfc_add_block_to_block (&se->post, &lse.post);
}
+static void
+gfc_conv_conditional_expr (gfc_se *se, gfc_expr *expr)
+{
+ gfc_se cond_se, true_se, false_se;
+ tree condition, true_val, false_val;
+ tree type;
+
+ gfc_init_se (&cond_se, se);
+ gfc_init_se (&true_se, se);
+ gfc_init_se (&false_se, se);
+
+ gfc_conv_expr (&cond_se, expr->value.conditional.condition);
+ gfc_add_block_to_block (&se->pre, &cond_se.pre);
+ condition = gfc_evaluate_now (cond_se.expr, &se->pre);
+
+ gfc_conv_expr (&true_se, expr->value.conditional.true_expr);
+ gfc_add_block_to_block (&se->pre, &true_se.pre);
+ true_val = true_se.expr;
+
+ gfc_conv_expr (&false_se, expr->value.conditional.false_expr);
+ gfc_add_block_to_block (&se->pre, &false_se.pre);
+ false_val = false_se.expr;
+
+ type = gfc_typenode_for_spec (&expr->ts);
+ true_val = fold_convert (type, true_val);
+ false_val = fold_convert (type, false_val);
+
+ se->expr = fold_build3_loc (input_location, COND_EXPR, type, condition,
+ true_val, false_val);
+}
+
/* If a string's length is one, we convert it to a single character. */
tree
@@ -10447,6 +10478,10 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
gfc_conv_expr_op (se, expr);
break;
+ case EXPR_CONDITIONAL:
+ gfc_conv_conditional_expr (se, expr);
+ break;
+
case EXPR_FUNCTION:
gfc_conv_function_expr (se, expr);
break;
diff --git a/gcc/testsuite/gfortran.dg/conditional_1.f90
b/gcc/testsuite/gfortran.dg/conditional_1.f90
new file mode 100644
index 00000000000..e19a33dbfb8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/conditional_1.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+program simple_conditional
+ implicit none
+ integer :: i = 42
+
+ i = i > 0 ? 1 : -1
+ if (i /= 1) stop 1
+
+ i = 0
+ i = i > 0 ? 1 : i < 0 ? -1 : 0
+ if (i /= 0) stop 2
+end program simple_conditional
--
2.43.0
