* simplify.c (gfc_simplify_transfer): Zero-initialize the

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

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 34105bc..7be4671 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -1,5 +1,5 @@
 /* Simplify intrinsic functions at compile-time.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
    Free Software Foundation, Inc.
    Contributed by Andy Vaught & Katherine Holcomb
 
@@ -2178,7 +2178,7 @@ gfc_simplify_kind (gfc_expr *e)
 
 static gfc_expr *
 simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper,
-                   gfc_array_spec *as)
+                   gfc_array_spec *as, gfc_ref *ref)
 {
   gfc_expr *l, *u, *result;
   int k;
@@ -2192,13 +2192,6 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper,
        return NULL;
     }
 
-  /* Then, we need to know the extent of the given dimension.  */
-  l = as->lower[d-1];
-  u = as->upper[d-1];
-
-  if (l->expr_type != EXPR_CONSTANT || u->expr_type != EXPR_CONSTANT)
-    return NULL;
-
   k = get_kind (BT_INTEGER, kind, upper ? "UBOUND" : "LBOUND",
                gfc_default_integer_kind); 
   if (k == -1)
@@ -2206,21 +2199,43 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper,
 
   result = gfc_constant_result (BT_INTEGER, k, &array->where);
 
-  if (mpz_cmp (l->value.integer, u->value.integer) > 0)
+
+  /* Then, we need to know the extent of the given dimension.  */
+  if (ref->u.ar.type == AR_FULL)
     {
-      /* Zero extent.  */
-      if (upper)
-       mpz_set_si (result->value.integer, 0);
+      l = as->lower[d-1];
+      u = as->upper[d-1];
+
+      if (l->expr_type != EXPR_CONSTANT || u->expr_type != EXPR_CONSTANT)
+       return NULL;
+
+      if (mpz_cmp (l->value.integer, u->value.integer) > 0)
+       {
+         /* Zero extent.  */
+         if (upper)
+           mpz_set_si (result->value.integer, 0);
+         else
+           mpz_set_si (result->value.integer, 1);
+       }
       else
-       mpz_set_si (result->value.integer, 1);
+       {
+         /* Nonzero extent.  */
+         if (upper)
+           mpz_set (result->value.integer, u->value.integer);
+         else
+           mpz_set (result->value.integer, l->value.integer);
+       }
     }
   else
     {
-      /* Nonzero extent.  */
       if (upper)
-       mpz_set (result->value.integer, u->value.integer);
+       {
+         if (gfc_ref_dimen_size (&ref->u.ar, d-1, &result->value.integer)
+             != SUCCESS)
+           return NULL;
+       }
       else
-       mpz_set (result->value.integer, l->value.integer);
+       mpz_set_si (result->value.integer, (long int) 1);
     }
 
   return range_check (result, upper ? "UBOUND" : "LBOUND");
@@ -2253,11 +2268,17 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
            case AR_FULL:
              /* We're done because 'as' has already been set in the
                 previous iteration.  */
-             goto done;
+             if (!ref->next)
+               goto done;
+
+           /* Fall through.  */
 
-           case AR_SECTION:
            case AR_UNKNOWN:
              return NULL;
+
+           case AR_SECTION:
+             as = ref->u.ar.as;
+             goto done;
            }
 
          gcc_unreachable ();
@@ -2297,7 +2318,7 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
       /* Simplify the bounds for each dimension.  */
       for (d = 0; d < array->rank; d++)
        {
-         bounds[d] = simplify_bound_dim (array, kind, d + 1, upper, as);
+         bounds[d] = simplify_bound_dim (array, kind, d + 1, upper, as, ref);
          if (bounds[d] == NULL || bounds[d] == &gfc_bad_expr)
            {
              int j;
@@ -2363,7 +2384,7 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
          return &gfc_bad_expr;
        }
 
-      return simplify_bound_dim (array, kind, d, upper, as);
+      return simplify_bound_dim (array, kind, d, upper, as, ref);
     }
 }
 
@@ -2619,6 +2640,18 @@ gfc_simplify_logical (gfc_expr *e, gfc_expr *k)
 }
 
 
+gfc_expr *
+gfc_simplify_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
+{
+  if (tsource->expr_type != EXPR_CONSTANT
+      || fsource->expr_type != EXPR_CONSTANT
+      || mask->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_copy_expr (mask->value.logical ? tsource : fsource);
+}
+
+
 /* Selects bewteen current value and extremum for simplify_min_max
    and simplify_minval_maxval.  */
 static void
@@ -2993,6 +3026,7 @@ gfc_simplify_nearest (gfc_expr *x, gfc_expr *s)
   mpfr_set_emin ((mp_exp_t) gfc_real_kinds[kind].min_exponent -
                mpfr_get_prec(result->value.real) + 1);
   mpfr_set_emax ((mp_exp_t) gfc_real_kinds[kind].max_exponent - 1);
+  mpfr_check_range (result->value.real, 0, GMP_RNDU);
 
   if (mpfr_sgn (s->value.real) > 0)
     {
@@ -3410,9 +3444,6 @@ is_constant_array_expr (gfc_expr *e)
   if (e->expr_type != EXPR_ARRAY || !gfc_is_constant_expr (e))
     return false;
   
-  if (e->value.constructor == NULL)
-    return false;
-  
   for (c = e->value.constructor; c; c = c->next)
     if (c->expr->expr_type != EXPR_CONSTANT)
       return false;
@@ -4510,6 +4541,7 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
   /* Allocate the buffer to store the binary version of the source.  */
   buffer_size = MAX (source_size, result_size);
   buffer = (unsigned char*)alloca (buffer_size);
+  memset (buffer, 0, buffer_size);
 
   /* Now write source to the buffer.  */
   gfc_target_encode_expr (source, buffer, buffer_size);