summaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>2009-10-02 16:25:50 +0000
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>2009-10-02 16:25:50 +0000
commitc38054a8342f5a4986bd11c16147aa6edae63bab (patch)
tree381e04543967b0b4c7519693b32c6643b41ff68d /gcc
parent16e43d96afb52c6fb8aaa449d562987862913699 (diff)
downloadgcc-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/ChangeLog8
-rw-r--r--gcc/fortran/trans-decl.c19
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/intent_out_5.f9027
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