diff options
author | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-10-02 16:25:50 +0000 |
---|---|---|
committer | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-10-02 16:25:50 +0000 |
commit | c38054a8342f5a4986bd11c16147aa6edae63bab (patch) | |
tree | 381e04543967b0b4c7519693b32c6643b41ff68d /gcc | |
parent | 16e43d96afb52c6fb8aaa449d562987862913699 (diff) | |
download | gcc-c38054a8342f5a4986bd11c16147aa6edae63bab.tar.gz |
2009-10-02 Tobias Burnus <burnus@net-b.de>
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 <burnus@net-b.de>
PR fortran/41479
* gfortran.dg/intent_out_5.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152407 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
-rw-r--r-- | gcc/fortran/trans-decl.c | 19 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/intent_out_5.f90 | 27 |
4 files changed, 51 insertions, 8 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 55386acffe0..c325d258ae8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2009-10-02 Tobias Burnus <burnus@net-b.de> + + 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 <ghazi@caip.rutgers.edu> PR fortran/33197 diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 3d6a5e2221c..ee38efbe27c 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 4bbabcb3fce..888064b3174 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-10-02 Tobias Burnus <burnus@net-b.de> + + PR fortran/41479 + * gfortran.dg/intent_out_5.f90: New test. + 2009-10-02 Jakub Jelinek <jakub@redhat.com> 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 00000000000..acd2b606525 --- /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 |