diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 15 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/missing_optional_dummy_6.f90 | 60 |
4 files changed, 80 insertions, 6 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 717ffa0..8fc1175 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2009-11-03 Tobias Burnus <burnus@net-b.de> + + PR fortran/41907 + * trans-expr.c (gfc_conv_procedure_call): Fix presence check + for optional arguments. + 2009-11-01 Tobias Burnus <burnus@net-b.de> PR fortran/41872 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index d8f8303..5a45f4f 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2998,16 +2998,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, 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. */ + When passing a non-array-descriptor full array to a + non-array-descriptor dummy, no check is needed. For + array-descriptor actual to array-descriptor dummy, see + PR 41911 for why a check has to be inserted. + fsym == NULL is checked as intrinsics required the descriptor + but do not always set fsym. */ if (e->expr_type == EXPR_VARIABLE && 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))))) + || (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 32e07cc..859b5f1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-11-03 Tobias Burnus <burnus@net-b.de> + + PR fortran/41907 + * gfortran.dg/missing_optional_dummy_6.f90: New test. + 2009-11-03 Nick Clifton <nickc@redhat.com> * gcc.target/rx/builtins,c: Remove redundant tests. diff --git a/gcc/testsuite/gfortran.dg/missing_optional_dummy_6.f90 b/gcc/testsuite/gfortran.dg/missing_optional_dummy_6.f90 new file mode 100644 index 0000000..4085822 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/missing_optional_dummy_6.f90 @@ -0,0 +1,60 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/41907 +! +program test + implicit none + call scalar1 () + call assumed_shape1 () + call explicit_shape1 () +contains + + ! Calling functions + subroutine scalar1 (slr1) + integer, optional :: slr1 + call scalar2 (slr1) + end subroutine scalar1 + + subroutine assumed_shape1 (as1) + integer, dimension(:), optional :: as1 + call assumed_shape2 (as1) + call explicit_shape2 (as1) + end subroutine assumed_shape1 + + subroutine explicit_shape1 (es1) + integer, dimension(5), optional :: es1 + call assumed_shape2 (es1) + call explicit_shape2 (es1) + end subroutine explicit_shape1 + + + ! Called functions + subroutine assumed_shape2 (as2) + integer, dimension(:),optional :: as2 + if (present (as2)) call abort() + end subroutine assumed_shape2 + + subroutine explicit_shape2 (es2) + integer, dimension(5),optional :: es2 + if (present (es2)) call abort() + end subroutine explicit_shape2 + + subroutine scalar2 (slr2) + integer, optional :: slr2 + if (present (slr2)) call abort() + end subroutine scalar2 + +end program test + +! { dg-final { scan-tree-dump-times "scalar2 \\(slr1" 1 "original" } } + +! { dg-final { scan-tree-dump-times "= es1 != 0B" 1 "original" } } +! { dg-final { scan-tree-dump-times "assumed_shape2 \\(es1" 0 "original" } } +! { dg-final { scan-tree-dump-times "explicit_shape2 \\(es1" 1 "original" } } + +! { dg-final { scan-tree-dump-times "= as1 != 0B" 2 "original" } } +! { dg-final { scan-tree-dump-times "assumed_shape2 \\(as1" 0 "original" } } +! { dg-final { scan-tree-dump-times "explicit_shape2 \\(as1" 0 "original" } } + +! { dg-final { cleanup-tree-dump "original" } } |