re PR fortran/41850 (Wrong-code with optional allocatable arrays)
2009-11-01 Tobias Burnus <burnus@net-b.de> PR fortran/41850 * trans-expr.c (gfc_conv_procedure_call): Deallocate intent-out variables only when present. Remove unneccessary present check. 2009-11-01 Tobias Burnus <burnus@net-b.de> PR fortran/41850 * gfortran.dg/intent_out_6.f90: New testcase. From-SVN: r153793
This commit is contained in:
parent
164247b0e2
commit
745ff31ff7
|
@ -1,3 +1,9 @@
|
|||
2009-11-01 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/41850
|
||||
* trans-expr.c (gfc_conv_procedure_call): Deallocate intent-out
|
||||
variables only when present. Remove unneccessary present check.
|
||||
|
||||
2009-10-29 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/41777
|
||||
|
|
|
@ -2935,17 +2935,22 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
|||
gfc_conv_array_parameter (&parmse, e, argss, f, fsym,
|
||||
sym->name, NULL);
|
||||
|
||||
/* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
|
||||
allocated on entry, it must be deallocated. */
|
||||
if (fsym && fsym->attr.allocatable
|
||||
&& fsym->attr.intent == INTENT_OUT)
|
||||
{
|
||||
tmp = build_fold_indirect_ref_loc (input_location,
|
||||
parmse.expr);
|
||||
tmp = gfc_trans_dealloc_allocated (tmp);
|
||||
gfc_add_expr_to_block (&se->pre, tmp);
|
||||
}
|
||||
|
||||
/* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
|
||||
allocated on entry, it must be deallocated. */
|
||||
if (fsym && fsym->attr.allocatable
|
||||
&& fsym->attr.intent == INTENT_OUT)
|
||||
{
|
||||
tmp = build_fold_indirect_ref_loc (input_location,
|
||||
parmse.expr);
|
||||
tmp = gfc_trans_dealloc_allocated (tmp);
|
||||
if (fsym->attr.optional
|
||||
&& e->expr_type == EXPR_VARIABLE
|
||||
&& e->symtree->n.sym->attr.optional)
|
||||
tmp = fold_build3 (COND_EXPR, void_type_node,
|
||||
gfc_conv_expr_present (e->symtree->n.sym),
|
||||
tmp, build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (&se->pre, tmp);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -2957,9 +2962,20 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
|||
if (e && (fsym == NULL || fsym->attr.optional))
|
||||
{
|
||||
/* If an optional argument is itself an optional dummy argument,
|
||||
check its presence and substitute a null if absent. */
|
||||
check its presence and substitute a null if absent. This is
|
||||
only needed when passing an array to an elemental procedure
|
||||
as then array elements are accessed - or no NULL pointer is
|
||||
allowed and a "1" or "0" should be passed if not present.
|
||||
When passing a deferred array to a non-deferred array dummy,
|
||||
the array needs to be packed and a check needs thus to be
|
||||
inserted. */
|
||||
if (e->expr_type == EXPR_VARIABLE
|
||||
&& e->symtree->n.sym->attr.optional)
|
||||
&& e->symtree->n.sym->attr.optional
|
||||
&& ((e->rank > 0 && sym->attr.elemental)
|
||||
|| e->representation.length || e->ts.type == BT_CHARACTER
|
||||
|| (e->rank > 0 && (fsym == NULL
|
||||
|| (fsym->as->type != AS_ASSUMED_SHAPE
|
||||
&& fsym->as->type != AS_DEFERRED)))))
|
||||
gfc_conv_missing_dummy (&parmse, e, fsym ? fsym->ts : e->ts,
|
||||
e->representation.length);
|
||||
}
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2009-11-01 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/41850
|
||||
* gfortran.dg/intent_out_6.f90: New testcase.
|
||||
|
||||
2009-10-31 Richard Guenther <rguenther@suse.de>
|
||||
|
||||
* g++.dg/tree-ssa/restrict1.C: New.
|
||||
|
|
|
@ -0,0 +1,39 @@
|
|||
! { dg-do run }
|
||||
!
|
||||
! PR fortran/41850
|
||||
!
|
||||
module test_module
|
||||
implicit none
|
||||
contains
|
||||
subroutine sub2(a)
|
||||
implicit none
|
||||
real,allocatable,intent(out),optional :: a(:)
|
||||
if(present(a)) then
|
||||
if(allocated(a)) call abort()
|
||||
allocate(a(1))
|
||||
a(1) = 5
|
||||
end if
|
||||
end subroutine sub2
|
||||
subroutine sub1(a)
|
||||
implicit none
|
||||
real,allocatable,intent(out),optional :: a(:)
|
||||
! print *,'in sub1'
|
||||
call sub2(a)
|
||||
if(present(a)) then
|
||||
if(a(1) /= 5) call abort()
|
||||
end if
|
||||
end subroutine sub1
|
||||
end module test_module
|
||||
|
||||
program test
|
||||
use test_module
|
||||
implicit none
|
||||
real, allocatable :: x(:)
|
||||
allocate(x(1))
|
||||
call sub1()
|
||||
x = 8
|
||||
call sub1(x)
|
||||
if(x(1) /= 5) call abort()
|
||||
end program
|
||||
|
||||
! { dg-final { cleanup-modules "test_module" } }
|
Loading…
Reference in New Issue