1 files changed, 125 insertions, 14 deletions

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index b36d517cff7..07fecd8aaf3 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -1,6 +1,6 @@
 /* Array things
-   Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010
-   Free Software Foundation, Inc.
+   Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+   2011, 2012 Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of GCC.
@@ -21,6 +21,7 @@ along with GCC; see the file COPYING3.  If not see
 
 #include "config.h"
 #include "system.h"
+#include "coretypes.h"
 #include "gfortran.h"
 #include "match.h"
 #include "constructor.h"
@@ -49,8 +50,6 @@ gfc_copy_array_ref (gfc_array_ref *src)
       dest->stride[i] = gfc_copy_expr (src->stride[i]);
     }
 
-  dest->offset = gfc_copy_expr (src->offset);
-
   return dest;
 }
 
@@ -160,7 +159,7 @@ 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));
+  memset (ar, '\0', sizeof (*ar));
 
   ar->where = gfc_current_locus;
   ar->as = as;
@@ -389,9 +388,11 @@ match_array_element_spec (gfc_array_spec *as)
 {
   gfc_expr **upper, **lower;
   match m;
+  int rank;
 
-  lower = &as->lower[as->rank + as->corank - 1];
-  upper = &as->upper[as->rank + as->corank - 1];
+  rank = as->rank == -1 ? 0 : as->rank;
+  lower = &as->lower[rank + as->corank - 1];
+  upper = &as->upper[rank + as->corank - 1];
 
   if (gfc_match_char ('*') == MATCH_YES)
     {
@@ -457,6 +458,20 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
       goto coarray;
     }
 
+  if (gfc_match (" .. )") == MATCH_YES)
+    {
+      as->type = AS_ASSUMED_RANK;
+      as->rank = -1;
+
+      if (gfc_notify_std (GFC_STD_F2008_TS, "Assumed-rank array at %C")
+	  == FAILURE)
+	goto cleanup;
+
+      if (!match_codim)
+	goto done;
+      goto coarray;
+    }
+
   for (;;)
     {
       as->rank++;
@@ -535,6 +550,9 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
 
 	    gfc_error ("Bad specification for assumed size array at %C");
 	    goto cleanup;
+
+	  case AS_ASSUMED_RANK:
+	    gcc_unreachable (); 
 	  }
 
       if (gfc_match_char (')') == MATCH_YES)
@@ -554,7 +572,7 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
 	}
 
       if (as->corank + as->rank >= 7
-	  && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Array "
+	  && gfc_notify_std (GFC_STD_F2008, "Array "
 			     "specification at %C with more than 7 dimensions")
 	     == FAILURE)
 	goto cleanup;
@@ -567,7 +585,7 @@ coarray:
   if (gfc_match_char ('[')  != MATCH_YES)
     goto done;
 
-  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Coarray declaration at %C")
+  if (gfc_notify_std (GFC_STD_F2008, "Coarray declaration at %C")
       == FAILURE)
     goto cleanup;
 
@@ -641,6 +659,9 @@ coarray:
 	    case AS_ASSUMED_SIZE:
 	      gfc_error ("Bad specification for assumed size array at %C");
 	      goto cleanup;
+
+	    case AS_ASSUMED_RANK:
+	      gcc_unreachable (); 
 	  }
 
       if (gfc_match_char (']') == MATCH_YES)
@@ -727,6 +748,14 @@ gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc)
       return SUCCESS;
     }
 
+  if ((sym->as->type == AS_ASSUMED_RANK && as->corank)
+      || (as->type == AS_ASSUMED_RANK && sym->as->corank))
+    {
+      gfc_error ("The assumed-rank array '%s' at %L shall not have a "
+		 "codimension", sym->name, error_loc);
+      return FAILURE;
+    }
+
   if (as->corank)
     {
       /* The "sym" has no corank (checked via gfc_add_codimension). Thus
@@ -1026,7 +1055,7 @@ gfc_match_array_constructor (gfc_expr **result)
 	return MATCH_NO;
       else
 	{
-	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: [...] "
+	  if (gfc_notify_std (GFC_STD_F2003, "[...] "
 			      "style array constructors at %C") == FAILURE)
 	    return MATCH_ERROR;
 	  end_delim = " ]";
@@ -1046,7 +1075,7 @@ gfc_match_array_constructor (gfc_expr **result)
 
       if (seen_ts)
 	{
-	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Array constructor "
+	  if (gfc_notify_std (GFC_STD_F2003, "Array constructor "
 			      "including type specification at %C") == FAILURE)
 	    goto cleanup;
 
@@ -1717,6 +1746,50 @@ gfc_expanded_ac (gfc_expr *e)
 
 /*************** Type resolution of array constructors ***************/
 
+
+/* The symbol expr_is_sought_symbol_ref will try to find.  */
+static const gfc_symbol *sought_symbol = NULL;
+
+
+/* Tells whether the expression E is a variable reference to the symbol
+   in the static variable SOUGHT_SYMBOL, and sets the locus pointer WHERE
+   accordingly.
+   To be used with gfc_expr_walker: if a reference is found we don't need
+   to look further so we return 1 to skip any further walk.  */
+
+static int
+expr_is_sought_symbol_ref (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+			   void *where)
+{
+  gfc_expr *expr = *e;
+  locus *sym_loc = (locus *)where;
+
+  if (expr->expr_type == EXPR_VARIABLE
+      && expr->symtree->n.sym == sought_symbol)
+    {
+      *sym_loc = expr->where;
+      return 1;
+    }
+
+  return 0;
+}
+
+
+/* Tells whether the expression EXPR contains a reference to the symbol
+   SYM and in that case sets the position SYM_LOC where the reference is.  */
+
+static bool
+find_symbol_in_expr (gfc_symbol *sym, gfc_expr *expr, locus *sym_loc)
+{
+  int ret;
+
+  sought_symbol = sym;
+  ret = gfc_expr_walker (&expr, &expr_is_sought_symbol_ref, sym_loc);
+  sought_symbol = NULL;
+  return ret;
+}
+
+
 /* Recursive array list resolution function.  All of the elements must
    be of the same type.  */
 
@@ -1725,14 +1798,46 @@ resolve_array_list (gfc_constructor_base base)
 {
   gfc_try t;
   gfc_constructor *c;
+  gfc_iterator *iter;
 
   t = SUCCESS;
 
   for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
     {
-      if (c->iterator != NULL
-	  && gfc_resolve_iterator (c->iterator, false) == FAILURE)
-	t = FAILURE;
+      iter = c->iterator;
+      if (iter != NULL)
+        {
+	  gfc_symbol *iter_var;
+	  locus iter_var_loc;
+	 
+	  if (gfc_resolve_iterator (iter, false) == FAILURE)
+	    t = FAILURE;
+
+	  /* Check for bounds referencing the iterator variable.  */
+	  gcc_assert (iter->var->expr_type == EXPR_VARIABLE);
+	  iter_var = iter->var->symtree->n.sym;
+	  if (find_symbol_in_expr (iter_var, iter->start, &iter_var_loc))
+	    {
+	      if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO initial "
+				  "expression references control variable "
+				  "at %L", &iter_var_loc) == FAILURE)
+	       t = FAILURE;
+	    }
+	  if (find_symbol_in_expr (iter_var, iter->end, &iter_var_loc))
+	    {
+	      if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO final "
+				  "expression references control variable "
+				  "at %L", &iter_var_loc) == FAILURE)
+	       t = FAILURE;
+	    }
+	  if (find_symbol_in_expr (iter_var, iter->step, &iter_var_loc))
+	    {
+	      if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO step "
+				  "expression references control variable "
+				  "at %L", &iter_var_loc) == FAILURE)
+	       t = FAILURE;
+	    }
+	}
 
       if (gfc_resolve_expr (c->expr) == FAILURE)
 	t = FAILURE;
@@ -1959,6 +2064,9 @@ spec_size (gfc_array_spec *as, mpz_t *result)
   mpz_t size;
   int d;
 
+  if (as->type == AS_ASSUMED_RANK)
+    return FAILURE;
+
   mpz_init_set_ui (*result, 1);
 
   for (d = 0; d < as->rank; d++)
@@ -2115,6 +2223,9 @@ gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result)
   if (array->ts.type == BT_CLASS)
     return FAILURE;
 
+  if (array->rank == -1)
+    return FAILURE;
+
   if (dimen < 0 || array == NULL || dimen > array->rank - 1)
     gfc_internal_error ("gfc_array_dimen_size(): Bad dimension");