diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 42 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/intent_out_6.f90 | 39 |
4 files changed, 79 insertions, 13 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 323bd43..90df7a4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -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 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 7eddbd4..8255bb1 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -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); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 6e3a9d8..363e9cb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -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. diff --git a/gcc/testsuite/gfortran.dg/intent_out_6.f90 b/gcc/testsuite/gfortran.dg/intent_out_6.f90 new file mode 100644 index 0000000..1a41107 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/intent_out_6.f90 @@ -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" } } |