backport: re PR fortran/57142 (SIZE/SHAPE overflow despite kind=8)

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

        Backport from mainline
        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.

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

        Backport from mainline
        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.

From-SVN: r198690

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index af2c5dc6d045b6eeb29edf7820132ff97e9eb894..2698389c8108d7c9d701c6fee041c332221e592d 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2013-05-07  Tobias Burnus  <burnus@net-b.de>
+
+       Backport from mainline
+       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-04-26  Janus Weil  <janus@gcc.gnu.org>
 
        Backports from trunk:

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8729e1567be4c1d70294916f6302d58aa70497f7..8e00739604d78995cc5025ddc4710aa0a9f220c1 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3155,6 +3155,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 4ce7d138e458f1f546856784642da6d5a748902b..bf176739c0b574da3b087b572f02ba1a66b73536 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -32,6 +32,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
@@ -3240,7 +3242,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;
@@ -5493,15 +5495,12 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind)
       e = gfc_get_constant_expr (BT_INTEGER, k, &source->where);
 
       if (t == SUCCESS)
-       {
-         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)
            {
@@ -5512,23 +5511,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
@@ -5558,7 +5564,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;
 
@@ -5568,18 +5574,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;
     }
 
@@ -5598,12 +5606,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");
+}
+
+
 gfc_expr *
 gfc_simplify_sign (gfc_expr *x, gfc_expr *y)
 {

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 83dca575f7daa0851fe753814624efca65b9d3e8..cb16efdf83bd57e22c091f3f50b526d520fb8568 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,10 +1,19 @@
+2013-05-07  Tobias Burnus  <burnus@net-b.de>
+
+       Backport from mainline
+       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-03  Marek Polacek  <polacek@redhat.com>
 
        Backport from mainline
        2013-04-25  Marek Polacek  <polacek@redhat.com>
 
        PR tree-optimization/57066
-        * gcc.dg/torture/builtin-logb-1.c: Adjust testcase.
+       * gcc.dg/torture/builtin-logb-1.c: Adjust testcase.
 
 2013-04-30  Uros Bizjak  <ubizjak@gmail.com>
 

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