* array.c (gfc_find_array_ref): Remove coarray-specific handling.

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

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 0d92e92..3e6b9d2 100644 (file)
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -237,6 +237,12 @@ coarray:
                         corank, ar->codimen);
              return MATCH_ERROR;
            }
+         if (ar->codimen > corank)
+           {
+             gfc_error ("Too many codimensions at %C, expected %d not %d",
+                        corank, ar->codimen);
+             return MATCH_ERROR;
+           }
          return MATCH_YES;
        }
 
@@ -283,7 +289,7 @@ gfc_free_array_spec (gfc_array_spec *as)
       gfc_free_expr (as->upper[i]);
     }
 
-  gfc_free (as);
+  free (as);
 }
 
 
@@ -437,16 +443,8 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
   array_type current_type;
   gfc_array_spec *as;
   int i;
- 
-  as = gfc_get_array_spec ();
-  as->corank = 0;
-  as->rank = 0;
 
-  for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
-    {
-      as->lower[i] = NULL;
-      as->upper[i] = NULL;
-    }
+  as = gfc_get_array_spec ();
 
   if (!match_dim)
     goto coarray;
@@ -463,6 +461,12 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
       as->rank++;
       current_type = match_array_element_spec (as);
 
+      /* Note that current_type == AS_ASSUMED_SIZE for both assumed-size
+        and implied-shape specifications.  If the rank is at least 2, we can
+        distinguish between them.  But for rank 1, we currently return
+        ASSUMED_SIZE; this gets adjusted later when we know for sure
+        whether the symbol parsed is a PARAMETER or not.  */
+
       if (as->rank == 1)
        {
          if (current_type == AS_UNKNOWN)
@@ -475,6 +479,15 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
          case AS_UNKNOWN:
            goto cleanup;
 
+         case AS_IMPLIED_SHAPE:
+           if (current_type != AS_ASSUMED_SHAPE)
+             {
+               gfc_error ("Bad array specification for implied-shape"
+                          " array at %C");
+               goto cleanup;
+             }
+           break;
+
          case AS_EXPLICIT:
            if (current_type == AS_ASSUMED_SIZE)
              {
@@ -513,6 +526,12 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
            goto cleanup;
 
          case AS_ASSUMED_SIZE:
+           if (as->rank == 2 && current_type == AS_ASSUMED_SIZE)
+             {
+               as->type = AS_IMPLIED_SHAPE;
+               break;
+             }
+
            gfc_error ("Bad specification for assumed size array at %C");
            goto cleanup;
          }
@@ -557,6 +576,13 @@ coarray:
       goto cleanup;
     }
 
+  if (as->rank >= GFC_MAX_DIMENSIONS)
+    {
+      gfc_error ("Array specification at %C has more than %d "
+                "dimensions", GFC_MAX_DIMENSIONS);
+      goto cleanup;
+    }
+
   for (;;)
     {
       as->corank++;
@@ -570,6 +596,7 @@ coarray:
       else
        switch (as->cotype)
          { /* See how current spec meshes with the existing.  */
+           case AS_IMPLIED_SHAPE:
            case AS_UNKNOWN:
              goto cleanup;
 
@@ -624,7 +651,7 @@ coarray:
          goto cleanup;
        }
 
-      if (as->corank >= GFC_MAX_DIMENSIONS)
+      if (as->rank + as->corank >= GFC_MAX_DIMENSIONS)
        {
          gfc_error ("Array specification at %C has more than %d "
                     "dimensions", GFC_MAX_DIMENSIONS);
@@ -737,7 +764,7 @@ gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc)
        }
     }
 
-  gfc_free (as);
+  free (as);
   return SUCCESS;
 }
 
@@ -1021,6 +1048,13 @@ gfc_match_array_constructor (gfc_expr **result)
          if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Array constructor "
                              "including type specification at %C") == FAILURE)
            goto cleanup;
+
+         if (ts.deferred)
+           {
+             gfc_error ("Type-spec at %L cannot contain a deferred "
+                        "type parameter", &where);
+             goto cleanup;
+           }
        }
     }
 
@@ -1288,6 +1322,7 @@ typedef struct
 
   mpz_t *offset;
   gfc_component *component;
+  mpz_t *repeat;
 
   gfc_try (*expand_work_function) (gfc_expr *);
 }
@@ -1522,6 +1557,7 @@ expand_constructor (gfc_constructor_base base)
          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;
@@ -1940,10 +1976,11 @@ spec_size (gfc_array_spec *as, mpz_t *result)
 }
 
 
-/* Get the number of elements in an array section.  */
+/* Get the number of elements in an array section. Optionally, also supply
+   the end value.  */
 
 gfc_try
-gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result)
+gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end)
 {
   mpz_t upper, lower, stride;
   gfc_try t;
@@ -2016,6 +2053,15 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result)
        mpz_set_ui (*result, 0);
       t = SUCCESS;
 
+      if (end)
+       {
+         mpz_init (*end);
+
+         mpz_sub_ui (*end, *result, 1UL);
+         mpz_mul (*end, *end, stride);
+         mpz_add (*end, *end, lower);
+       }
+
     cleanup:
       mpz_clear (upper);
       mpz_clear (lower);
@@ -2040,7 +2086,7 @@ ref_size (gfc_array_ref *ar, mpz_t *result)
 
   for (d = 0; d < ar->dimen; d++)
     {
-      if (gfc_ref_dimen_size (ar, d, &size) == FAILURE)
+      if (gfc_ref_dimen_size (ar, d, &size, NULL) == FAILURE)
        {
          mpz_clear (*result);
          return FAILURE;
@@ -2086,7 +2132,7 @@ gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result)
                if (ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
                  dimen--;
 
-             return gfc_ref_dimen_size (&ref->u.ar, i - 1, result);
+             return gfc_ref_dimen_size (&ref->u.ar, i - 1, result, NULL);
            }
        }
 
@@ -2222,7 +2268,7 @@ gfc_array_ref_shape (gfc_array_ref *ar, mpz_t *shape)
        {
          if (ar->dimen_type[i] != DIMEN_ELEMENT)
            {
-             if (gfc_ref_dimen_size (ar, i, &shape[d]) == FAILURE)
+             if (gfc_ref_dimen_size (ar, i, &shape[d], NULL) == FAILURE)
                goto cleanup;
              d++;
            }
@@ -2235,9 +2281,7 @@ gfc_array_ref_shape (gfc_array_ref *ar, mpz_t *shape)
     }
 
 cleanup:
-  for (d--; d >= 0; d--)
-    mpz_clear (shape[d]);
-
+  gfc_clear_shape (shape, d);
   return FAILURE;
 }
 
@@ -2252,8 +2296,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)