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

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.

From-SVN: r198549

6 files changed, 96 insertions, 23 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e154fa2..c523473 100644
--- 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
--- 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
--- 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
--- 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
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
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