From ba6f7079726ba4b36c3c66dea28bf85202fa8386 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 2 Oct 2009 18:25:50 +0200 Subject: re PR fortran/41479 (intent(out) for types with default initialization) 2009-10-02 Tobias Burnus PR fortran/41479 * trans-decl.c (gfc_init_default_dt): Check for presence of the argument only if it is optional or in entry master. (init_intent_out_dt): Ditto; call gfc_init_default_dt for all derived types with initializers. 2009-10-02 Tobias Burnus PR fortran/41479 * gfortran.dg/intent_out_5.f90: New test. From-SVN: r152407 --- gcc/fortran/ChangeLog | 8 ++++++++ gcc/fortran/trans-decl.c | 19 +++++++++++-------- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/intent_out_5.f90 | 27 +++++++++++++++++++++++++++ 4 files changed, 51 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/intent_out_5.f90 (limited to 'gcc') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 55386ac..c325d25 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2009-10-02 Tobias Burnus + + PR fortran/41479 + * trans-decl.c (gfc_init_default_dt): Check for presence of + the argument only if it is optional or in entry master. + (init_intent_out_dt): Ditto; call gfc_init_default_dt + for all derived types with initializers. + 2009-10-01 Kaveh R. Ghazi PR fortran/33197 diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 3d6a5e2..ee38efb 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2991,7 +2991,8 @@ gfc_init_default_dt (gfc_symbol * sym, tree body) gfc_set_sym_referenced (sym); e = gfc_lval_expr_from_sym (sym); tmp = gfc_trans_assignment (e, sym->value, false); - if (sym->attr.dummy) + if (sym->attr.dummy && (sym->attr.optional + || sym->ns->proc_name->attr.entry_master)) { present = gfc_conv_expr_present (sym); tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present, @@ -3023,21 +3024,23 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body) && !f->sym->attr.pointer && f->sym->ts.type == BT_DERIVED) { - if (f->sym->ts.u.derived->attr.alloc_comp) + if (f->sym->ts.u.derived->attr.alloc_comp && !f->sym->value) { tmp = gfc_deallocate_alloc_comp (f->sym->ts.u.derived, f->sym->backend_decl, f->sym->as ? f->sym->as->rank : 0); - present = gfc_conv_expr_present (f->sym); - tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present, - tmp, build_empty_stmt (input_location)); + if (f->sym->attr.optional + || f->sym->ns->proc_name->attr.entry_master) + { + present = gfc_conv_expr_present (f->sym); + tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present, + tmp, build_empty_stmt (input_location)); + } gfc_add_expr_to_block (&fnblock, tmp); } - - if (!f->sym->ts.u.derived->attr.alloc_comp - && f->sym->value) + else if (f->sym->value) body = gfc_init_default_dt (f->sym, body); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4bbabcb..888064b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-10-02 Tobias Burnus + + PR fortran/41479 + * gfortran.dg/intent_out_5.f90: New test. + 2009-10-02 Jakub Jelinek PR debug/41404 diff --git a/gcc/testsuite/gfortran.dg/intent_out_5.f90 b/gcc/testsuite/gfortran.dg/intent_out_5.f90 new file mode 100644 index 0000000..acd2b60 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/intent_out_5.f90 @@ -0,0 +1,27 @@ +! { dg-do run} +! +! PR fortran/41479 +! +! Contributed by Juergen Reuter. +! +program main + type :: container_t + integer :: n = 42 + ! if the following line is omitted, the problem disappears + integer, dimension(:), allocatable :: a + end type container_t + + type(container_t) :: container + + if (container%n /= 42) call abort() + if (allocated(container%a)) call abort() + container%n = 1 + allocate(container%a(50)) + call init (container) + if (container%n /= 42) call abort() + if (allocated(container%a)) call abort() +contains + subroutine init (container) + type(container_t), intent(out) :: container + end subroutine init +end program main -- cgit v1.1