gcc/fortran/:

[pf3gnuchains/gcc-fork.git] / gcc / fortran / trans-array.c

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 1f6021a..8ece643 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -80,7 +80,10 @@ along with GCC; see the file COPYING3.  If not see
 #include "system.h"
 #include "coretypes.h"
 #include "tree.h"
+#include "gimple.h"
+#include "ggc.h"
 #include "toplev.h"
+#include "real.h"
 #include "flags.h"
 #include "gfortran.h"
 #include "constructor.h"
@@ -1305,13 +1308,14 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
          else
            {
              /* Collect multiple scalar constants into a constructor.  */
-             VEC(constructor_elt,gc) *v = NULL;
+             tree list;
              tree init;
              tree bound;
              tree tmptype;
              HOST_WIDE_INT idx = 0;
 
              p = c;
+             list = NULL_TREE;
               /* Count the number of consecutive scalar constants.  */
              while (p && !(p->iterator
                            || p->expr->expr_type != EXPR_CONSTANT))
@@ -1328,10 +1332,8 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
                                (gfc_get_pchar_type (p->expr->ts.kind),
                                 se.expr);
 
-                  CONSTRUCTOR_APPEND_ELT (v,
-                                          build_int_cst (gfc_array_index_type,
-                                                         idx++),
-                                          se.expr);
+                 list = tree_cons (build_int_cst (gfc_array_index_type,
+                                                  idx++), se.expr, list);
                  c = p;
                  p = gfc_constructor_next (p);
                }
@@ -1342,7 +1344,7 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
                                          gfc_index_zero_node, bound);
              tmptype = build_array_type (type, tmptype);
 
-             init = build_constructor (tmptype, v);
+             init = build_constructor_from_list (tmptype, nreverse (list));
              TREE_CONSTANT (init) = 1;
              TREE_STATIC (init) = 1;
              /* Create a static variable to hold the data.  */
@@ -1669,17 +1671,17 @@ gfc_constant_array_constructor_p (gfc_constructor_base base)
 tree
 gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
 {
-  tree tmptype, init, tmp;
+  tree tmptype, list, init, tmp;
   HOST_WIDE_INT nelem;
   gfc_constructor *c;
   gfc_array_spec as;
   gfc_se se;
   int i;
-  VEC(constructor_elt,gc) *v = NULL;
 
   /* First traverse the constructor list, converting the constants
      to tree to build an initializer.  */
   nelem = 0;
+  list = NULL_TREE;
   c = gfc_constructor_first (expr->value.constructor);
   while (c)
     {
@@ -1690,8 +1692,8 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
       else if (POINTER_TYPE_P (type))
        se.expr = gfc_build_addr_expr (gfc_get_pchar_type (c->expr->ts.kind),
                                       se.expr);
-      CONSTRUCTOR_APPEND_ELT (v, build_int_cst (gfc_array_index_type, nelem),
-                              se.expr);
+      list = tree_cons (build_int_cst (gfc_array_index_type, nelem),
+                       se.expr, list);
       c = gfc_constructor_next (c);
       nelem++;
     }
@@ -1721,7 +1723,7 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
 
   tmptype = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC, true);
 
-  init = build_constructor (tmptype, v);
+  init = build_constructor_from_list (tmptype, nreverse (list));
 
   TREE_CONSTANT (init) = 1;
   TREE_STATIC (init) = 1;
@@ -5265,6 +5267,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       gfc_trans_scalarizing_loops (&loop, &block);
 
       desc = loop.temp_ss->data.info.descriptor;
+
+      gcc_assert (is_gimple_lvalue (desc));
     }
   else if (expr->expr_type == EXPR_FUNCTION)
     {
@@ -6218,6 +6222,25 @@ gfc_copy_only_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank)
 }
 
 
+/* Check for default initializer; sym->value is not enough as it is also
+   set for EXPR_NULL of allocatables.  */
+
+static bool
+has_default_initializer (gfc_symbol *der)
+{
+  gfc_component *c;
+
+  gcc_assert (der->attr.flavor == FL_DERIVED);
+  for (c = der->components; c; c = c->next)
+    if ((c->ts.type != BT_DERIVED && c->initializer)
+        || (c->ts.type == BT_DERIVED
+            && (!c->attr.pointer && has_default_initializer (c->ts.u.derived))))
+      break;
+
+  return c != NULL;
+}
+
+
 /* NULLIFY an allocatable/pointer array on function entry, free it on exit.
    Do likewise, recursively if necessary, with the allocatable components of
    derived types.  */
@@ -6284,8 +6307,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
       if (!sym->attr.save
          && !(TREE_STATIC (sym->backend_decl) && sym->attr.is_main_program))
        {
-         if (sym->value == NULL
-             || !gfc_has_default_initializer (sym->ts.u.derived))
+         if (sym->value == NULL || !has_default_initializer (sym->ts.u.derived))
            {
              rank = sym->as ? sym->as->rank : 0;
              tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, descriptor, rank);