https://gcc.gnu.org/g:14e5e4ee1ff4aa499eb036a950e1695351bc0e2e
commit r16-5282-g14e5e4ee1ff4aa499eb036a950e1695351bc0e2e Author: Yuao Ma <[email protected]> Date: Thu Nov 13 22:50:28 2025 +0800 fortran: correctly handle optional allocatable dummy arguments This patch fixes a regression introduced in r14-8400-g186ae6d2cb93ad. gcc/fortran/ChangeLog: * trans-expr.cc (conv_dummy_value): Add check for NULL allocatable. gcc/testsuite/ChangeLog: * gfortran.dg/value_optional_3.f90: New test. Diff: --- gcc/fortran/trans-expr.cc | 11 ++++-- gcc/testsuite/gfortran.dg/value_optional_3.f90 | 51 ++++++++++++++++++++++++++ 2 files changed, 58 insertions(+), 4 deletions(-) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index b87c935a7031..ac85b762c7fe 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6696,11 +6696,14 @@ conv_dummy_value (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym, argse.want_pointer = 1; gfc_conv_expr (&argse, e); cond = fold_convert (TREE_TYPE (argse.expr), null_pointer_node); - cond = fold_build2_loc (input_location, NE_EXPR, - logical_type_node, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, argse.expr, cond); - vec_safe_push (optionalargs, - fold_convert (boolean_type_node, cond)); + if (e->symtree->n.sym->attr.dummy) + cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, + logical_type_node, + gfc_conv_expr_present (e->symtree->n.sym), + cond); + vec_safe_push (optionalargs, fold_convert (boolean_type_node, cond)); /* Create "conditional temporary". */ conv_cond_temp (parmse, e, cond); } diff --git a/gcc/testsuite/gfortran.dg/value_optional_3.f90 b/gcc/testsuite/gfortran.dg/value_optional_3.f90 new file mode 100644 index 000000000000..58464f9ed2e7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/value_optional_3.f90 @@ -0,0 +1,51 @@ +! { dg-do run } + +module m + implicit none(type, external) + + logical :: is_present + logical :: is_allocated + integer :: has_value + +contains + + subroutine test(a) + integer, allocatable :: a + call sub_val(a) + end subroutine test + + subroutine test2(a) + integer, allocatable, optional :: a + call sub_val(a) + end subroutine test2 + + subroutine sub_val(x) + integer, optional, value :: x + if (present(x) .neqv. (is_present .and. is_allocated)) stop 1 + if (present(x)) then + if (x /= has_value) stop 2 + end if + end subroutine sub_val + +end module m + +use m +implicit none(type, external) +integer, allocatable :: b + +is_allocated = .false. +is_present = .false. +call test2() + +is_present = .true. +call test(b) +call test2(b) + +b = 4 +is_allocated = .true. +has_value = b +call test(b) +call test2(b) +deallocate(b) + +end program
