2013-05-02 Tobias Burnus <burnus@net-b.de>

        PR fortran/57142
        * simplify.c (gfc_simplify_size): Renamed from
        simplify_size; fix kind=8 handling.
        (gfc_simplify_size): New function.
        (gfc_simplify_shape): Add range check.
        * resolve.c (resolve_function): Fix handling
        for ISYM_SIZE.

2013-05-02  Tobias Burnus  <burnus@net-b.de>

        PR fortran/57142
        * gfortran.dg/size_kind_2.f90: New.
        * gfortran.dg/size_kind_3.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@198549 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e154fa2..c523473 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2013-05-02  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/57142
+       * simplify.c (gfc_simplify_size): Renamed from
+       simplify_size; fix kind=8 handling.
+       (gfc_simplify_size): New function.
+       (gfc_simplify_shape): Add range check.
+       * resolve.c (resolve_function): Fix handling
+       for ISYM_SIZE.
+
 2013-05-01  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        * frontend-passes.c (optimize_power):  Fix typo

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 6e1f56f..2860e41 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2861,6 +2861,7 @@ resolve_function (gfc_expr *expr)
       for (arg = expr->value.function.actual; arg; arg = arg->next)
        {
          if ((GENERIC_ID == GFC_ISYM_UBOUND || GENERIC_ID == GFC_ISYM_SIZE)
+             && arg == expr->value.function.actual
              && arg->next != NULL && arg->next->expr)
            {
              if (arg->next->expr->expr_type != EXPR_CONSTANT)

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 02505db..815043b 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -33,6 +33,8 @@ along with GCC; see the file COPYING3.  If not see
 
 gfc_expr gfc_bad_expr;
 
+static gfc_expr *simplify_size (gfc_expr *, gfc_expr *, int);
+
 
 /* Note that 'simplification' is not just transforming expressions.
    For functions that are not simplified at compile time, range
@@ -3248,7 +3250,7 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper,
          gfc_expr* dim = result;
          mpz_set_si (dim->value.integer, d);
 
-         result = gfc_simplify_size (array, dim, kind);
+         result = simplify_size (array, dim, k);
          gfc_free_expr (dim);
          if (!result)
            goto returnNull;
@@ -5538,15 +5540,12 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind)
       e = gfc_get_constant_expr (BT_INTEGER, k, &source->where);
 
       if (t)
-       {
-         mpz_set (e->value.integer, shape[n]);
-         mpz_clear (shape[n]);
-       }
+       mpz_set (e->value.integer, shape[n]);
       else
        {
          mpz_set_ui (e->value.integer, n + 1);
 
-         f = gfc_simplify_size (source, e, NULL);
+         f = simplify_size (source, e, k);
          gfc_free_expr (e);
          if (f == NULL)
            {
@@ -5557,23 +5556,30 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind)
            e = f;
        }
 
+      if (e == &gfc_bad_expr || range_check (e, "SHAPE") == &gfc_bad_expr)
+       {
+         gfc_free_expr (result);
+         if (t)
+           gfc_clear_shape (shape, source->rank);
+         return &gfc_bad_expr;
+       }
+
       gfc_constructor_append_expr (&result->value.constructor, e, NULL);
     }
 
+  if (t)
+    gfc_clear_shape (shape, source->rank);
+
   return result;
 }
 
 
-gfc_expr *
-gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+static gfc_expr *
+simplify_size (gfc_expr *array, gfc_expr *dim, int k)
 {
   mpz_t size;
   gfc_expr *return_value;
   int d;
-  int k = get_kind (BT_INTEGER, kind, "SIZE", gfc_default_integer_kind);
-
-  if (k == -1)
-    return &gfc_bad_expr;
 
   /* For unary operations, the size of the result is given by the size
      of the operand.  For binary ones, it's the size of the first operand
@@ -5603,7 +5609,7 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
              replacement = array->value.op.op1;
            else
              {
-               simplified = gfc_simplify_size (array->value.op.op1, dim, kind);
+               simplified = simplify_size (array->value.op.op1, dim, k);
                if (simplified)
                  return simplified;
 
@@ -5613,18 +5619,20 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
        }
 
       /* Try to reduce it directly if possible.  */
-      simplified = gfc_simplify_size (replacement, dim, kind);
+      simplified = simplify_size (replacement, dim, k);
 
       /* Otherwise, we build a new SIZE call.  This is hopefully at least
         simpler than the original one.  */
       if (!simplified)
-       simplified = gfc_build_intrinsic_call (gfc_current_ns,
-                                              GFC_ISYM_SIZE, "size",
-                                              array->where, 3,
-                                              gfc_copy_expr (replacement),
-                                              gfc_copy_expr (dim),
-                                              gfc_copy_expr (kind));
-
+       {
+         gfc_expr *kind = gfc_get_int_expr (gfc_default_integer_kind, NULL, k);
+         simplified = gfc_build_intrinsic_call (gfc_current_ns,
+                                                GFC_ISYM_SIZE, "size",
+                                                array->where, 3,
+                                                gfc_copy_expr (replacement),
+                                                gfc_copy_expr (dim),
+                                                kind);
+       }
       return simplified;
     }
 
@@ -5643,12 +5651,31 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
        return NULL;
     }
 
-  return_value = gfc_get_int_expr (k, &array->where, mpz_get_si (size));
+  return_value = gfc_get_constant_expr (BT_INTEGER, k, &array->where);
+  mpz_set (return_value->value.integer, size);
   mpz_clear (size);
+
   return return_value;
 }
 
 
+gfc_expr *
+gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+  gfc_expr *result;
+  int k = get_kind (BT_INTEGER, kind, "SIZE", gfc_default_integer_kind);
+
+  if (k == -1)
+    return &gfc_bad_expr;
+
+  result = simplify_size (array, dim, k);
+  if (result == NULL || result == &gfc_bad_expr)
+    return result;
+
+  return range_check (result, "SIZE");
+}
+
+
 /* SIZEOF and C_SIZEOF return the size in bytes of an array element
    multiplied by the array size.  */
 
@@ -5705,7 +5732,8 @@ gfc_simplify_storage_size (gfc_expr *x,
   mpz_set_si (result->value.integer, gfc_element_size (x));
 
   mpz_mul_ui (result->value.integer, result->value.integer, BITS_PER_UNIT);
-  return result;
+
+  return range_check (result, "STORAGE_SIZE");
 }
 
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0dcb015..c8dc189 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2013-05-02  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/57142
+       * gfortran.dg/size_kind_2.f90: New.
+       * gfortran.dg/size_kind_3.f90: New.
+
 2013-05-02  Richard Biener  <rguenther@suse.de>
 
        PR middle-end/57140

diff --git a/gcc/testsuite/gfortran.dg/size_kind_2.f90 b/gcc/testsuite/gfortran.dg/size_kind_2.f90
new file mode 100644 (file)
index 0000000..002221c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/size_kind_2.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/57142
+!
+integer :: B(huge(1)+3_8,2_8)
+integer(8) :: var1(2), var2, var3
+
+var1 = shape(B,kind=8)
+var2 = size(B,kind=8)
+var3 = size(B,dim=1,kind=8)
+end
+
+! { dg-final { scan-tree-dump "static integer.kind=8. A..\\\[2\\\] = \\\{2147483650, 2\\\};" "original" } }
+! { dg-final { scan-tree-dump "var2 = 4294967300;" "original" } }
+! { dg-final { scan-tree-dump "var3 = 2147483650;" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }

diff --git a/gcc/testsuite/gfortran.dg/size_kind_3.f90 b/gcc/testsuite/gfortran.dg/size_kind_3.f90
new file mode 100644 (file)
index 0000000..ae57bd9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/size_kind_3.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR fortran/57142
+!
+integer :: B(huge(1)+3_8,2_8)
+integer(8) :: var1(2), var2, var3
+
+var1 = shape(B) ! { dg-error "SHAPE overflows its kind" }
+var2 = size(B) ! { dg-error "SIZE overflows its kind" }
+var3 = size(B,dim=1) ! { dg-error "SIZE overflows its kind" }
+end