Hi Tobias, On Tue, Nov 4, 2025 at 9:10 PM Tobias Burnus <[email protected]> wrote: > If you go for that route, I think we want to have a sorry > for the FIXME issues in expr-1 and those in expr-3. And for > the code in 'conv_dummy_value', I think a comment would be good > why that's called for conditional expr, possibly with a FIXME > about the missing bits. >
Thank you so much for the test cases! They've been really helpful - not only do they highlight some issues with the .NIL. implementation, but they've also uncovered some existing bugs in the current trunk. Rather than merging this with the risk of introducing new bugs, I plan to fix the current bugs first. The attached patch primarily focuses on fixing the problem exposed by cond-expr-3.f90, where dummy argument presence is not being identified correctly. It turns out that to handle this situation properly, we need to modify both gfc_conv_missing_dummy and conv_dummy_value. Specifically, in conv_dummy_value, simply forwarding the call to EXPR_VARIABLE isn't sufficient, so I've chosen a new approach in the patch. I've also slightly enhanced the test case so that it now tests all four combinations of value/reference. Regarding the implementation details, I'm not entirely sure about the current approach. I think the changes to conv_dummy_value are fine, but for gfc_conv_missing_dummy, the current recursive approach seems to have repeated preconditions - for example, we're checking whether the attr is optional both inside and outside the function body. Since this function is only called twice (once for user-defined functions and once for intrinsics), I think there might be a better design. I'd love to hear your thoughts on this. Finally, sorry for the late reply! It really took me some time to handle this correctly... I'll address pointers/allocators next. Yuao
From a02aca3bbacfd30e9e62c55d4e9ad7673c81bf4f Mon Sep 17 00:00:00 2001 From: Yuao Ma <[email protected]> Date: Mon, 10 Nov 2025 22:18:14 +0800 Subject: [PATCH] fortran: correctly handle optional dummy argument for value and reference gcc/fortran/ChangeLog: * trans-expr.cc (gfc_conv_missing_dummy): (conv_dummy_value): (gfc_conv_procedure_call): gcc/testsuite/ChangeLog: * gfortran.dg/conditional_10.f90: New test. --- gcc/fortran/trans-expr.cc | 84 +++++++++++++++++--- gcc/testsuite/gfortran.dg/conditional_10.f90 | 62 +++++++++++++++ 2 files changed, 134 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/conditional_10.f90 diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 2e88e65b6b8..d09b68e7521 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -2246,6 +2246,36 @@ gfc_conv_missing_dummy (gfc_se * se, gfc_expr * arg, gfc_typespec ts, int kind) tree present; tree tmp; + if (TREE_CODE (se->expr) == COND_EXPR) + { + tree cond = TREE_OPERAND (se->expr, 0); + tree lhs = TREE_OPERAND (se->expr, 1); + tree rhs = TREE_OPERAND (se->expr, 2); + + gfc_se lse, rse; + gfc_init_se (&lse, NULL); + gfc_init_se (&rse, NULL); + + lse.expr = lhs; + lse.string_length = se->string_length; + gfc_conv_missing_dummy (&lse, arg->value.conditional.true_expr, ts, kind); + gfc_add_block_to_block (&se->pre, &lse.pre); + + rse.expr = rhs; + rse.string_length = se->string_length; + gfc_conv_missing_dummy (&rse, arg->value.conditional.false_expr, ts, + kind); + gfc_add_block_to_block (&se->pre, &rse.pre); + + se->expr + = fold_build3_loc (input_location, COND_EXPR, TREE_TYPE (lse.expr), + cond, lse.expr, rse.expr); + return; + } + + if (!arg->symtree->n.sym->attr.optional) + return; + present = gfc_conv_expr_present (arg->symtree->n.sym); if (kind > 0) @@ -6704,6 +6734,36 @@ conv_dummy_value (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym, /* Create "conditional temporary". */ conv_cond_temp (parmse, e, cond); } + else if (e->expr_type == EXPR_CONDITIONAL) + { + tree cond = TREE_OPERAND (parmse->expr, 0); + tree lhs = TREE_OPERAND (parmse->expr, 1); + tree rhs = TREE_OPERAND (parmse->expr, 2); + + gfc_se lse, rse; + gfc_init_se (&lse, NULL); + gfc_init_se (&rse, NULL); + + lse.expr = lhs; + lse.string_length = parmse->string_length; + vec<tree, va_gc> *true_vec = NULL; + vec_alloc (true_vec, 1); + conv_dummy_value (&lse, e->value.conditional.true_expr, fsym, + true_vec); + gfc_add_block_to_block (&parmse->pre, &lse.pre); + + rse.expr = rhs; + rse.string_length = parmse->string_length; + vec<tree, va_gc> *false_vec = NULL; + vec_alloc (false_vec, 1); + conv_dummy_value (&lse, e->value.conditional.false_expr, fsym, + false_vec); + gfc_add_block_to_block (&parmse->pre, &rse.pre); + + cond = fold_build3_loc (input_location, COND_EXPR, boolean_type_node, + cond, (*true_vec)[0], (*false_vec)[0]); + vec_safe_push (optionalargs, fold_convert (boolean_type_node, cond)); + } else if (e->expr_type != EXPR_VARIABLE || !e->symtree->n.sym->attr.optional || (e->ref != NULL && e->ref->type != REF_ARRAY)) @@ -7998,18 +8058,18 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, Also, it is necessary to pass a NULL pointer to library routines which usually ignore optional arguments, so they can handle these themselves. */ - if (e->expr_type == EXPR_VARIABLE - && e->symtree->n.sym->attr.optional - && (((e->rank != 0 && elemental_proc) - || e->representation.length || e->ts.type == BT_CHARACTER - || (e->rank == 0 && e->symtree->n.sym->attr.value) - || (e->rank != 0 - && (fsym == NULL - || (fsym->as - && (fsym->as->type == AS_ASSUMED_SHAPE - || fsym->as->type == AS_ASSUMED_RANK - || fsym->as->type == AS_DEFERRED))))) - || se->ignore_optional)) + if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.optional + && (((e->rank != 0 && elemental_proc) + || e->representation.length || e->ts.type == BT_CHARACTER + || (e->rank == 0 && e->symtree->n.sym->attr.value) + || (e->rank != 0 + && (fsym == NULL + || (fsym->as + && (fsym->as->type == AS_ASSUMED_SHAPE + || fsym->as->type == AS_ASSUMED_RANK + || fsym->as->type == AS_DEFERRED))))) + || se->ignore_optional) + || e->expr_type == EXPR_CONDITIONAL) gfc_conv_missing_dummy (&parmse, e, fsym ? fsym->ts : e->ts, e->representation.length); } diff --git a/gcc/testsuite/gfortran.dg/conditional_10.f90 b/gcc/testsuite/gfortran.dg/conditional_10.f90 new file mode 100644 index 00000000000..a6f5360db53 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/conditional_10.f90 @@ -0,0 +1,62 @@ +! { dg-do run } +! { dg-options "-std=f2023" } + +module m + implicit none(type, external) + logical :: is_present + integer :: has_value +contains + subroutine test(a, c, cond) + integer, value, optional :: a, c + logical, value :: cond + call sub((cond ? a : c)) + call sub_val((cond ? a : c)) + end subroutine test + + subroutine test_val(a, c, cond) + integer, value, optional :: a, c + logical, value :: cond + call sub((cond ? a : c)) + call sub_val((cond ? a : c)) + end subroutine test_val + + subroutine sub(x) + integer, optional :: x + if (present(x) .neqv. is_present) error stop + if (present(x)) then + if (x /= has_value) error stop + end if + end subroutine sub + + subroutine sub_val(x) + integer, optional, value :: x + if (present(x) .neqv. is_present) error stop + if (present(x)) then + if (x /= has_value) error stop + end if + end subroutine sub_val +end module m + +use m +implicit none(type, external) + +is_present = .false. +call test(cond=.true.) +call test(cond=.false.) +call test_val(cond=.true.) +call test_val(cond=.false.) + +is_present = .true. +has_value = 2 +call test(2, cond=.true.) ! OK +call test(c=2, cond=.false.) ! OK +call test_val(2, cond=.true.) ! OK +call test_val(c=2, cond=.false.) ! OK + +is_present = .false. +call test(c=4, cond=.true.) +call test(4, cond=.false.) +call test_val(c=4, cond=.true.) +call test_val(4, cond=.false.) + +end program -- 2.43.0
