Backported from mainline

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

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 3d4a52a..86de8ab 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2223,7 +2223,7 @@ gfc_init_loopinfo (gfc_loopinfo * loop)
   for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
     {
       loop->order[n] = n;
-      loop->reverse[n] = GFC_CANNOT_REVERSE;
+      loop->reverse[n] = GFC_INHIBIT_REVERSE;
     }
 
   loop->ss = gfc_ss_terminator;
@@ -4490,7 +4490,7 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr)
   gfc_se se;
   HOST_WIDE_INT hi;
   unsigned HOST_WIDE_INT lo;
-  tree index;
+  tree index, range;
   VEC(constructor_elt,gc) *v = NULL;
 
   switch (expr->expr_type)
@@ -4544,28 +4544,56 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr)
           else
             index = NULL_TREE;
 
+         if (mpz_cmp_si (c->repeat, 1) > 0)
+           {
+             tree tmp1, tmp2;
+             mpz_t maxval;
+
+             mpz_init (maxval);
+             mpz_add (maxval, c->offset, c->repeat);
+             mpz_sub_ui (maxval, maxval, 1);
+             tmp2 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind);
+             if (mpz_cmp_si (c->offset, 0) != 0)
+               {
+                 mpz_add_ui (maxval, c->offset, 1);
+                 tmp1 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind);
+               }
+             else
+               tmp1 = gfc_conv_mpz_to_tree (c->offset, gfc_index_integer_kind);
+
+             range = fold_build2 (RANGE_EXPR, gfc_array_index_type, tmp1, tmp2);
+             mpz_clear (maxval);
+           }
+         else
+           range = NULL;
+
           gfc_init_se (&se, NULL);
          switch (c->expr->expr_type)
            {
            case EXPR_CONSTANT:
              gfc_conv_constant (&se, c->expr);
-             CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
              break;
 
            case EXPR_STRUCTURE:
               gfc_conv_structure (&se, c->expr, 1);
-             CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
              break;
 
-
            default:
              /* Catch those occasional beasts that do not simplify
                 for one reason or another, assuming that if they are
                 standard defying the frontend will catch them.  */
              gfc_conv_expr (&se, c->expr);
-             CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
              break;
            }
+
+         if (range == NULL_TREE)
+           CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
+         else
+           {
+             if (index != NULL_TREE)
+               CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
+             CONSTRUCTOR_APPEND_ELT (v, range, se.expr);
+           }
         }
       break;
 
@@ -5669,7 +5697,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
 
       lse.string_length = rse.string_length;
       tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, true,
-                                    expr->expr_type == EXPR_VARIABLE, true);
+                                    expr->expr_type == EXPR_VARIABLE
+                                    || expr->expr_type == EXPR_ARRAY, true);
       gfc_add_expr_to_block (&block, tmp);
 
       /* Finish the copying loops.  */
@@ -6520,18 +6549,22 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
       switch (purpose)
        {
        case DEALLOCATE_ALLOC_COMP:
+         if (cmp_has_alloc_comps && !c->attr.pointer)
+           {
+             /* Do not deallocate the components of ultimate pointer
+                components.  */
+             comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+                                     decl, cdecl, NULL_TREE);
+             rank = c->as ? c->as->rank : 0;
+             tmp = structure_alloc_comps (c->ts.u.derived, comp, NULL_TREE,
+                                          rank, purpose);
+             gfc_add_expr_to_block (&fnblock, tmp);
+           }
+
          if (c->attr.allocatable && c->attr.dimension)
            {
              comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
                                      decl, cdecl, NULL_TREE);
-             if (cmp_has_alloc_comps && !c->attr.pointer)
-               {
-                 /* Do not deallocate the components of ultimate pointer
-                    components.  */
-                 tmp = structure_alloc_comps (c->ts.u.derived, comp, NULL_TREE,
-                                              c->as->rank, purpose);
-                 gfc_add_expr_to_block (&fnblock, tmp);
-               }
              tmp = gfc_trans_dealloc_allocated (comp);
              gfc_add_expr_to_block (&fnblock, tmp);
            }