re PR fortran/21625 ([4.0 only] Nested derived type pointer component not initialized...

	PR fortran/21625
	* resolve.c (expr_to_initialize): New function.
	(resolve_allocate_expr): Take current statement as new
	argument. Add default initializers to variables of
	derived types, if they need it.
	(resolve_code): Provide current statement as argument to
	resolve_allocate_expr().

From-SVN: r105642

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 169f49086d9ce3077f986265a428bef922b07616..fb776002194ca16b16d66549234386f72104ee41 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2005-10-20  Erik Edelmann  <erik.edelmann@iki.fi>
+
+       PR fortran/21625
+       * resolve.c (expr_to_initialize): New function.
+       (resolve_allocate_expr): Take current statement as new 
+       argument. Add default initializers to variables of
+       derived types, if they need it.
+       (resolve_code): Provide current statement as argument to
+       resolve_allocate_expr().
+
 2005-10-19  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/24440

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index de74f269bc0ab1b312688899267ff78935a3cbe2..26f11c50583d506b5bb09b74403e2adb5a8d4da9 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2609,17 +2609,49 @@ resolve_deallocate_expr (gfc_expr * e)
 }
 
 
+/* Given the expression node e for an allocatable/pointer of derived type to be
+   allocated, get the expression node to be initialized afterwards (needed for
+   derived types with default initializers).  */
+
+static gfc_expr *
+expr_to_initialize (gfc_expr * e)
+{
+  gfc_expr *result;
+  gfc_ref *ref;
+  int i;
+
+  result = gfc_copy_expr (e);
+
+  /* Change the last array reference from AR_ELEMENT to AR_FULL.  */
+  for (ref = result->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->next == NULL)
+      {
+        ref->u.ar.type = AR_FULL;
+
+        for (i = 0; i < ref->u.ar.dimen; i++)
+          ref->u.ar.start[i] = ref->u.ar.end[i] = ref->u.ar.stride[i] = NULL;
+
+        result->rank = ref->u.ar.dimen; 
+        break;
+      }
+
+  return result;
+}
+
+
 /* Resolve the expression in an ALLOCATE statement, doing the additional
    checks to see whether the expression is OK or not.  The expression must
    have a trailing array reference that gives the size of the array.  */
 
 static try
-resolve_allocate_expr (gfc_expr * e)
+resolve_allocate_expr (gfc_expr * e, gfc_code * code)
 {
   int i, pointer, allocatable, dimension;
   symbol_attribute attr;
   gfc_ref *ref, *ref2;
   gfc_array_ref *ar;
+  gfc_code *init_st;
+  gfc_expr *init_e;
 
   if (gfc_resolve_expr (e) == FAILURE)
     return FAILURE;
@@ -2674,6 +2706,19 @@ resolve_allocate_expr (gfc_expr * e)
       return FAILURE;
     }
 
+  /* Add default initializer for those derived types that need them.  */
+  if (e->ts.type == BT_DERIVED && (init_e = gfc_default_initializer (&e->ts)))
+    {
+        init_st = gfc_get_code ();
+        init_st->loc = code->loc;
+        init_st->op = EXEC_ASSIGN;
+        init_st->expr = expr_to_initialize (e);
+        init_st->expr2 = init_e;
+
+        init_st->next = code->next;
+        code->next = init_st;
+    }
+
   if (pointer && dimension == 0)
     return SUCCESS;
 
@@ -4022,7 +4067,7 @@ resolve_code (gfc_code * code, gfc_namespace * ns)
                       "of type INTEGER", &code->expr->where);
 
          for (a = code->ext.alloc_list; a; a = a->next)
-           resolve_allocate_expr (a->expr);
+           resolve_allocate_expr (a->expr, code);
 
          break;