2010-04-12 Jerry DeLisle <jvdelisle@gcc.gnu.org>

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

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 171eeaa..bd2791a 100644 (file)
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -31,6 +31,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "flags.h"
 #include "gfortran.h"
 #include "intrinsic.h"
+#include "constructor.h"
 
 
 /* Make sure an expression is a scalar.  */
@@ -599,10 +600,8 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
 
   where = &pointer->where;
 
-  if (pointer->expr_type == EXPR_VARIABLE)
-    attr1 = gfc_variable_attr (pointer, NULL);
-  else if (pointer->expr_type == EXPR_FUNCTION)
-    attr1 = pointer->symtree->n.sym->attr;
+  if (pointer->expr_type == EXPR_VARIABLE || pointer->expr_type == EXPR_FUNCTION)
+    attr1 = gfc_expr_attr (pointer);
   else if (pointer->expr_type == EXPR_NULL)
     goto null_arg;
   else
@@ -624,10 +623,8 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
   if (target->expr_type == EXPR_NULL)
     goto null_arg;
 
-  if (target->expr_type == EXPR_VARIABLE)
-    attr2 = gfc_variable_attr (target, NULL);
-  else if (target->expr_type == EXPR_FUNCTION)
-    attr2 = target->symtree->n.sym->attr;
+  if (target->expr_type == EXPR_VARIABLE || target->expr_type == EXPR_FUNCTION)
+    attr2 = gfc_expr_attr (target);
   else
     {
       gfc_error ("'%s' argument of '%s' intrinsic at %L must be a pointer "
@@ -2270,7 +2267,8 @@ gfc_check_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector)
 
          if (mask->expr_type == EXPR_ARRAY)
            {
-             gfc_constructor *mask_ctor = mask->value.constructor;
+             gfc_constructor *mask_ctor;
+             mask_ctor = gfc_constructor_first (mask->value.constructor);
              while (mask_ctor)
                {
                  if (mask_ctor->expr->expr_type != EXPR_CONSTANT)
@@ -2282,7 +2280,7 @@ gfc_check_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector)
                  if (mask_ctor->expr->value.logical)
                    mask_true_values++;
 
-                 mask_ctor = mask_ctor->next;
+                 mask_ctor = gfc_constructor_next (mask_ctor);
                }
            }
          else if (mask->expr_type == EXPR_CONSTANT && mask->value.logical)
@@ -2512,12 +2510,9 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
       int i, extent;
       for (i = 0; i < shape_size; ++i)
        {
-         e = gfc_get_array_element (shape, i);
+         e = gfc_constructor_lookup_expr (shape->value.constructor, i);
          if (e->expr_type != EXPR_CONSTANT)
-           {
-             gfc_free_expr (e);
-             continue;
-           }
+           continue;
 
          gfc_extract_int (e, &extent);
          if (extent < 0)
@@ -2527,8 +2522,6 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
                         gfc_current_intrinsic, &e->where, extent);
              return FAILURE;
            }
-
-         gfc_free_expr (e);
        }
     }
 
@@ -2573,12 +2566,9 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
 
          for (i = 1; i <= order_size; ++i)
            {
-             e = gfc_get_array_element (order, i-1);
+             e = gfc_constructor_lookup_expr (order->value.constructor, i-1);
              if (e->expr_type != EXPR_CONSTANT)
-               {
-                 gfc_free_expr (e);
-                 continue;
-               }
+               continue;
 
              gfc_extract_int (e, &dim);
 
@@ -2601,7 +2591,6 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
                }
 
              perm[dim-1] = 1;
-             gfc_free_expr (e);
            }
        }
     }
@@ -2617,9 +2606,10 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
          gfc_constructor *c;
          bool test;
 
-         c = shape->value.constructor;
+         
          mpz_init_set_ui (size, 1);
-         for (; c; c = c->next)
+         for (c = gfc_constructor_first (shape->value.constructor);
+              c; c = gfc_constructor_next (c))
            mpz_mul (size, size, c->expr->value.integer);
 
          test = mpz_cmp (nelems, size) < 0 && mpz_cmp_ui (size, 0) > 0;
@@ -3228,7 +3218,8 @@ gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field)
       && gfc_array_size (vector, &vector_size) == SUCCESS)
     {
       int mask_true_count = 0;
-      gfc_constructor *mask_ctor = mask->value.constructor;
+      gfc_constructor *mask_ctor;
+      mask_ctor = gfc_constructor_first (mask->value.constructor);
       while (mask_ctor)
        {
          if (mask_ctor->expr->expr_type != EXPR_CONSTANT)
@@ -3240,7 +3231,7 @@ gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field)
          if (mask_ctor->expr->value.logical)
            mask_true_count++;
 
-         mask_ctor = mask_ctor->next;
+         mask_ctor = gfc_constructor_next (mask_ctor);
        }
 
       if (mpz_get_si (vector_size) < mask_true_count)