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.
@@ -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;
@@ -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");
}
@@ -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" } }
@@ -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