OSDN Git Service

2010-04-06 Tobias Burnus <burnus@net-b.de>
[pf3gnuchains/gcc-fork.git] / gcc / fortran / array.c
index 5487be7..4282fd1 100644 (file)
@@ -23,7 +23,6 @@ along with GCC; see the file COPYING3.  If not see
 #include "system.h"
 #include "gfortran.h"
 #include "match.h"
-#include "constructor.h"
 
 /**************** Array reference matching subroutines *****************/
 
@@ -62,13 +61,12 @@ gfc_copy_array_ref (gfc_array_ref *src)
    expression.  */
 
 static match
-match_subscript (gfc_array_ref *ar, int init, bool match_star)
+match_subscript (gfc_array_ref *ar, int init)
 {
   match m;
-  bool star = false;
   int i;
 
-  i = ar->dimen + ar->codimen;
+  i = ar->dimen;
 
   ar->c_where[i] = gfc_current_locus;
   ar->start[i] = ar->end[i] = ar->stride[i] = NULL;
@@ -83,12 +81,9 @@ match_subscript (gfc_array_ref *ar, int init, bool match_star)
     goto end_element;
 
   /* Get start element.  */
-  if (match_star && (m = gfc_match_char ('*')) == MATCH_YES)
-    star = true;
-
-  if (!star && init)
+  if (init)
     m = gfc_match_init_expr (&ar->start[i]);
-  else if (!star)
+  else
     m = gfc_match_expr (&ar->start[i]);
 
   if (m == MATCH_NO)
@@ -97,22 +92,14 @@ match_subscript (gfc_array_ref *ar, int init, bool match_star)
     return MATCH_ERROR;
 
   if (gfc_match_char (':') == MATCH_NO)
-    goto matched;
-
-  if (star)
-    {
-      gfc_error ("Unexpected '*' in coarray subscript at %C");
-      return MATCH_ERROR;
-    }
+    return MATCH_YES;
 
   /* Get an optional end element.  Because we've seen the colon, we
      definitely have a range along this dimension.  */
 end_element:
   ar->dimen_type[i] = DIMEN_RANGE;
 
-  if (match_star && (m = gfc_match_char ('*')) == MATCH_YES)
-    star = true;
-  else if (init)
+  if (init)
     m = gfc_match_init_expr (&ar->end[i]);
   else
     m = gfc_match_expr (&ar->end[i]);
@@ -123,12 +110,6 @@ end_element:
   /* See if we have an optional stride.  */
   if (gfc_match_char (':') == MATCH_YES)
     {
-      if (star)
-       {
-         gfc_error ("Strides not allowed in coarray subscript at %C");
-         return MATCH_ERROR;
-       }
-
       m = init ? gfc_match_init_expr (&ar->stride[i])
               : gfc_match_expr (&ar->stride[i]);
 
@@ -138,10 +119,6 @@ end_element:
        return MATCH_ERROR;
     }
 
-matched:
-  if (star)
-    ar->dimen_type[i] = DIMEN_STAR;
-
   return MATCH_YES;
 }
 
@@ -151,23 +128,14 @@ matched:
    to consist of init expressions.  */
 
 match
-gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
-                    int corank)
+gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init)
 {
   match m;
-  bool matched_bracket = false;
 
   memset (ar, '\0', sizeof (ar));
 
   ar->where = gfc_current_locus;
   ar->as = as;
-  ar->type = AR_UNKNOWN;
-
-  if (gfc_match_char ('[') == MATCH_YES)
-    {
-       matched_bracket = true;
-       goto coarray;
-    }
 
   if (gfc_match_char ('(') != MATCH_YES)
     {
@@ -176,73 +144,34 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
       return MATCH_YES;
     }
 
+  ar->type = AR_UNKNOWN;
+
   for (ar->dimen = 0; ar->dimen < GFC_MAX_DIMENSIONS; ar->dimen++)
     {
-      m = match_subscript (ar, init, false);
+      m = match_subscript (ar, init);
       if (m == MATCH_ERROR)
-       return MATCH_ERROR;
+       goto error;
 
       if (gfc_match_char (')') == MATCH_YES)
-       {
-         ar->dimen++;
-         goto coarray;
-       }
+       goto matched;
 
       if (gfc_match_char (',') != MATCH_YES)
        {
          gfc_error ("Invalid form of array reference at %C");
-         return MATCH_ERROR;
+         goto error;
        }
     }
 
   gfc_error ("Array reference at %C cannot have more than %d dimensions",
             GFC_MAX_DIMENSIONS);
-  return MATCH_ERROR;
-
-coarray:
-  if (!matched_bracket && gfc_match_char ('[') != MATCH_YES)
-    {
-      if (ar->dimen > 0)
-       return MATCH_YES;
-      else
-       return MATCH_ERROR;
-    }
-
-  if (gfc_option.coarray == GFC_FCOARRAY_NONE)
-    {
-      gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
-      return MATCH_ERROR;
-    }
-
-  if (corank == 0)
-    {
-       gfc_error ("Unexpected coarray designator at %C");
-       return MATCH_ERROR;
-    }
-
-  for (ar->codimen = 0; ar->codimen + ar->dimen < GFC_MAX_DIMENSIONS; ar->codimen++)
-    {
-      m = match_subscript (ar, init, ar->codimen == (corank - 1));
-      if (m == MATCH_ERROR)
-       return MATCH_ERROR;
-
-      if (gfc_match_char (']') == MATCH_YES)
-       {
-         ar->codimen++;
-         return MATCH_YES;
-       }
-
-      if (gfc_match_char (',') != MATCH_YES)
-       {
-         gfc_error ("Invalid form of coarray reference at %C");
-         return MATCH_ERROR;
-       }
-    }
 
-  gfc_error ("Array reference at %C cannot have more than %d dimensions",
-            GFC_MAX_DIMENSIONS);
+error:
   return MATCH_ERROR;
 
+matched:
+  ar->dimen++;
+
+  return MATCH_YES;
 }
 
 
@@ -366,7 +295,7 @@ match_array_element_spec (gfc_array_spec *as)
 
   if (gfc_match_char ('*') == MATCH_YES)
     {
-      *lower = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+      *lower = gfc_int_expr (1);
       return AS_ASSUMED_SIZE;
     }
 
@@ -383,7 +312,7 @@ match_array_element_spec (gfc_array_spec *as)
 
   if (gfc_match_char (':') == MATCH_NO)
     {
-      *lower = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+      *lower = gfc_int_expr (1);
       return AS_EXPLICIT;
     }
 
@@ -531,8 +460,8 @@ coarray:
 
   if (gfc_option.coarray == GFC_FCOARRAY_NONE)
     {
-      gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
-      goto cleanup;
+       gfc_error ("Coarrays disabled at %C, use -fcoarray= to enable");
+       goto cleanup;
     }
 
   for (;;)
@@ -636,7 +565,7 @@ done:
       for (i = 0; i < as->rank + as->corank; i++)
        {
          if (as->lower[i] == NULL)
-           as->lower[i] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+           as->lower[i] = gfc_int_expr (1);
        }
     }
 
@@ -807,6 +736,151 @@ gfc_compare_array_spec (gfc_array_spec *as1, gfc_array_spec *as2)
 
 /****************** Array constructor functions ******************/
 
+/* Start an array constructor.  The constructor starts with zero
+   elements and should be appended to by gfc_append_constructor().  */
+
+gfc_expr *
+gfc_start_constructor (bt type, int kind, locus *where)
+{
+  gfc_expr *result;
+
+  result = gfc_get_expr ();
+
+  result->expr_type = EXPR_ARRAY;
+  result->rank = 1;
+
+  result->ts.type = type;
+  result->ts.kind = kind;
+  result->where = *where;
+  return result;
+}
+
+
+/* Given an array constructor expression, append the new expression
+   node onto the constructor.  */
+
+void
+gfc_append_constructor (gfc_expr *base, gfc_expr *new_expr)
+{
+  gfc_constructor *c;
+
+  if (base->value.constructor == NULL)
+    base->value.constructor = c = gfc_get_constructor ();
+  else
+    {
+      c = base->value.constructor;
+      while (c->next)
+       c = c->next;
+
+      c->next = gfc_get_constructor ();
+      c = c->next;
+    }
+
+  c->expr = new_expr;
+
+  if (new_expr
+      && (new_expr->ts.type != base->ts.type || new_expr->ts.kind != base->ts.kind))
+    gfc_internal_error ("gfc_append_constructor(): New node has wrong kind");
+}
+
+
+/* Given an array constructor expression, insert the new expression's
+   constructor onto the base's one according to the offset.  */
+
+void
+gfc_insert_constructor (gfc_expr *base, gfc_constructor *c1)
+{
+  gfc_constructor *c, *pre;
+  expr_t type;
+  int t;
+
+  type = base->expr_type;
+
+  if (base->value.constructor == NULL)
+    base->value.constructor = c1;
+  else
+    {
+      c = pre = base->value.constructor;
+      while (c)
+       {
+         if (type == EXPR_ARRAY)
+           {
+             t = mpz_cmp (c->n.offset, c1->n.offset);
+             if (t < 0)
+               {
+                 pre = c;
+                 c = c->next;
+               }
+             else if (t == 0)
+               {
+                 gfc_error ("duplicated initializer");
+                 break;
+               }
+             else
+               break;
+           }
+         else
+           {
+             pre = c;
+             c = c->next;
+           }
+       }
+
+      if (pre != c)
+       {
+         pre->next = c1;
+         c1->next = c;
+       }
+      else
+       {
+         c1->next = c;
+         base->value.constructor = c1;
+       }
+    }
+}
+
+
+/* Get a new constructor.  */
+
+gfc_constructor *
+gfc_get_constructor (void)
+{
+  gfc_constructor *c;
+
+  c = XCNEW (gfc_constructor);
+  c->expr = NULL;
+  c->iterator = NULL;
+  c->next = NULL;
+  mpz_init_set_si (c->n.offset, 0);
+  mpz_init_set_si (c->repeat, 0);
+  return c;
+}
+
+
+/* Free chains of gfc_constructor structures.  */
+
+void
+gfc_free_constructor (gfc_constructor *p)
+{
+  gfc_constructor *next;
+
+  if (p == NULL)
+    return;
+
+  for (; p; p = next)
+    {
+      next = p->next;
+
+      if (p->expr)
+       gfc_free_expr (p->expr);
+      if (p->iterator != NULL)
+       gfc_free_iterator (p->iterator, 1);
+      mpz_clear (p->n.offset);
+      mpz_clear (p->repeat);
+      gfc_free (p);
+    }
+}
+
 
 /* Given an expression node that might be an array constructor and a
    symbol, make sure that no iterators in this or child constructors
@@ -814,12 +888,11 @@ gfc_compare_array_spec (gfc_array_spec *as1, gfc_array_spec *as2)
    duplicate was found.  */
 
 static int
-check_duplicate_iterator (gfc_constructor_base base, gfc_symbol *master)
+check_duplicate_iterator (gfc_constructor *c, gfc_symbol *master)
 {
-  gfc_constructor *c;
   gfc_expr *e;
 
-  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
+  for (; c; c = c->next)
     {
       e = c->expr;
 
@@ -844,15 +917,14 @@ check_duplicate_iterator (gfc_constructor_base base, gfc_symbol *master)
 
 
 /* Forward declaration because these functions are mutually recursive.  */
-static match match_array_cons_element (gfc_constructor_base *);
+static match match_array_cons_element (gfc_constructor **);
 
 /* Match a list of array elements.  */
 
 static match
-match_array_list (gfc_constructor_base *result)
+match_array_list (gfc_constructor **result)
 {
-  gfc_constructor_base head;
-  gfc_constructor *p;
+  gfc_constructor *p, *head, *tail, *new_cons;
   gfc_iterator iter;
   locus old_loc;
   gfc_expr *e;
@@ -871,6 +943,8 @@ match_array_list (gfc_constructor_base *result)
   if (m != MATCH_YES)
     goto cleanup;
 
+  tail = head;
+
   if (gfc_match_char (',') != MATCH_YES)
     {
       m = MATCH_NO;
@@ -885,7 +959,7 @@ match_array_list (gfc_constructor_base *result)
       if (m == MATCH_ERROR)
        goto cleanup;
 
-      m = match_array_cons_element (&head);
+      m = match_array_cons_element (&new_cons);
       if (m == MATCH_ERROR)
        goto cleanup;
       if (m == MATCH_NO)
@@ -896,6 +970,9 @@ match_array_list (gfc_constructor_base *result)
          goto cleanup;         /* Could be a complex constant */
        }
 
+      tail->next = new_cons;
+      tail = new_cons;
+
       if (gfc_match_char (',') != MATCH_YES)
        {
          if (n > 2)
@@ -914,13 +991,19 @@ match_array_list (gfc_constructor_base *result)
       goto cleanup;
     }
 
-  e = gfc_get_array_expr (BT_UNKNOWN, 0, &old_loc);
+  e = gfc_get_expr ();
+  e->expr_type = EXPR_ARRAY;
+  e->where = old_loc;
   e->value.constructor = head;
 
-  p = gfc_constructor_append_expr (result, e, &gfc_current_locus);
+  p = gfc_get_constructor ();
+  p->where = gfc_current_locus;
   p->iterator = gfc_get_iterator ();
   *p->iterator = iter;
 
+  p->expr = e;
+  *result = p;
+
   return MATCH_YES;
 
 syntax:
@@ -928,7 +1011,7 @@ syntax:
   m = MATCH_ERROR;
 
 cleanup:
-  gfc_constructor_free (head);
+  gfc_free_constructor (head);
   gfc_free_iterator (&iter, 0);
   gfc_current_locus = old_loc;
   return m;
@@ -939,8 +1022,9 @@ cleanup:
    single expression or a list of elements.  */
 
 static match
-match_array_cons_element (gfc_constructor_base *result)
+match_array_cons_element (gfc_constructor **result)
 {
+  gfc_constructor *p;
   gfc_expr *expr;
   match m;
 
@@ -952,7 +1036,11 @@ match_array_cons_element (gfc_constructor_base *result)
   if (m != MATCH_YES)
     return m;
 
-  gfc_constructor_append_expr (result, expr, &gfc_current_locus);
+  p = gfc_get_constructor ();
+  p->where = gfc_current_locus;
+  p->expr = expr;
+
+  *result = p;
   return MATCH_YES;
 }
 
@@ -962,7 +1050,7 @@ match_array_cons_element (gfc_constructor_base *result)
 match
 gfc_match_array_constructor (gfc_expr **result)
 {
-  gfc_constructor_base head, new_cons;
+  gfc_constructor *head, *tail, *new_cons;
   gfc_expr *expr;
   gfc_typespec ts;
   locus where;
@@ -986,7 +1074,7 @@ gfc_match_array_constructor (gfc_expr **result)
     end_delim = " /)";
 
   where = gfc_current_locus;
-  head = new_cons = NULL;
+  head = tail = NULL;
   seen_ts = false;
 
   /* Try to match an optional "type-spec ::"  */
@@ -1018,12 +1106,19 @@ gfc_match_array_constructor (gfc_expr **result)
 
   for (;;)
     {
-      m = match_array_cons_element (&head);
+      m = match_array_cons_element (&new_cons);
       if (m == MATCH_ERROR)
        goto cleanup;
       if (m == MATCH_NO)
        goto syntax;
 
+      if (head == NULL)
+       head = new_cons;
+      else
+       tail->next = new_cons;
+
+      tail = new_cons;
+
       if (gfc_match_char (',') == MATCH_NO)
        break;
     }
@@ -1032,19 +1127,24 @@ gfc_match_array_constructor (gfc_expr **result)
     goto syntax;
 
 done:
+  expr = gfc_get_expr ();
+
+  expr->expr_type = EXPR_ARRAY;
+
+  expr->value.constructor = head;
   /* Size must be calculated at resolution time.  */
+
   if (seen_ts)
-    {
-      expr = gfc_get_array_expr (ts.type, ts.kind, &where);
-      expr->ts = ts;
-    }
+    expr->ts = ts;
   else
-    expr = gfc_get_array_expr (BT_UNKNOWN, 0, &where);
-
-  expr->value.constructor = head;
+    expr->ts.type = BT_UNKNOWN;
+  
   if (expr->ts.u.cl)
     expr->ts.u.cl->length_from_typespec = seen_ts;
 
+  expr->where = where;
+  expr->rank = 1;
+
   *result = expr;
   return MATCH_YES;
 
@@ -1052,7 +1152,7 @@ syntax:
   gfc_error ("Syntax error in array constructor at %C");
 
 cleanup:
-  gfc_constructor_free (head);
+  gfc_free_constructor (head);
   return MATCH_ERROR;
 }
 
@@ -1108,12 +1208,11 @@ check_element_type (gfc_expr *expr, bool convert)
 /* Recursive work function for gfc_check_constructor_type().  */
 
 static gfc_try
-check_constructor_type (gfc_constructor_base base, bool convert)
+check_constructor_type (gfc_constructor *c, bool convert)
 {
-  gfc_constructor *c;
   gfc_expr *e;
 
-  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
+  for (; c; c = c->next)
     {
       e = c->expr;
 
@@ -1172,7 +1271,7 @@ cons_stack;
 
 static cons_stack *base;
 
-static gfc_try check_constructor (gfc_constructor_base, gfc_try (*) (gfc_expr *));
+static gfc_try check_constructor (gfc_constructor *, gfc_try (*) (gfc_expr *));
 
 /* Check an EXPR_VARIABLE expression in a constructor to make sure
    that that variable is an iteration variables.  */
@@ -1198,14 +1297,13 @@ gfc_check_iter_variable (gfc_expr *expr)
    constructor, giving variables with the names of iterators a pass.  */
 
 static gfc_try
-check_constructor (gfc_constructor_base ctor, gfc_try (*check_function) (gfc_expr *))
+check_constructor (gfc_constructor *c, gfc_try (*check_function) (gfc_expr *))
 {
   cons_stack element;
   gfc_expr *e;
   gfc_try t;
-  gfc_constructor *c;
 
-  for (c = gfc_constructor_first (ctor); c; c = gfc_constructor_next (c))
+  for (; c; c = c->next)
     {
       e = c->expr;
 
@@ -1259,7 +1357,7 @@ iterator_stack *iter_stack;
 
 typedef struct
 {
-  gfc_constructor_base base;
+  gfc_constructor *new_head, *new_tail;
   int extract_count, extract_n;
   gfc_expr *extracted;
   mpz_t *count;
@@ -1274,7 +1372,7 @@ expand_info;
 
 static expand_info current_expand;
 
-static gfc_try expand_constructor (gfc_constructor_base);
+static gfc_try expand_constructor (gfc_constructor *);
 
 
 /* Work function that counts the number of elements present in a
@@ -1333,10 +1431,21 @@ extract_element (gfc_expr *e)
 static gfc_try
 expand (gfc_expr *e)
 {
-  gfc_constructor *c = gfc_constructor_append_expr (&current_expand.base,
-                                                   e, &e->where);
+  if (current_expand.new_head == NULL)
+    current_expand.new_head = current_expand.new_tail =
+      gfc_get_constructor ();
+  else
+    {
+      current_expand.new_tail->next = gfc_get_constructor ();
+      current_expand.new_tail = current_expand.new_tail->next;
+    }
 
-  c->n.component = current_expand.component;
+  current_expand.new_tail->where = e->where;
+  current_expand.new_tail->expr = e;
+
+  mpz_set (current_expand.new_tail->n.offset, *current_expand.offset);
+  current_expand.new_tail->n.component = current_expand.component;
+  mpz_set (current_expand.new_tail->repeat, *current_expand.repeat);
   return SUCCESS;
 }
 
@@ -1356,7 +1465,7 @@ gfc_simplify_iterator_var (gfc_expr *e)
   if (p == NULL)
     return;            /* Variable not found */
 
-  gfc_replace_expr (e, gfc_get_int_expr (gfc_default_integer_kind, NULL, 0));
+  gfc_replace_expr (e, gfc_int_expr (0));
 
   mpz_set (e->value.integer, p->value);
 
@@ -1470,12 +1579,11 @@ cleanup:
    passed expression.  */
 
 static gfc_try
-expand_constructor (gfc_constructor_base base)
+expand_constructor (gfc_constructor *c)
 {
-  gfc_constructor *c;
   gfc_expr *e;
 
-  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next(c))
+  for (; c; c = c->next)
     {
       if (c->iterator != NULL)
        {
@@ -1500,9 +1608,9 @@ expand_constructor (gfc_constructor_base base)
          gfc_free_expr (e);
          return FAILURE;
        }
-      current_expand.offset = &c->offset;
-      current_expand.repeat = &c->repeat;
+      current_expand.offset = &c->n.offset;
       current_expand.component = c->n.component;
+      current_expand.repeat = &c->repeat;
       if (current_expand.expand_work_function (e) == FAILURE)
        return FAILURE;
     }
@@ -1510,39 +1618,6 @@ expand_constructor (gfc_constructor_base base)
 }
 
 
-/* Given an array expression and an element number (starting at zero),
-   return a pointer to the array element.  NULL is returned if the
-   size of the array has been exceeded.  The expression node returned
-   remains a part of the array and should not be freed.  Access is not
-   efficient at all, but this is another place where things do not
-   have to be particularly fast.  */
-
-static gfc_expr *
-gfc_get_array_element (gfc_expr *array, int element)
-{
-  expand_info expand_save;
-  gfc_expr *e;
-  gfc_try rc;
-
-  expand_save = current_expand;
-  current_expand.extract_n = element;
-  current_expand.expand_work_function = extract_element;
-  current_expand.extracted = NULL;
-  current_expand.extract_count = 0;
-
-  iter_stack = NULL;
-
-  rc = expand_constructor (array->value.constructor);
-  e = current_expand.extracted;
-  current_expand = expand_save;
-
-  if (rc == FAILURE)
-    return NULL;
-
-  return e;
-}
-
-
 /* Top level subroutine for expanding constructors.  We only expand
    constructor if they are small enough.  */
 
@@ -1553,8 +1628,6 @@ gfc_expand_constructor (gfc_expr *e)
   gfc_expr *f;
   gfc_try rc;
 
-  /* If we can successfully get an array element at the max array size then
-     the array is too big to expand, so we just return.  */
   f = gfc_get_array_element (e, gfc_option.flag_max_array_constructor);
   if (f != NULL)
     {
@@ -1562,9 +1635,8 @@ gfc_expand_constructor (gfc_expr *e)
       return SUCCESS;
     }
 
-  /* We now know the array is not too big so go ahead and try to expand it.  */
   expand_save = current_expand;
-  current_expand.base = NULL;
+  current_expand.new_head = current_expand.new_tail = NULL;
 
   iter_stack = NULL;
 
@@ -1572,13 +1644,13 @@ gfc_expand_constructor (gfc_expr *e)
 
   if (expand_constructor (e->value.constructor) == FAILURE)
     {
-      gfc_constructor_free (current_expand.base);
+      gfc_free_constructor (current_expand.new_head);
       rc = FAILURE;
       goto done;
     }
 
-  gfc_constructor_free (e->value.constructor);
-  e->value.constructor = current_expand.base;
+  gfc_free_constructor (e->value.constructor);
+  e->value.constructor = current_expand.new_head;
 
   rc = SUCCESS;
 
@@ -1616,14 +1688,37 @@ gfc_constant_ac (gfc_expr *e)
 {
   expand_info expand_save;
   gfc_try rc;
+  gfc_constructor * con;
+  
+  rc = SUCCESS;
 
-  iter_stack = NULL;
-  expand_save = current_expand;
-  current_expand.expand_work_function = is_constant_element;
+  if (e->value.constructor
+      && e->value.constructor->expr->expr_type == EXPR_ARRAY)
+    {
+      /* Expand the constructor.  */
+      iter_stack = NULL;
+      expand_save = current_expand;
+      current_expand.expand_work_function = is_constant_element;
 
-  rc = expand_constructor (e->value.constructor);
+      rc = expand_constructor (e->value.constructor);
+
+      current_expand = expand_save;
+    }
+  else
+    {
+      /* No need to expand this further.  */
+      for (con = e->value.constructor; con; con = con->next)
+       {
+         if (con->expr->expr_type == EXPR_CONSTANT)
+           continue;
+         else
+           {
+             if (!gfc_is_constant_expr (con->expr))
+               rc = FAILURE;
+           }
+       }
+    }
 
-  current_expand = expand_save;
   if (rc == FAILURE)
     return 0;
 
@@ -1637,12 +1732,11 @@ gfc_constant_ac (gfc_expr *e)
 int
 gfc_expanded_ac (gfc_expr *e)
 {
-  gfc_constructor *c;
+  gfc_constructor *p;
 
   if (e->expr_type == EXPR_ARRAY)
-    for (c = gfc_constructor_first (e->value.constructor);
-        c; c = gfc_constructor_next (c))
-      if (c->iterator != NULL || !gfc_expanded_ac (c->expr))
+    for (p = e->value.constructor; p; p = p->next)
+      if (p->iterator != NULL || !gfc_expanded_ac (p->expr))
        return 0;
 
   return 1;
@@ -1655,20 +1749,19 @@ gfc_expanded_ac (gfc_expr *e)
    be of the same type.  */
 
 static gfc_try
-resolve_array_list (gfc_constructor_base base)
+resolve_array_list (gfc_constructor *p)
 {
   gfc_try t;
-  gfc_constructor *c;
 
   t = SUCCESS;
 
-  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
+  for (; p; p = p->next)
     {
-      if (c->iterator != NULL
-         && gfc_resolve_iterator (c->iterator, false) == FAILURE)
+      if (p->iterator != NULL
+         && gfc_resolve_iterator (p->iterator, false) == FAILURE)
        t = FAILURE;
 
-      if (gfc_resolve_expr (c->expr) == FAILURE)
+      if (gfc_resolve_expr (p->expr) == FAILURE)
        t = FAILURE;
     }
 
@@ -1691,8 +1784,7 @@ gfc_resolve_character_array_constructor (gfc_expr *expr)
 
   if (expr->ts.u.cl == NULL)
     {
-      for (p = gfc_constructor_first (expr->value.constructor);
-          p; p = gfc_constructor_next (p))
+      for (p = expr->value.constructor; p; p = p->next)
        if (p->expr->ts.u.cl != NULL)
          {
            /* Ensure that if there is a char_len around that it is
@@ -1713,8 +1805,7 @@ got_charlen:
       /* Check that all constant string elements have the same length until
         we reach the end or find a variable-length one.  */
 
-      for (p = gfc_constructor_first (expr->value.constructor);
-          p; p = gfc_constructor_next (p))
+      for (p = expr->value.constructor; p; p = p->next)
        {
          int current_length = -1;
          gfc_ref *ref;
@@ -1761,8 +1852,7 @@ got_charlen:
       gcc_assert (found_length != -1);
 
       /* Update the character length of the array constructor.  */
-      expr->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
-                                               NULL, found_length);
+      expr->ts.u.cl->length = gfc_int_expr (found_length);
     }
   else 
     {
@@ -1780,8 +1870,7 @@ got_charlen:
         (without typespec) all elements are verified to have the same length
         anyway.  */
       if (found_length != -1)
-       for (p = gfc_constructor_first (expr->value.constructor);
-            p; p = gfc_constructor_next (p))
+       for (p = expr->value.constructor; p; p = p->next)
          if (p->expr->expr_type == EXPR_CONSTANT)
            {
              gfc_expr *cl = NULL;
@@ -1831,8 +1920,8 @@ gfc_resolve_array_constructor (gfc_expr *expr)
 
 /* Copy an iterator structure.  */
 
-gfc_iterator *
-gfc_copy_iterator (gfc_iterator *src)
+static gfc_iterator *
+copy_iterator (gfc_iterator *src)
 {
   gfc_iterator *dest;
 
@@ -1850,6 +1939,73 @@ gfc_copy_iterator (gfc_iterator *src)
 }
 
 
+/* Copy a constructor structure.  */
+
+gfc_constructor *
+gfc_copy_constructor (gfc_constructor *src)
+{
+  gfc_constructor *dest;
+  gfc_constructor *tail;
+
+  if (src == NULL)
+    return NULL;
+
+  dest = tail = NULL;
+  while (src)
+    {
+      if (dest == NULL)
+       dest = tail = gfc_get_constructor ();
+      else
+       {
+         tail->next = gfc_get_constructor ();
+         tail = tail->next;
+       }
+      tail->where = src->where;
+      tail->expr = gfc_copy_expr (src->expr);
+      tail->iterator = copy_iterator (src->iterator);
+      mpz_set (tail->n.offset, src->n.offset);
+      tail->n.component = src->n.component;
+      mpz_set (tail->repeat, src->repeat);
+      src = src->next;
+    }
+
+  return dest;
+}
+
+
+/* Given an array expression and an element number (starting at zero),
+   return a pointer to the array element.  NULL is returned if the
+   size of the array has been exceeded.  The expression node returned
+   remains a part of the array and should not be freed.  Access is not
+   efficient at all, but this is another place where things do not
+   have to be particularly fast.  */
+
+gfc_expr *
+gfc_get_array_element (gfc_expr *array, int element)
+{
+  expand_info expand_save;
+  gfc_expr *e;
+  gfc_try rc;
+
+  expand_save = current_expand;
+  current_expand.extract_n = element;
+  current_expand.expand_work_function = extract_element;
+  current_expand.extracted = NULL;
+  current_expand.extract_count = 0;
+
+  iter_stack = NULL;
+
+  rc = expand_constructor (array->value.constructor);
+  e = current_expand.extracted;
+  current_expand = expand_save;
+
+  if (rc == FAILURE)
+    return NULL;
+
+  return e;
+}
+
+
 /********* Subroutines for determining the size of an array *********/
 
 /* These are needed just to accommodate RESHAPE().  There are no
@@ -2223,8 +2379,7 @@ gfc_find_array_ref (gfc_expr *e)
 
   for (ref = e->ref; ref; ref = ref->next)
     if (ref->type == REF_ARRAY
-       && (ref->u.ar.type == AR_FULL || ref->u.ar.type == AR_SECTION
-           || (ref->u.ar.type == AR_ELEMENT && ref->u.ar.dimen == 0)))
+       && (ref->u.ar.type == AR_FULL || ref->u.ar.type == AR_SECTION))
       break;
 
   if (ref == NULL)