Hi all, This patch introduces support for the NIL value within conditional arguments, addressing several scenarios for how NIL should be handled.
We now support three distinct behaviors for NIL argument: - accept it for actual arguments to OPTIONAL dummy arguments - reject it for dummy arguments that are not OPTIONAL - reject it when not used as actual argument. Implementation Details - The NIL node is represented by an expression of type EXPR_CONDITIONAL where the condition field is nullptr. - To distinguish between the valid and invalid uses mentioned above, we rely on the global state actual_arg to determine if the expression is being used as an actual argument. - For codegen, a NIL node simply generates a build_empty_statement. - The included test suite covers both the expected workable cases and the correct error diagnostics for rejected cases. This patch does not yet address diagnostics for intrinsic procedures. Handling NIL arguments for intrinsics is complex because most intrinsic functions already utilize their own custom argument-checking functions. While one option would be to add a new loop to the check_specific - traversing the argument list and verifying the OPTIONAL status - I haven't yet committed to this approach, as I'm unsure if it's the most optimal solution. Regarding the Fortran 2023 standard, C1538 - C1545 outline additional requirements for conditional arguments involving NIL. I plan to gradually expand support to meet these extra requirements over subsequent patches. Please take a look when you have time, thanks! Yuao
From 19285cd11445eb5b8530ecf532f360e72ead3259 Mon Sep 17 00:00:00 2001 From: Yuao Ma <[email protected]> Date: Sun, 19 Oct 2025 17:38:52 +0800 Subject: [PATCH] fortran: support .NIL. in conditional arguments This patch introduces support for the NIL value within a conditional arguments, addressing several scenarios for how NIL should be handled. We now support three distinct behaviors for NIL argument: - accept it for actual arguments to OPTIONAL dummy arguments - reject it for dummy arguments that are not OPTIONAL - reject it when not used as actual argument. Implementation Details - The NIL node is represented by an expression of type EXPR_CONDITIONAL where the condition field is nullptr. - To distinguish between the valid and invalid uses mentioned above, we rely on the global state actual_arg to determine if the expression is being used as an actual argument. - For codegen, a NIL node simply generates a build_empty_statement. - The included test suite covers both the expected workable cases and the correct error diagnostics for rejected cases. gcc/fortran/ChangeLog: * dump-parse-tree.cc (show_expr): Handle NIL. * expr.cc (gfc_is_conditional_nil): Check if cond-expr has NIL. (simplify_conditional): Handle NIL. * gfortran.h (gfc_is_conditional_nil): Add declaration. * interface.cc (gfc_compare_actual_formal): Diagnose dummy argument non NIL. * matchexp.cc (match_conditional): Parsing NIL. * resolve.cc (resolve_conditional): Handle NIL. (gfc_resolve_expr): For cond-expr we need the actual_arg. * trans-array.cc (gfc_walk_conditional_expr): Handle NIL. * trans-expr.cc (gfc_conv_conditional_expr): NIL codegen. gcc/testsuite/ChangeLog: * gfortran.dg/conditional_10.f90: New test. * gfortran.dg/conditional_11.f90: New test. --- gcc/fortran/dump-parse-tree.cc | 19 ++++--- gcc/fortran/expr.cc | 17 ++++++- gcc/fortran/gfortran.h | 2 +- gcc/fortran/interface.cc | 10 ++++ gcc/fortran/matchexp.cc | 30 +++++++---- gcc/fortran/resolve.cc | 52 ++++++++++++++++---- gcc/fortran/trans-array.cc | 3 ++ gcc/fortran/trans-expr.cc | 6 +++ gcc/testsuite/gfortran.dg/conditional_10.f90 | 21 ++++++++ gcc/testsuite/gfortran.dg/conditional_11.f90 | 15 ++++++ 10 files changed, 147 insertions(+), 28 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/conditional_10.f90 create mode 100644 gcc/testsuite/gfortran.dg/conditional_11.f90 diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index eda0659d6e2..17d821a0f61 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -768,13 +768,18 @@ 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); + if (!p->value.conditional.condition) + fputs (".NIL.", dumpfile); + else + { + 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: diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index a11ff79ab6b..44a6b98dfa7 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -136,6 +136,21 @@ gfc_get_conditional_expr (locus *where, gfc_expr *condition, return e; } +/* Check if the condtional expression has .nil. or not */ + +bool +gfc_is_conditional_nil (gfc_expr *e) +{ + if (!e) + gcc_unreachable (); + if (e->expr_type != EXPR_CONDITIONAL) + return false; + if (e->value.conditional.condition == nullptr) + return true; + return gfc_is_conditional_nil (e->value.conditional.true_expr) + || gfc_is_conditional_nil (e->value.conditional.false_expr); +} + /* Get a new expression node that is an structure constructor of given type and kind. */ @@ -1409,7 +1424,7 @@ simplify_conditional (gfc_expr *p, int type) || !gfc_simplify_expr (false_expr, type)) return false; - if (!gfc_is_constant_expr (condition)) + if (!condition || !gfc_is_constant_expr (condition)) return true; p->value.conditional.condition = NULL; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index a14202fda8f..4eb4779e096 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3967,7 +3967,7 @@ gfc_expr *gfc_copy_expr (gfc_expr *); gfc_ref* gfc_copy_ref (gfc_ref*); bool gfc_specification_expr (gfc_expr *); - +bool gfc_is_conditional_nil (gfc_expr *); bool gfc_numeric_ts (gfc_typespec *); int gfc_kind_max (gfc_expr *, gfc_expr *); diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index ef5a17d0af4..674bf852872 100644 --- a/gcc/fortran/interface.cc +++ b/gcc/fortran/interface.cc @@ -3547,6 +3547,16 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, goto match; } + if (a->expr->expr_type == EXPR_CONDITIONAL + && gfc_is_conditional_nil (a->expr) && !optional_dummy) + { + gfc_error ( + "Dummy argument is not optional, .NIL. at %L shall not appear", + &a->expr->where); + ok = false; + goto match; + } + if (!compare_parameter (f->sym, a->expr, ranks_must_agree, is_elemental, where)) { diff --git a/gcc/fortran/matchexp.cc b/gcc/fortran/matchexp.cc index e3a99253841..d7b25f95666 100644 --- a/gcc/fortran/matchexp.cc +++ b/gcc/fortran/matchexp.cc @@ -170,11 +170,17 @@ match_conditional (gfc_expr **result) } gfc_gobble_whitespace (); - m = gfc_match_expr (&true_expr); - if (m != MATCH_YES) + where = gfc_current_locus; + if ((m = gfc_match (" .nil. ")) == MATCH_YES) + true_expr = gfc_get_conditional_expr (&where, nullptr, nullptr, nullptr); + else { - gfc_free_expr (condition); - return m; + m = gfc_match_expr (&true_expr); + if (m != MATCH_YES) + { + gfc_free_expr (condition); + return m; + } } m = gfc_match_char (':'); @@ -186,12 +192,18 @@ match_conditional (gfc_expr **result) return MATCH_ERROR; } - m = match_conditional (&false_expr); - if (m != MATCH_YES) + where = gfc_current_locus; + if ((m = gfc_match (" .nil. ")) == MATCH_YES) + false_expr = gfc_get_conditional_expr (&where, nullptr, nullptr, nullptr); + else { - gfc_free_expr (condition); - gfc_free_expr (true_expr); - return m; + m = match_conditional (&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); diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 1c49ccf4711..31f11cebec4 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -5017,11 +5017,37 @@ static bool resolve_conditional (gfc_expr *expr) { gfc_expr *condition, *true_expr, *false_expr; + bool true_expr_is_nil, false_expr_is_nil; + gfc_typespec non_nil_ts; + int non_nil_rank; condition = expr->value.conditional.condition; true_expr = expr->value.conditional.true_expr; false_expr = expr->value.conditional.false_expr; + if (!condition) + { + if (actual_arg) + return true; + else + { + gfc_error (".NIL. at %L is only valid in conditional arguments", + &expr->where); + return false; + } + } + + true_expr_is_nil = true_expr->expr_type == EXPR_CONDITIONAL + && true_expr->value.conditional.condition == nullptr; + false_expr_is_nil = false_expr->expr_type == EXPR_CONDITIONAL + && false_expr->value.conditional.condition == nullptr; + if (true_expr_is_nil && false_expr_is_nil) + { + gfc_error ("Both operands of the conditional argument at %L are .NIL.", + &expr->where); + return false; + } + if (!gfc_resolve_expr (condition) || !gfc_resolve_expr (true_expr) || !gfc_resolve_expr (false_expr)) return false; @@ -5034,7 +5060,8 @@ resolve_conditional (gfc_expr *expr) return false; } - if (true_expr->ts.type != false_expr->ts.type) + if (!true_expr_is_nil && !false_expr_is_nil + && true_expr->ts.type != false_expr->ts.type) { gfc_error ("expr at %L and expr at %L in conditional expression " "must have the same declared type", @@ -5042,7 +5069,8 @@ resolve_conditional (gfc_expr *expr) return false; } - if (true_expr->ts.kind != false_expr->ts.kind) + if (!true_expr_is_nil && !false_expr_is_nil + && true_expr->ts.kind != false_expr->ts.kind) { gfc_error ("expr at %L and expr at %L in conditional expression " "must have the same kind parameter", @@ -5050,7 +5078,8 @@ resolve_conditional (gfc_expr *expr) return false; } - if (true_expr->rank != false_expr->rank) + if (!true_expr_is_nil && !false_expr_is_nil + && true_expr->rank != false_expr->rank) { gfc_error ("expr at %L and expr at %L in conditional expression " "must have the same rank", @@ -5058,10 +5087,13 @@ resolve_conditional (gfc_expr *expr) return false; } + non_nil_ts = false_expr_is_nil ? true_expr->ts : false_expr->ts; + non_nil_rank = false_expr_is_nil ? true_expr->rank : false_expr->rank; + /* TODO: support more data types for conditional expressions */ - if (true_expr->ts.type != BT_INTEGER && true_expr->ts.type != BT_LOGICAL - && true_expr->ts.type != BT_REAL && true_expr->ts.type != BT_COMPLEX - && true_expr->ts.type != BT_CHARACTER) + if (non_nil_ts.type != BT_INTEGER && non_nil_ts.type != BT_LOGICAL + && non_nil_ts.type != BT_REAL && non_nil_ts.type != BT_COMPLEX + && non_nil_ts.type != BT_CHARACTER) { gfc_error ( "Sorry, only integer, logical, real, complex and character types are " @@ -5071,7 +5103,7 @@ resolve_conditional (gfc_expr *expr) } /* TODO: support arrays in conditional expressions */ - if (true_expr->rank > 0) + if (non_nil_rank > 0) { gfc_error ("Sorry, array is currently unsupported for conditional " "expressions at %L", @@ -5079,8 +5111,8 @@ resolve_conditional (gfc_expr *expr) return false; } - expr->ts = true_expr->ts; - expr->rank = true_expr->rank; + expr->ts = non_nil_ts; + expr->rank = non_nil_rank; return true; } @@ -8113,7 +8145,7 @@ gfc_resolve_expr (gfc_expr *e) actual_arg_save = actual_arg; first_actual_arg_save = first_actual_arg; - if (e->expr_type != EXPR_VARIABLE) + if (e->expr_type != EXPR_VARIABLE && e->expr_type != EXPR_CONDITIONAL) { inquiry_argument = false; actual_arg = false; diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index e2b17a725be..b7ba2ee56ce 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -12770,6 +12770,9 @@ gfc_walk_conditional_expr (gfc_ss *ss, gfc_expr *expr) { gfc_ss *head; + if (!expr->value.conditional.condition) + return gfc_ss_terminator; + head = gfc_walk_subexpr (ss, expr->value.conditional.true_expr); head = gfc_walk_subexpr (head, expr->value.conditional.false_expr); return head; diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 21f256b280f..a5c047db3ac 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -4375,6 +4375,12 @@ gfc_conv_conditional_expr (gfc_se *se, gfc_expr *expr) tree condition, true_val, false_val; tree type; + if (!expr->value.conditional.condition) + { + se->expr = build_empty_stmt (input_location); + return; + } + gfc_init_se (&cond_se, se); gfc_init_se (&true_se, se); gfc_init_se (&false_se, se); diff --git a/gcc/testsuite/gfortran.dg/conditional_10.f90 b/gcc/testsuite/gfortran.dg/conditional_10.f90 new file mode 100644 index 00000000000..3b4d6da7762 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/conditional_10.f90 @@ -0,0 +1,21 @@ +! { dg-do run } +! { dg-options "-std=f2023" } +program conditional_nil + implicit none + integer :: a = 4 + integer :: b = 6 + + call five((a < 5 ? a : .NIL.)) + if (a /= 5) stop 1 + call five((a == 5 ? .NIL. : a)) + if (a /= 5) stop 2 + call five((a /= 5 ? .NIL. : b > 5 ? b : .NIL.)) + if (b /= 5) stop 3 +contains + subroutine five(x) + integer, optional :: x + if (present(x)) then + x = 5 + end if + end subroutine five +end program conditional_nil diff --git a/gcc/testsuite/gfortran.dg/conditional_11.f90 b/gcc/testsuite/gfortran.dg/conditional_11.f90 new file mode 100644 index 00000000000..344b13ab3d1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/conditional_11.f90 @@ -0,0 +1,15 @@ +! { dg-do compile } +! { dg-options "-std=f2023" } +program conditional_nil_resolve + implicit none + integer :: i = 42 + + i = (i > 0 ? 1 : .nil.) ! { dg-error "is only valid in conditional arguments" } + i = (i > 0 ? .nil. : .nil.) ! { dg-error "Both operands of the conditional argument at" } + call five((i < 5 ? i : i > 43 ? i : .nil.)) ! { dg-error "Dummy argument is not optional, .NIL. at" } +contains + subroutine five(x) + integer :: x + x = 5 + end subroutine five +end program conditional_nil_resolve -- 2.43.0
