Fortran: Fix absent-optional handling for nondescriptor arrays (PR94672)
gcc/fortran/ChangeLog: PR fortran/94672 * trans-array.c (gfc_trans_g77_array): Check against the parm decl and set the nonparm decl used for the is-present check to NULL if absent. gcc/testsuite/ChangeLog: PR fortran/94672 * gfortran.dg/optional_assumed_charlen_2.f90: New test.
This commit is contained in:
parent
b648814c02
commit
cb3c3d6331
|
@ -6472,8 +6472,14 @@ gfc_trans_g77_array (gfc_symbol * sym, gfc_wrapped_block * block)
|
||||||
|
|
||||||
if (sym->attr.optional || sym->attr.not_always_present)
|
if (sym->attr.optional || sym->attr.not_always_present)
|
||||||
{
|
{
|
||||||
tmp = gfc_conv_expr_present (sym);
|
tree nullify;
|
||||||
stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt (input_location));
|
if (TREE_CODE (parm) != PARM_DECL)
|
||||||
|
nullify = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
|
||||||
|
parm, null_pointer_node);
|
||||||
|
else
|
||||||
|
nullify = build_empty_stmt (input_location);
|
||||||
|
tmp = gfc_conv_expr_present (sym, true);
|
||||||
|
stmt = build3_v (COND_EXPR, tmp, stmt, nullify);
|
||||||
}
|
}
|
||||||
|
|
||||||
gfc_add_init_cleanup (block, stmt, NULL_TREE);
|
gfc_add_init_cleanup (block, stmt, NULL_TREE);
|
||||||
|
|
|
@ -0,0 +1,48 @@
|
||||||
|
! { dg-do run }
|
||||||
|
! PR fortran/94672
|
||||||
|
!
|
||||||
|
! Contributed by Tomáš Trnka
|
||||||
|
!
|
||||||
|
module m
|
||||||
|
implicit none (type,external)
|
||||||
|
type t
|
||||||
|
integer :: i = 5
|
||||||
|
end type t
|
||||||
|
contains
|
||||||
|
subroutine bar(x, y, z, n)
|
||||||
|
integer, value :: n
|
||||||
|
type(t), intent(out), optional :: x(:), y(n), z(:)
|
||||||
|
allocatable :: z
|
||||||
|
end subroutine bar
|
||||||
|
|
||||||
|
subroutine foo (n, nFound, sVal)
|
||||||
|
integer, value :: n
|
||||||
|
integer, intent(out) :: nFound
|
||||||
|
character(*), optional, intent(out) :: sVal(n)
|
||||||
|
|
||||||
|
nFound = 0
|
||||||
|
|
||||||
|
if (present(sVal)) then
|
||||||
|
nFound = nFound + 1
|
||||||
|
end if
|
||||||
|
end subroutine
|
||||||
|
end
|
||||||
|
|
||||||
|
use m
|
||||||
|
implicit none (type,external)
|
||||||
|
type(t) :: a(7), b(7), c(:)
|
||||||
|
allocatable :: c
|
||||||
|
integer :: nn, nf
|
||||||
|
character(len=4) :: str
|
||||||
|
|
||||||
|
allocate(c(7))
|
||||||
|
call bar(a,b,c,7)
|
||||||
|
if (any(a(:)%i /= 5)) stop 1
|
||||||
|
if (any(b(:)%i /= 5)) stop 2
|
||||||
|
if (allocated(c)) stop 3
|
||||||
|
|
||||||
|
call foo(7, nf, str)
|
||||||
|
if (nf /= 1) stop 4
|
||||||
|
call foo(7, nf)
|
||||||
|
if (nf /= 0) stop 5
|
||||||
|
end
|
Loading…
Reference in New Issue