This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, Fortran] PR57142 - Fix simplify for SHAPE and SIZE for large arrays


Instead of using the return "size" value directly, the code converted it first to an int and then back into a GMP number. This patch now directly uses the mpz value.

Additionally, I added range checks - to print the proper function name (SHAPE instead of SIZE), I split the worker code from the checking code.

Build and regtested on x86-64-gnu-linux.
OK for the trunk and the 4.7/4.8 branches?

Tobias
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.

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
@@ -2856,16 +2856,17 @@ resolve_function (gfc_expr *expr)
       /* Array intrinsics must also have the last upper bound of an
 	 assumed size array argument.  UBOUND and SIZE have to be
 	 excluded from the check if the second argument is anything
 	 than a constant.  */
 
       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)
 		break;
 
 	      if (arg->next->name && strncmp (arg->next->name, "kind", 4) == 0)
 		break;
 
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");
 }
 
 
--- /dev/null	2013-05-02 08:29:57.272077410 +0200
+++ gcc/gcc/testsuite/gfortran.dg/size_kind_2.f90	2013-05-02 15:25:53.765368001 +0200
@@ -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" } }
--- /dev/null	2013-05-02 08:29:57.272077410 +0200
+++ gcc/gcc/testsuite/gfortran.dg/size_kind_3.f90	2013-05-02 15:22:58.605614924 +0200
@@ -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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]