mirror of
https://forge.sourceware.org/marek/gcc.git
synced 2026-02-22 03:47:02 -05:00
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:
@@ -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);
|
||||
}
|
||||
|
||||
51
gcc/testsuite/gfortran.dg/value_optional_3.f90
Normal file
51
gcc/testsuite/gfortran.dg/value_optional_3.f90
Normal 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
|
||||
Reference in New Issue
Block a user