diff options
| author | Tobias Burnus <burnus@net-b.de> | 2009-07-27 11:32:20 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2009-07-27 11:32:20 +0200 |
| commit | 758e12afc4e793135a7ac8b51693b62c1bb83939 (patch) | |
| tree | e88e7bef2170afcf8543b177e66227cb3215dc95 | |
| parent | d08d49885a1a07dd93fa036e37412324e8b710bf (diff) | |
| download | gcc-758e12afc4e793135a7ac8b51693b62c1bb83939.zip gcc-758e12afc4e793135a7ac8b51693b62c1bb83939.tar.gz gcc-758e12afc4e793135a7ac8b51693b62c1bb83939.tar.bz2 | |
re PR fortran/40851 ([4.3/4.4/4.5] problem with deallocation of pointers)
2009-07-26 Tobias Burnus <burnus@net-b.de>
PR fortran/40851
* resolve.c (resolve_symbol): Do not initialize pointer
* derived-types.
* trans-decl.c (init_intent_out_dt): Ditto.
(generate_local_decl): No need to set attr.referenced for DT pointers.
2009-07-26 Tobias Burnus <burnus@net-b.de>
PR fortran/40851
* gfortran.dg/derived_init_3.f90: New test.
From-SVN: r150108
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 4 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/derived_init_3.f90 | 34 |
5 files changed, 50 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ca320ca..91a45e9 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2009-07-27 Tobias Burnus <burnus@net-b.de> + + PR fortran/40851 + * resolve.c (resolve_symbol): Do not initialize pointer derived-types. + * trans-decl.c (init_intent_out_dt): Ditto. + (generate_local_decl): No need to set attr.referenced for DT pointers. + 2009-07-26 Tobias Burnus <burnus@net-b.de> PR fortran/33197 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index aaab554..053ec83 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10036,7 +10036,7 @@ resolve_symbol (gfc_symbol *sym) if ((!a->save && !a->dummy && !a->pointer && !a->in_common && !a->use_assoc && !(a->function && sym != sym->result)) - || (a->dummy && a->intent == INTENT_OUT)) + || (a->dummy && a->intent == INTENT_OUT && !a->pointer)) apply_default_init (sym); } diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index e4ac20f..65a6ac5 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2958,7 +2958,8 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body) gfc_init_block (&fnblock); for (f = proc_sym->formal; f; f = f->next) if (f->sym && f->sym->attr.intent == INTENT_OUT - && f->sym->ts.type == BT_DERIVED) + && !f->sym->attr.pointer + && f->sym->ts.type == BT_DERIVED) { if (f->sym->ts.derived->attr.alloc_comp) { @@ -3708,6 +3709,7 @@ generate_local_decl (gfc_symbol * sym) if (!sym->attr.referenced && sym->ts.type == BT_DERIVED && sym->ts.derived->attr.alloc_comp + && !sym->attr.pointer && ((sym->attr.dummy && sym->attr.intent == INTENT_OUT) || (sym->attr.result && sym != sym->result))) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f9bbf62..d136f43 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-07-27 Tobias Burnus <burnus@net-b.de> + + PR fortran/40851 + * gfortran.dg/derived_init_3.f90: New test. + 2009-07-26 Tobias Burnus <burnus@net-b.de> PR fortran/33197 diff --git a/gcc/testsuite/gfortran.dg/derived_init_3.f90 b/gcc/testsuite/gfortran.dg/derived_init_3.f90 new file mode 100644 index 0000000..a1c4a0c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/derived_init_3.f90 @@ -0,0 +1,34 @@ +! { dg-do run } +! +! PR fortran/40851 +! +! Make sure the an INTENT(OUT) dummy is not initialized +! when it is a pointer. +! +! Contributed by Juergen Reuter <juergen.reuter@desy.de>. +! +program main + + type :: string + character,dimension(:),allocatable :: chars + end type string + + type :: string_container + type(string) :: string + end type string_container + + type(string_container), target :: tgt + type(string_container), pointer :: ptr + + ptr => tgt + call set_ptr (ptr) + if (associated(ptr)) call abort() + +contains + + subroutine set_ptr (ptr) + type(string_container), pointer, intent(out) :: ptr + ptr => null () + end subroutine set_ptr + +end program main |