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.
This commit is contained in:
Yuao Ma
2025-11-13 22:50:28 +08:00
committed by c8ef
parent 7a5a92a643
commit 14e5e4ee1f
2 changed files with 58 additions and 4 deletions

View File

@@ -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);
}

View File

@@ -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