OSDN Git Service

2009-07-26 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 27 Jul 2009 09:32:20 +0000 (09:32 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 27 Jul 2009 09:32:20 +0000 (09:32 +0000)
        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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150108 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/resolve.c
gcc/fortran/trans-decl.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/derived_init_3.f90 [new file with mode: 0644]

index ca320ca..91a45e9 100644 (file)
@@ -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
index aaab554..053ec83 100644 (file)
@@ -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);
     }
 
index e4ac20f..65a6ac5 100644 (file)
@@ -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)))
index f9bbf62..d136f43 100644 (file)
@@ -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 (file)
index 0000000..a1c4a0c
--- /dev/null
@@ -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