2004-10-03 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>

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

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index e2eac02..ac1ea6f 100644 (file)
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -1,5 +1,5 @@
 /* Array things
-   Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
+   Copyright (C) 2000, 2001, 2002, 2004 Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of GCC.
@@ -24,7 +24,6 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 #include "match.h"
 
 #include <string.h>
-#include <assert.h>
 
 /* This parameter is the size of the largest array constructor that we
    will expand to an array constructor without iterators.
@@ -77,7 +76,7 @@ match_subscript (gfc_array_ref * ar, int init)
 
   i = ar->dimen;
 
-  ar->c_where[i] = *gfc_current_locus ();
+  ar->c_where[i] = gfc_current_locus;
   ar->start[i] = ar->end[i] = ar->stride[i] = NULL;
 
   /* We can't be sure of the difference between DIMEN_ELEMENT and
@@ -143,7 +142,7 @@ gfc_match_array_ref (gfc_array_ref * ar, gfc_array_spec * as, int init)
 
   memset (ar, '\0', sizeof (ar));
 
-  ar->where = *gfc_current_locus ();
+  ar->where = gfc_current_locus;
   ar->as = as;
 
   if (gfc_match_char ('(') != MATCH_YES)
@@ -605,6 +604,7 @@ gfc_insert_constructor (gfc_expr * base, gfc_constructor * c1)
 {
   gfc_constructor *c, *pre;
   expr_t type;
+  int t;
 
   type = base->expr_type;
 
@@ -617,12 +617,13 @@ gfc_insert_constructor (gfc_expr * base, gfc_constructor * c1)
         {
           if (type == EXPR_ARRAY)
             {
-              if (mpz_cmp (c->n.offset, c1->n.offset) < 0)
+             t = mpz_cmp (c->n.offset, c1->n.offset);
+              if (t < 0)
                 {
                   pre = c;
                   c = c->next;
                 }
-              else if (mpz_cmp (c->n.offset, c1->n.offset) == 0)
+              else if (t == 0)
                 {
                   gfc_error ("duplicated initializer");
                   break;
@@ -743,7 +744,7 @@ match_array_list (gfc_constructor ** result)
   match m;
   int n;
 
-  old_loc = *gfc_current_locus ();
+  old_loc = gfc_current_locus;
 
   if (gfc_match_char ('(') == MATCH_NO)
     return MATCH_NO;
@@ -809,7 +810,7 @@ match_array_list (gfc_constructor ** result)
   e->value.constructor = head;
 
   p = gfc_get_constructor ();
-  p->where = *gfc_current_locus ();
+  p->where = gfc_current_locus;
   p->iterator = gfc_get_iterator ();
   *p->iterator = iter;
 
@@ -825,7 +826,7 @@ syntax:
 cleanup:
   gfc_free_constructor (head);
   gfc_free_iterator (&iter, 0);
-  gfc_set_locus (&old_loc);
+  gfc_current_locus = old_loc;
   return m;
 }
 
@@ -849,7 +850,7 @@ match_array_cons_element (gfc_constructor ** result)
     return m;
 
   p = gfc_get_constructor ();
-  p->where = *gfc_current_locus ();
+  p->where = gfc_current_locus;
   p->expr = expr;
 
   *result = p;
@@ -870,7 +871,7 @@ gfc_match_array_constructor (gfc_expr ** result)
   if (gfc_match (" (/") == MATCH_NO)
     return MATCH_NO;
 
-  where = *gfc_current_locus ();
+  where = gfc_current_locus;
   head = tail = NULL;
 
   if (gfc_match (" /)") == MATCH_YES)
@@ -940,7 +941,7 @@ check_element_type (gfc_expr * expr)
 {
 
   if (cons_state == CONS_BAD)
-    return 0;                  /* Supress further errors */
+    return 0;                  /* Suppress further errors */
 
   if (cons_state == CONS_START)
     {
@@ -1606,7 +1607,7 @@ gfc_get_array_element (gfc_expr * array, int element)
 
 /********* Subroutines for determining the size of an array *********/
 
-/* These are needed just to accomodate RESHAPE().  There are no
+/* These are needed just to accommodate RESHAPE().  There are no
    diagnostics here, we just return a negative number if something
    goes wrong. */
 
@@ -1971,3 +1972,22 @@ gfc_find_array_ref (gfc_expr * e)
 
   return &ref->u.ar;
 }
+
+
+/* Find out if an array shape is known at compile time.  */
+
+int
+gfc_is_compile_time_shape (gfc_array_spec *as)
+{
+  int i;
+
+  if (as->type != AS_EXPLICIT)
+    return 0;
+
+  for (i = 0; i < as->rank; i++)
+    if (!gfc_is_constant_expr (as->lower[i])
+       || !gfc_is_constant_expr (as->upper[i]))
+      return 0;
+
+  return 1;
+}