2008-10-30 Mikael Morin <mikael.morin@tele2.fr>

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

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index c5aff65..5080e0f 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -595,9 +595,9 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
   for (dim = 0; dim < info->dimen; dim++)
     {
       n = loop->order[dim];
-      /* TODO: Investigate why "if (n < loop->temp_dim)
-        gcc_assert (integer_zerop (loop->from[n]));" fails here.  */
-      if (n >= loop->temp_dim)
+      if (n < loop->temp_dim)
+      gcc_assert (integer_zerop (loop->from[n]));
+      else
        {
          /* Callee allocated arrays may not have a known bound yet.  */
           if (loop->to[n])
@@ -642,9 +642,18 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
 
   or_expr = NULL_TREE;
 
+  /* If there is at least one null loop->to[n], it is a callee allocated 
+     array.  */
   for (n = 0; n < info->dimen; n++)
-    {
-      if (loop->to[n] == NULL_TREE)
+    if (loop->to[n] == NULL_TREE)
+      {
+       size = NULL_TREE;
+       break;
+      }
+
+  for (n = 0; n < info->dimen; n++)
+     {
+      if (size == NULL_TREE)
         {
          /* For a callee allocated array express the loop bounds in terms
             of the descriptor fields.  */
@@ -653,7 +662,6 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
                         gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]),
                         gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n]));
           loop->to[n] = tmp;
-          size = NULL_TREE;
           continue;
         }
         
@@ -1628,8 +1636,7 @@ gfc_trans_constant_array_constructor (gfc_loopinfo * loop,
 
   info->descriptor = tmp;
   info->data = build_fold_addr_expr (tmp);
-  info->offset = fold_build1 (NEGATE_EXPR, gfc_array_index_type,
-                             loop->from[0]);
+  info->offset = gfc_index_zero_node;
 
   for (i = 0; i < info->dimen; i++)
     {
@@ -1692,7 +1699,6 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
   tree offsetvar;
   tree desc;
   tree type;
-  tree loopfrom;
   bool dynamic;
   bool old_first_len, old_typespec_chararray_ctor;
   tree old_first_len_val;
@@ -1804,34 +1810,9 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
        }
     }
 
-  /* Temporarily reset the loop variables, so that the returned temporary
-     has the right size and bounds.  This seems only to be necessary for
-     1D arrays.  */
-  if (!integer_zerop (loop->from[0]) && loop->dimen == 1)
-    {
-      loopfrom = loop->from[0];
-      loop->from[0] = gfc_index_zero_node;
-      loop->to[0] = fold_build2 (MINUS_EXPR, gfc_array_index_type,
-                                loop->to[0], loopfrom);
-    }
-  else
-    loopfrom = NULL_TREE;
-
   gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info,
                               type, dynamic, true, false, where);
 
-  if (loopfrom != NULL_TREE)
-    {
-      loop->from[0] = loopfrom;
-      loop->to[0] = fold_build2 (PLUS_EXPR, gfc_array_index_type,
-                                loop->to[0], loopfrom);
-      /* In the case of a non-zero from, the temporary needs an offset
-        so that subsequent indexing is correct.  */
-      ss->data.info.offset = fold_build1 (NEGATE_EXPR,
-                                         gfc_array_index_type,
-                                         loop->from[0]);
-    }
-
   desc = ss->data.info.descriptor;
   offset = gfc_index_zero_node;
   offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
@@ -3379,7 +3360,10 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
          if (ss->shape)
            {
              /* The frontend has worked out the size for us.  */
-             loopspec[n] = ss;
+             if (!loopspec[n] || !loopspec[n]->shape
+                   || !integer_zerop (loopspec[n]->data.info.start[n]))
+               /* Prefer zero-based descriptors if possible.  */
+               loopspec[n] = ss;
              continue;
            }
 
@@ -3556,7 +3540,9 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
   /* Calculate the translation from loop variables to array indices.  */
   for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
     {
-      if (ss->type != GFC_SS_SECTION && ss->type != GFC_SS_COMPONENT)
+      if (ss->type != GFC_SS_SECTION && ss->type != GFC_SS_COMPONENT
+           && ss->type != GFC_SS_CONSTRUCTOR)
+
        continue;
 
       info = &ss->data.info;