COMP/CMSDIST/gcc-4.6.1-fix-gfortran-regression.patch

Index: gcc/testsuite/gfortran.dg/pr49540-2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr49540-2.f90     (revision 0)
+++ gcc/testsuite/gfortran.dg/pr49540-2.f90     (revision 175827)
@@ -0,0 +1,17 @@
+! PR fortran/49540
+! { dg-do compile }
+! { dg-options "" }
+block data
+  common /a/ i(5,5)
+  data i /4, 23 * 5, 6/
+  data i(:,2) /1, 3 * 2, 3/
+  common /b/ j(5,5)
+  data j(2,:) /1, 3 * 2, 3/
+  data j /4, 23 * 5, 6/
+  common /c/ k(5,5)
+  data k(:,2) /1, 3 * 2, 3/
+  data k /4, 23 * 5, 6/
+  common /d/ l(5,5)
+  data l /4, 23 * 5, 6/
+  data l(2,:) /1, 3 * 2, 3/
+end block data
Index: gcc/testsuite/gfortran.dg/pr49540-1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr49540-1.f90     (revision 0)
+++ gcc/testsuite/gfortran.dg/pr49540-1.f90     (revision 175827)
@@ -0,0 +1,6 @@
+! PR fortran/49540
+! { dg-do compile }
+block data
+  common /a/ b(100000,100)
+  data b /10000000 * 0.0/
+end block data
Index: gcc/dwarf2out.c
===================================================================
--- gcc/dwarf2out.c     (revision 175826)
+++ gcc/dwarf2out.c     (revision 175827)
@@ -17118,7 +17118,7 @@
                {
                  int count = tree_low_cst (TREE_OPERAND (index, 1), 0)
                              - tree_low_cst (TREE_OPERAND (index, 0), 0);
-                 while (count > 0)
+                 while (count-- > 0)
                    {
                      if (val)
                        memcpy (array + curpos, array + pos, fieldsize);
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c   (revision 175826)
+++ gcc/fortran/trans-array.c   (revision 175827)
@@ -4490,7 +4490,7 @@
   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 @@
           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;
 
Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c (revision 175826)
+++ gcc/fortran/array.c (revision 175827)
@@ -1309,6 +1309,7 @@
 
   mpz_t *offset;
   gfc_component *component;
+  mpz_t *repeat;
 
   gfc_try (*expand_work_function) (gfc_expr *);
 }
@@ -1543,6 +1544,7 @@
          return FAILURE;
        }
       current_expand.offset = &c->offset;
+      current_expand.repeat = &c->repeat;
       current_expand.component = c->n.component;
       if (current_expand.expand_work_function (e) == FAILURE)
        return FAILURE;
Index: gcc/fortran/constructor.c
===================================================================
--- gcc/fortran/constructor.c   (revision 175826)
+++ gcc/fortran/constructor.c   (revision 175827)
@@ -1,5 +1,5 @@
 /* Array and structure constructors
-   Copyright (C) 2009, 2010
+   Copyright (C) 2009, 2010, 2011
    Free Software Foundation, Inc.
 
 This file is part of GCC.
@@ -36,6 +36,7 @@
     gfc_free_iterator (c->iterator, 1);
 
   mpz_clear (c->offset);
+  mpz_clear (c->repeat);
 
   gfc_free (c);
 }
@@ -54,6 +55,7 @@
   c->n.component = src->n.component;
 
   mpz_init_set (c->offset, src->offset);
+  mpz_init_set (c->repeat, src->repeat);
 
   return c;
 }
@@ -78,6 +80,7 @@
   c->iterator = NULL;
 
   mpz_init_set_si (c->offset, 0);
+  mpz_init_set_si (c->repeat, 1);
 
   return c;
 }
@@ -169,6 +172,7 @@
 gfc_constructor *
 gfc_constructor_lookup (gfc_constructor_base base, int offset)
 {
+  gfc_constructor *c;
   splay_tree_node node;
 
   if (!base)
@@ -176,9 +180,24 @@
 
   node = splay_tree_lookup (base, (splay_tree_key) offset);
   if (node)
-    return (gfc_constructor*) node->value;
+    return (gfc_constructor *) node->value;
 
-  return NULL;
+  /* Check if the previous node has a repeat count big enough to
+     cover the offset looked for.  */
+  node = splay_tree_predecessor (base, (splay_tree_key) offset);
+  if (!node)
+    return NULL;
+
+  c = (gfc_constructor *) node->value;
+  if (mpz_cmp_si (c->repeat, 1) > 0)
+    {
+      if (mpz_get_si (c->offset) + mpz_get_si (c->repeat) <= offset)
+       c = NULL;
+    }
+  else
+    c = NULL;
+
+  return c;
 }
 
 
@@ -232,3 +251,27 @@
   else
     return NULL;
 }
+
+
+void
+gfc_constructor_remove (gfc_constructor *ctor)
+{
+  if (ctor)
+    splay_tree_remove (ctor->base, mpz_get_si (ctor->offset));
+}
+
+
+gfc_constructor *
+gfc_constructor_lookup_next (gfc_constructor_base base, int offset)
+{
+  splay_tree_node node;
+
+  if (!base)
+    return NULL;
+
+  node = splay_tree_successor (base, (splay_tree_key) offset);
+  if (!node)
+    return NULL;
+
+  return (gfc_constructor *) node->value;
+}
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h      (revision 175826)
+++ gcc/fortran/gfortran.h      (revision 175827)
@@ -2264,6 +2264,8 @@
      gfc_component *component; /* Record the component being initialized.  */
   }
   n;
+  mpz_t repeat; /* Record the repeat number of initial values in data
+                 statement like "data a/5*10/".  */
 }
 gfc_constructor;
 
Index: gcc/fortran/constructor.h
===================================================================
--- gcc/fortran/constructor.h   (revision 175826)
+++ gcc/fortran/constructor.h   (revision 175827)
@@ -1,5 +1,5 @@
 /* Array and structure constructors
-   Copyright (C) 2009, 2010
+   Copyright (C) 2009, 2010, 2011
    Free Software Foundation, Inc.
 
 This file is part of GCC.
@@ -81,6 +81,10 @@
    Returns NULL if there is no next expression.  */
 gfc_constructor *gfc_constructor_next (gfc_constructor *ctor);
 
-gfc_constructor *gfc_constructor_advance (gfc_constructor *ctor, int n);
+/* Remove the gfc_constructor node from the splay tree.  */
+void gfc_constructor_remove (gfc_constructor *);
 
+/* Return first constructor node after offset.  */
+gfc_constructor *gfc_constructor_lookup_next (gfc_constructor_base, int);
+
 #endif /* GFC_CONSTRUCTOR_H */
Index: gcc/fortran/data.c
===================================================================
--- gcc/fortran/data.c  (revision 175826)
+++ gcc/fortran/data.c  (revision 175827)
@@ -1,5 +1,5 @@
 /* Supporting functions for resolving DATA statement.
-   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
    Free Software Foundation, Inc.
    Contributed by Lifang Zeng <zlf605@hotmail.com>
 
@@ -189,10 +189,13 @@
 
 /* Assign the initial value RVALUE to  LVALUE's symbol->value. If the
    LVALUE already has an initialization, we extend this, otherwise we
-   create a new one.  */
+   create a new one.  If REPEAT is non-NULL, initialize *REPEAT
+   consecutive values in LVALUE the same value in RVALUE.  In that case,
+   LVALUE must refer to a full array, not an array section.  */
 
 gfc_try
-gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
+gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
+                      mpz_t *repeat)
 {
   gfc_ref *ref;
   gfc_expr *init;
@@ -269,6 +272,100 @@
                         &lvalue->where);
              goto abort;
            }
+         else if (repeat != NULL
+                  && ref->u.ar.type != AR_ELEMENT)
+           {
+             mpz_t size, end;
+             gcc_assert (ref->u.ar.type == AR_FULL
+                         && ref->next == NULL);
+             mpz_init_set (end, offset);
+             mpz_add (end, end, *repeat);
+             if (spec_size (ref->u.ar.as, &size) == SUCCESS)
+               {
+                 if (mpz_cmp (end, size) > 0)
+                   {
+                     mpz_clear (size);
+                     gfc_error ("Data element above array upper bound at %L",
+                                &lvalue->where);
+                     goto abort;
+                   }
+                 mpz_clear (size);
+               }
+
+             con = gfc_constructor_lookup (expr->value.constructor,
+                                           mpz_get_si (offset));
+             if (!con)
+               {
+                 con = gfc_constructor_lookup_next (expr->value.constructor,
+                                                    mpz_get_si (offset));
+                 if (con != NULL && mpz_cmp (con->offset, end) >= 0)
+                   con = NULL;
+               }
+
+             /* Overwriting an existing initializer is non-standard but
+                usually only provokes a warning from other compilers.  */
+             if (con != NULL && con->expr != NULL)
+               {
+                 /* Order in which the expressions arrive here depends on
+                    whether they are from data statements or F95 style
+                    declarations.  Therefore, check which is the most
+                    recent.  */
+                 gfc_expr *exprd;
+                 exprd = (LOCATION_LINE (con->expr->where.lb->location)
+                          > LOCATION_LINE (rvalue->where.lb->location))
+                         ? con->expr : rvalue;
+                 if (gfc_notify_std (GFC_STD_GNU,"Extension: "
+                                     "re-initialization of '%s' at %L",
+                                     symbol->name, &exprd->where) == FAILURE)
+                   return FAILURE;
+               }
+
+             while (con != NULL)
+               {
+                 gfc_constructor *next_con = gfc_constructor_next (con);
+
+                 if (mpz_cmp (con->offset, end) >= 0)
+                   break;
+                 if (mpz_cmp (con->offset, offset) < 0)
+                   {
+                     gcc_assert (mpz_cmp_si (con->repeat, 1) > 0);
+                     mpz_sub (con->repeat, offset, con->offset);
+                   }
+                 else if (mpz_cmp_si (con->repeat, 1) > 0
+                          && mpz_get_si (con->offset)
+                             + mpz_get_si (con->repeat) > mpz_get_si (end))
+                   {
+                     int endi;
+                     splay_tree_node node
+                       = splay_tree_lookup (con->base,
+                                            mpz_get_si (con->offset));
+                     gcc_assert (node
+                                 && con == (gfc_constructor *) node->value
+                                 && node->key == (splay_tree_key)
+                                                 mpz_get_si (con->offset));
+                     endi = mpz_get_si (con->offset)
+                            + mpz_get_si (con->repeat);
+                     if (endi > mpz_get_si (end) + 1)
+                       mpz_set_si (con->repeat, endi - mpz_get_si (end));
+                     else
+                       mpz_set_si (con->repeat, 1);
+                     mpz_set (con->offset, end);
+                     node->key = (splay_tree_key) mpz_get_si (end);
+                     break;
+                   }
+                 else
+                   gfc_constructor_remove (con);
+                 con = next_con;
+               }
+
+             con = gfc_constructor_insert_expr (&expr->value.constructor,
+                                                NULL, &rvalue->where,
+                                                mpz_get_si (offset));
+             mpz_set (con->repeat, *repeat);
+             repeat = NULL;
+             mpz_clear (end);
+             break;
+           }
          else
            {
              mpz_t size;
@@ -293,6 +390,32 @@
                                                 NULL, &rvalue->where,
                                                 mpz_get_si (offset));
            }
+         else if (mpz_cmp_si (con->repeat, 1) > 0)
+           {
+             /* Need to split a range.  */
+             if (mpz_cmp (con->offset, offset) < 0)
+               {
+                 gfc_constructor *pred_con = con;
+                 con = gfc_constructor_insert_expr (&expr->value.constructor,
+                                                    NULL, &con->where,
+                                                    mpz_get_si (offset));
+                 con->expr = gfc_copy_expr (pred_con->expr);
+                 mpz_add (con->repeat, pred_con->offset, pred_con->repeat);
+                 mpz_sub (con->repeat, con->repeat, offset);
+                 mpz_sub (pred_con->repeat, offset, pred_con->offset);
+               }
+             if (mpz_cmp_si (con->repeat, 1) > 0)
+               {
+                 gfc_constructor *succ_con;
+                 succ_con
+                   = gfc_constructor_insert_expr (&expr->value.constructor,
+                                                  NULL, &con->where,
+                                                  mpz_get_si (offset) + 1);
+                 succ_con->expr = gfc_copy_expr (con->expr);
+                 mpz_sub_ui (succ_con->repeat, con->repeat, 1);
+                 mpz_set_si (con->repeat, 1);
+               }
+           }
          break;
 
        case REF_COMPONENT:
@@ -337,6 +460,7 @@
     }
 
   mpz_clear (offset);
+  gcc_assert (repeat == NULL);
 
   if (ref || last_ts->type == BT_CHARACTER)
     {
@@ -380,36 +504,6 @@
 }
 
 
-/* Similarly, but initialize REPEAT consecutive values in LVALUE the same
-   value in RVALUE.  */
-
-gfc_try
-gfc_assign_data_value_range (gfc_expr *lvalue, gfc_expr *rvalue,
-                            mpz_t index, mpz_t repeat)
-{
-  mpz_t offset, last_offset;
-  gfc_try t;
-
-  mpz_init (offset);
-  mpz_init (last_offset);
-  mpz_add (last_offset, index, repeat);
-
-  t = SUCCESS;
-  for (mpz_set(offset, index) ; mpz_cmp(offset, last_offset) < 0;
-                  mpz_add_ui (offset, offset, 1))
-    if (gfc_assign_data_value (lvalue, rvalue, offset) == FAILURE)
-      {
-       t = FAILURE;
-       break;
-      }
-
-  mpz_clear (offset);
-  mpz_clear (last_offset);
-
-  return t;
-}
-
-
 /* Modify the index of array section and re-calculate the array offset.  */
 
 void 
Index: gcc/fortran/data.h
===================================================================
--- gcc/fortran/data.h  (revision 175826)
+++ gcc/fortran/data.h  (revision 175827)
@@ -1,5 +1,5 @@
 /* Header for functions resolving DATA statements.
-   Copyright (C) 2007, 2008, 2010 Free Software Foundation, Inc.
+   Copyright (C) 2007, 2008, 2010, 2011 Free Software Foundation, Inc.
 
 This file is part of GCC.
 
@@ -19,6 +19,5 @@
 
 void gfc_formalize_init_value (gfc_symbol *);
 void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *);
-gfc_try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t);
-gfc_try gfc_assign_data_value_range (gfc_expr *, gfc_expr *, mpz_t, mpz_t);
+gfc_try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t, mpz_t *);
 void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *);
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c       (revision 175826)
+++ gcc/fortran/resolve.c       (revision 175827)
@@ -12612,8 +12612,8 @@
              mpz_set_ui (size, 0);
            }
 
-         t = gfc_assign_data_value_range (var->expr, values.vnode->expr,
-                                          offset, range);
+         t = gfc_assign_data_value (var->expr, values.vnode->expr,
+                                    offset, &range);
 
          mpz_add (offset, offset, range);
          mpz_clear (range);
@@ -12628,7 +12628,8 @@
          mpz_sub_ui (values.left, values.left, 1);
          mpz_sub_ui (size, size, 1);
 
-         t = gfc_assign_data_value (var->expr, values.vnode->expr, offset);
+         t = gfc_assign_data_value (var->expr, values.vnode->expr,
+                                    offset, NULL);
          if (t == FAILURE)
            break;
 
#	User	Rev	Content
1	eulisse	1.1	Index: gcc/testsuite/gfortran.dg/pr49540-2.f90
2			===================================================================
3			--- gcc/testsuite/gfortran.dg/pr49540-2.f90 (revision 0)
4			+++ gcc/testsuite/gfortran.dg/pr49540-2.f90 (revision 175827)
5			@@ -0,0 +1,17 @@
6			+! PR fortran/49540
7			+! { dg-do compile }
8			+! { dg-options "" }
9			+block data
10			+ common /a/ i(5,5)
11			+ data i /4, 23 * 5, 6/
12			+ data i(:,2) /1, 3 * 2, 3/
13			+ common /b/ j(5,5)
14			+ data j(2,:) /1, 3 * 2, 3/
15			+ data j /4, 23 * 5, 6/
16			+ common /c/ k(5,5)
17			+ data k(:,2) /1, 3 * 2, 3/
18			+ data k /4, 23 * 5, 6/
19			+ common /d/ l(5,5)
20			+ data l /4, 23 * 5, 6/
21			+ data l(2,:) /1, 3 * 2, 3/
22			+end block data
23			Index: gcc/testsuite/gfortran.dg/pr49540-1.f90
24			===================================================================
25			--- gcc/testsuite/gfortran.dg/pr49540-1.f90 (revision 0)
26			+++ gcc/testsuite/gfortran.dg/pr49540-1.f90 (revision 175827)
27			@@ -0,0 +1,6 @@
28			+! PR fortran/49540
29			+! { dg-do compile }
30			+block data
31			+ common /a/ b(100000,100)
32			+ data b /10000000 * 0.0/
33			+end block data
34			Index: gcc/dwarf2out.c
35			===================================================================
36			--- gcc/dwarf2out.c (revision 175826)
37			+++ gcc/dwarf2out.c (revision 175827)
38			@@ -17118,7 +17118,7 @@
39			{
40			int count = tree_low_cst (TREE_OPERAND (index, 1), 0)
41			- tree_low_cst (TREE_OPERAND (index, 0), 0);
42			- while (count > 0)
43			+ while (count-- > 0)
44			{
45			if (val)
46			memcpy (array + curpos, array + pos, fieldsize);
47			Index: gcc/fortran/trans-array.c
48			===================================================================
49			--- gcc/fortran/trans-array.c (revision 175826)
50			+++ gcc/fortran/trans-array.c (revision 175827)
51			@@ -4490,7 +4490,7 @@
52			gfc_se se;
53			HOST_WIDE_INT hi;
54			unsigned HOST_WIDE_INT lo;
55			- tree index;
56			+ tree index, range;
57			VEC(constructor_elt,gc) *v = NULL;
58
59			switch (expr->expr_type)
60			@@ -4544,28 +4544,56 @@
61			else
62			index = NULL_TREE;
63
64			+ if (mpz_cmp_si (c->repeat, 1) > 0)
65			+ {
66			+ tree tmp1, tmp2;
67			+ mpz_t maxval;
68			+
69			+ mpz_init (maxval);
70			+ mpz_add (maxval, c->offset, c->repeat);
71			+ mpz_sub_ui (maxval, maxval, 1);
72			+ tmp2 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind);
73			+ if (mpz_cmp_si (c->offset, 0) != 0)
74			+ {
75			+ mpz_add_ui (maxval, c->offset, 1);
76			+ tmp1 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind);
77			+ }
78			+ else
79			+ tmp1 = gfc_conv_mpz_to_tree (c->offset, gfc_index_integer_kind);
80			+
81			+ range = fold_build2 (RANGE_EXPR, gfc_array_index_type, tmp1, tmp2);
82			+ mpz_clear (maxval);
83			+ }
84			+ else
85			+ range = NULL;
86			+
87			gfc_init_se (&se, NULL);
88			switch (c->expr->expr_type)
89			{
90			case EXPR_CONSTANT:
91			gfc_conv_constant (&se, c->expr);
92			- CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
93			break;
94
95			case EXPR_STRUCTURE:
96			gfc_conv_structure (&se, c->expr, 1);
97			- CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
98			break;
99
100			-
101			default:
102			/* Catch those occasional beasts that do not simplify
103			for one reason or another, assuming that if they are
104			standard defying the frontend will catch them. */
105			gfc_conv_expr (&se, c->expr);
106			- CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
107			break;
108			}
109			+
110			+ if (range == NULL_TREE)
111			+ CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
112			+ else
113			+ {
114			+ if (index != NULL_TREE)
115			+ CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
116			+ CONSTRUCTOR_APPEND_ELT (v, range, se.expr);
117			+ }
118			}
119			break;
120
121			Index: gcc/fortran/array.c
122			===================================================================
123			--- gcc/fortran/array.c (revision 175826)
124			+++ gcc/fortran/array.c (revision 175827)
125			@@ -1309,6 +1309,7 @@
126
127			mpz_t *offset;
128			gfc_component *component;
129			+ mpz_t *repeat;
130
131			gfc_try (expand_work_function) (gfc_expr );
132			}
133			@@ -1543,6 +1544,7 @@
134			return FAILURE;
135			}
136			current_expand.offset = &c->offset;
137			+ current_expand.repeat = &c->repeat;
138			current_expand.component = c->n.component;
139			if (current_expand.expand_work_function (e) == FAILURE)
140			return FAILURE;
141			Index: gcc/fortran/constructor.c
142			===================================================================
143			--- gcc/fortran/constructor.c (revision 175826)
144			+++ gcc/fortran/constructor.c (revision 175827)
145			@@ -1,5 +1,5 @@
146			/* Array and structure constructors
147			- Copyright (C) 2009, 2010
148			+ Copyright (C) 2009, 2010, 2011
149			Free Software Foundation, Inc.
150
151			This file is part of GCC.
152			@@ -36,6 +36,7 @@
153			gfc_free_iterator (c->iterator, 1);
154
155			mpz_clear (c->offset);
156			+ mpz_clear (c->repeat);
157
158			gfc_free (c);
159			}
160			@@ -54,6 +55,7 @@
161			c->n.component = src->n.component;
162
163			mpz_init_set (c->offset, src->offset);
164			+ mpz_init_set (c->repeat, src->repeat);
165
166			return c;
167			}
168			@@ -78,6 +80,7 @@
169			c->iterator = NULL;
170
171			mpz_init_set_si (c->offset, 0);
172			+ mpz_init_set_si (c->repeat, 1);
173
174			return c;
175			}
176			@@ -169,6 +172,7 @@
177			gfc_constructor *
178			gfc_constructor_lookup (gfc_constructor_base base, int offset)
179			{
180			+ gfc_constructor *c;
181			splay_tree_node node;
182
183			if (!base)
184			@@ -176,9 +180,24 @@
185
186			node = splay_tree_lookup (base, (splay_tree_key) offset);
187			if (node)
188			- return (gfc_constructor*) node->value;
189			+ return (gfc_constructor *) node->value;
190
191			- return NULL;
192			+ /* Check if the previous node has a repeat count big enough to
193			+ cover the offset looked for. */
194			+ node = splay_tree_predecessor (base, (splay_tree_key) offset);
195			+ if (!node)
196			+ return NULL;
197			+
198			+ c = (gfc_constructor *) node->value;
199			+ if (mpz_cmp_si (c->repeat, 1) > 0)
200			+ {
201			+ if (mpz_get_si (c->offset) + mpz_get_si (c->repeat) <= offset)
202			+ c = NULL;
203			+ }
204			+ else
205			+ c = NULL;
206			+
207			+ return c;
208			}
209
210
211			@@ -232,3 +251,27 @@
212			else
213			return NULL;
214			}
215			+
216			+
217			+void
218			+gfc_constructor_remove (gfc_constructor *ctor)
219			+{
220			+ if (ctor)
221			+ splay_tree_remove (ctor->base, mpz_get_si (ctor->offset));
222			+}
223			+
224			+
225			+gfc_constructor *
226			+gfc_constructor_lookup_next (gfc_constructor_base base, int offset)
227			+{
228			+ splay_tree_node node;
229			+
230			+ if (!base)
231			+ return NULL;
232			+
233			+ node = splay_tree_successor (base, (splay_tree_key) offset);
234			+ if (!node)
235			+ return NULL;
236			+
237			+ return (gfc_constructor *) node->value;
238			+}
239			Index: gcc/fortran/gfortran.h
240			===================================================================
241			--- gcc/fortran/gfortran.h (revision 175826)
242			+++ gcc/fortran/gfortran.h (revision 175827)
243			@@ -2264,6 +2264,8 @@
244			gfc_component component; / Record the component being initialized. */
245			}
246			n;
247			+ mpz_t repeat; /* Record the repeat number of initial values in data
248			+ statement like "data a/510/". /
249			}
250			gfc_constructor;
251
252			Index: gcc/fortran/constructor.h
253			===================================================================
254			--- gcc/fortran/constructor.h (revision 175826)
255			+++ gcc/fortran/constructor.h (revision 175827)
256			@@ -1,5 +1,5 @@
257			/* Array and structure constructors
258			- Copyright (C) 2009, 2010
259			+ Copyright (C) 2009, 2010, 2011
260			Free Software Foundation, Inc.
261
262			This file is part of GCC.
263			@@ -81,6 +81,10 @@
264			Returns NULL if there is no next expression. */
265			gfc_constructor gfc_constructor_next (gfc_constructor ctor);
266
267			-gfc_constructor gfc_constructor_advance (gfc_constructor ctor, int n);
268			+/* Remove the gfc_constructor node from the splay tree. */
269			+void gfc_constructor_remove (gfc_constructor *);
270
271			+/* Return first constructor node after offset. */
272			+gfc_constructor *gfc_constructor_lookup_next (gfc_constructor_base, int);
273			+
274			#endif /* GFC_CONSTRUCTOR_H */
275			Index: gcc/fortran/data.c
276			===================================================================
277			--- gcc/fortran/data.c (revision 175826)
278			+++ gcc/fortran/data.c (revision 175827)
279			@@ -1,5 +1,5 @@
280			/* Supporting functions for resolving DATA statement.
281			- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
282			+ Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
283			Free Software Foundation, Inc.
284			Contributed by Lifang Zeng <zlf605@hotmail.com>
285
286			@@ -189,10 +189,13 @@
287
288			/* Assign the initial value RVALUE to LVALUE's symbol->value. If the
289			LVALUE already has an initialization, we extend this, otherwise we
290			- create a new one. */
291			+ create a new one. If REPEAT is non-NULL, initialize *REPEAT
292			+ consecutive values in LVALUE the same value in RVALUE. In that case,
293			+ LVALUE must refer to a full array, not an array section. */
294
295			gfc_try
296			-gfc_assign_data_value (gfc_expr lvalue, gfc_expr rvalue, mpz_t index)
297			+gfc_assign_data_value (gfc_expr lvalue, gfc_expr rvalue, mpz_t index,
298			+ mpz_t *repeat)
299			{
300			gfc_ref *ref;
301			gfc_expr *init;
302			@@ -269,6 +272,100 @@
303			&lvalue->where);
304			goto abort;
305			}
306			+ else if (repeat != NULL
307			+ && ref->u.ar.type != AR_ELEMENT)
308			+ {
309			+ mpz_t size, end;
310			+ gcc_assert (ref->u.ar.type == AR_FULL
311			+ && ref->next == NULL);
312			+ mpz_init_set (end, offset);
313			+ mpz_add (end, end, *repeat);
314			+ if (spec_size (ref->u.ar.as, &size) == SUCCESS)
315			+ {
316			+ if (mpz_cmp (end, size) > 0)
317			+ {
318			+ mpz_clear (size);
319			+ gfc_error ("Data element above array upper bound at %L",
320			+ &lvalue->where);
321			+ goto abort;
322			+ }
323			+ mpz_clear (size);
324			+ }
325			+
326			+ con = gfc_constructor_lookup (expr->value.constructor,
327			+ mpz_get_si (offset));
328			+ if (!con)
329			+ {
330			+ con = gfc_constructor_lookup_next (expr->value.constructor,
331			+ mpz_get_si (offset));
332			+ if (con != NULL && mpz_cmp (con->offset, end) >= 0)
333			+ con = NULL;
334			+ }
335			+
336			+ /* Overwriting an existing initializer is non-standard but
337			+ usually only provokes a warning from other compilers. */
338			+ if (con != NULL && con->expr != NULL)
339			+ {
340			+ /* Order in which the expressions arrive here depends on
341			+ whether they are from data statements or F95 style
342			+ declarations. Therefore, check which is the most
343			+ recent. */
344			+ gfc_expr *exprd;
345			+ exprd = (LOCATION_LINE (con->expr->where.lb->location)
346			+ > LOCATION_LINE (rvalue->where.lb->location))
347			+ ? con->expr : rvalue;
348			+ if (gfc_notify_std (GFC_STD_GNU,"Extension: "
349			+ "re-initialization of '%s' at %L",
350			+ symbol->name, &exprd->where) == FAILURE)
351			+ return FAILURE;
352			+ }
353			+
354			+ while (con != NULL)
355			+ {
356			+ gfc_constructor *next_con = gfc_constructor_next (con);
357			+
358			+ if (mpz_cmp (con->offset, end) >= 0)
359			+ break;
360			+ if (mpz_cmp (con->offset, offset) < 0)
361			+ {
362			+ gcc_assert (mpz_cmp_si (con->repeat, 1) > 0);
363			+ mpz_sub (con->repeat, offset, con->offset);
364			+ }
365			+ else if (mpz_cmp_si (con->repeat, 1) > 0
366			+ && mpz_get_si (con->offset)
367			+ + mpz_get_si (con->repeat) > mpz_get_si (end))
368			+ {
369			+ int endi;
370			+ splay_tree_node node
371			+ = splay_tree_lookup (con->base,
372			+ mpz_get_si (con->offset));
373			+ gcc_assert (node
374			+ && con == (gfc_constructor *) node->value
375			+ && node->key == (splay_tree_key)
376			+ mpz_get_si (con->offset));
377			+ endi = mpz_get_si (con->offset)
378			+ + mpz_get_si (con->repeat);
379			+ if (endi > mpz_get_si (end) + 1)
380			+ mpz_set_si (con->repeat, endi - mpz_get_si (end));
381			+ else
382			+ mpz_set_si (con->repeat, 1);
383			+ mpz_set (con->offset, end);
384			+ node->key = (splay_tree_key) mpz_get_si (end);
385			+ break;
386			+ }
387			+ else
388			+ gfc_constructor_remove (con);
389			+ con = next_con;
390			+ }
391			+
392			+ con = gfc_constructor_insert_expr (&expr->value.constructor,
393			+ NULL, &rvalue->where,
394			+ mpz_get_si (offset));
395			+ mpz_set (con->repeat, *repeat);
396			+ repeat = NULL;
397			+ mpz_clear (end);
398			+ break;
399			+ }
400			else
401			{
402			mpz_t size;
403			@@ -293,6 +390,32 @@
404			NULL, &rvalue->where,
405			mpz_get_si (offset));
406			}
407			+ else if (mpz_cmp_si (con->repeat, 1) > 0)
408			+ {
409			+ /* Need to split a range. */
410			+ if (mpz_cmp (con->offset, offset) < 0)
411			+ {
412			+ gfc_constructor *pred_con = con;
413			+ con = gfc_constructor_insert_expr (&expr->value.constructor,
414			+ NULL, &con->where,
415			+ mpz_get_si (offset));
416			+ con->expr = gfc_copy_expr (pred_con->expr);
417			+ mpz_add (con->repeat, pred_con->offset, pred_con->repeat);
418			+ mpz_sub (con->repeat, con->repeat, offset);
419			+ mpz_sub (pred_con->repeat, offset, pred_con->offset);
420			+ }
421			+ if (mpz_cmp_si (con->repeat, 1) > 0)
422			+ {
423			+ gfc_constructor *succ_con;
424			+ succ_con
425			+ = gfc_constructor_insert_expr (&expr->value.constructor,
426			+ NULL, &con->where,
427			+ mpz_get_si (offset) + 1);
428			+ succ_con->expr = gfc_copy_expr (con->expr);
429			+ mpz_sub_ui (succ_con->repeat, con->repeat, 1);
430			+ mpz_set_si (con->repeat, 1);
431			+ }
432			+ }
433			break;
434
435			case REF_COMPONENT:
436			@@ -337,6 +460,7 @@
437			}
438
439			mpz_clear (offset);
440			+ gcc_assert (repeat == NULL);
441
442			if (ref \|\| last_ts->type == BT_CHARACTER)
443			{
444			@@ -380,36 +504,6 @@
445			}
446
447
448			-/* Similarly, but initialize REPEAT consecutive values in LVALUE the same
449			- value in RVALUE. */
450			-
451			-gfc_try
452			-gfc_assign_data_value_range (gfc_expr lvalue, gfc_expr rvalue,
453			- mpz_t index, mpz_t repeat)
454			-{
455			- mpz_t offset, last_offset;
456			- gfc_try t;
457			-
458			- mpz_init (offset);
459			- mpz_init (last_offset);
460			- mpz_add (last_offset, index, repeat);
461			-
462			- t = SUCCESS;
463			- for (mpz_set(offset, index) ; mpz_cmp(offset, last_offset) < 0;
464			- mpz_add_ui (offset, offset, 1))
465			- if (gfc_assign_data_value (lvalue, rvalue, offset) == FAILURE)
466			- {
467			- t = FAILURE;
468			- break;
469			- }
470			-
471			- mpz_clear (offset);
472			- mpz_clear (last_offset);
473			-
474			- return t;
475			-}
476			-
477			-
478			/* Modify the index of array section and re-calculate the array offset. */
479
480			void
481			Index: gcc/fortran/data.h
482			===================================================================
483			--- gcc/fortran/data.h (revision 175826)
484			+++ gcc/fortran/data.h (revision 175827)
485			@@ -1,5 +1,5 @@
486			/* Header for functions resolving DATA statements.
487			- Copyright (C) 2007, 2008, 2010 Free Software Foundation, Inc.
488			+ Copyright (C) 2007, 2008, 2010, 2011 Free Software Foundation, Inc.
489
490			This file is part of GCC.
491
492			@@ -19,6 +19,5 @@
493
494			void gfc_formalize_init_value (gfc_symbol *);
495			void gfc_get_section_index (gfc_array_ref , mpz_t , mpz_t *);
496			-gfc_try gfc_assign_data_value (gfc_expr , gfc_expr , mpz_t);
497			-gfc_try gfc_assign_data_value_range (gfc_expr , gfc_expr , mpz_t, mpz_t);
498			+gfc_try gfc_assign_data_value (gfc_expr , gfc_expr , mpz_t, mpz_t *);
499			void gfc_advance_section (mpz_t , gfc_array_ref , mpz_t *);
500			Index: gcc/fortran/resolve.c
501			===================================================================
502			--- gcc/fortran/resolve.c (revision 175826)
503			+++ gcc/fortran/resolve.c (revision 175827)
504			@@ -12612,8 +12612,8 @@
505			mpz_set_ui (size, 0);
506			}
507
508			- t = gfc_assign_data_value_range (var->expr, values.vnode->expr,
509			- offset, range);
510			+ t = gfc_assign_data_value (var->expr, values.vnode->expr,
511			+ offset, &range);
512
513			mpz_add (offset, offset, range);
514			mpz_clear (range);
515			@@ -12628,7 +12628,8 @@
516			mpz_sub_ui (values.left, values.left, 1);
517			mpz_sub_ui (size, size, 1);
518
519			- t = gfc_assign_data_value (var->expr, values.vnode->expr, offset);
520			+ t = gfc_assign_data_value (var->expr, values.vnode->expr,
521			+ offset, NULL);
522			if (t == FAILURE)
523			break;
524