Commit 1634e53f by Tobias Burnus Committed by Tobias Burnus

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
parent 9f8e7a96
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> 2013-05-01 Thomas Koenig <tkoenig@gcc.gnu.org>
* frontend-passes.c (optimize_power): Fix typo * frontend-passes.c (optimize_power): Fix typo
......
...@@ -2861,6 +2861,7 @@ resolve_function (gfc_expr *expr) ...@@ -2861,6 +2861,7 @@ resolve_function (gfc_expr *expr)
for (arg = expr->value.function.actual; arg; arg = arg->next) for (arg = expr->value.function.actual; arg; arg = arg->next)
{ {
if ((GENERIC_ID == GFC_ISYM_UBOUND || GENERIC_ID == GFC_ISYM_SIZE) if ((GENERIC_ID == GFC_ISYM_UBOUND || GENERIC_ID == GFC_ISYM_SIZE)
&& arg == expr->value.function.actual
&& arg->next != NULL && arg->next->expr) && arg->next != NULL && arg->next->expr)
{ {
if (arg->next->expr->expr_type != EXPR_CONSTANT) if (arg->next->expr->expr_type != EXPR_CONSTANT)
......
...@@ -33,6 +33,8 @@ along with GCC; see the file COPYING3. If not see ...@@ -33,6 +33,8 @@ along with GCC; see the file COPYING3. If not see
gfc_expr gfc_bad_expr; gfc_expr gfc_bad_expr;
static gfc_expr *simplify_size (gfc_expr *, gfc_expr *, int);
/* Note that 'simplification' is not just transforming expressions. /* Note that 'simplification' is not just transforming expressions.
For functions that are not simplified at compile time, range 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, ...@@ -3248,7 +3250,7 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper,
gfc_expr* dim = result; gfc_expr* dim = result;
mpz_set_si (dim->value.integer, d); mpz_set_si (dim->value.integer, d);
result = gfc_simplify_size (array, dim, kind); result = simplify_size (array, dim, k);
gfc_free_expr (dim); gfc_free_expr (dim);
if (!result) if (!result)
goto returnNull; goto returnNull;
...@@ -5538,15 +5540,12 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind) ...@@ -5538,15 +5540,12 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind)
e = gfc_get_constant_expr (BT_INTEGER, k, &source->where); e = gfc_get_constant_expr (BT_INTEGER, k, &source->where);
if (t) if (t)
{ mpz_set (e->value.integer, shape[n]);
mpz_set (e->value.integer, shape[n]);
mpz_clear (shape[n]);
}
else else
{ {
mpz_set_ui (e->value.integer, n + 1); 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); gfc_free_expr (e);
if (f == NULL) if (f == NULL)
{ {
...@@ -5557,23 +5556,30 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind) ...@@ -5557,23 +5556,30 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind)
e = f; 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); gfc_constructor_append_expr (&result->value.constructor, e, NULL);
} }
if (t)
gfc_clear_shape (shape, source->rank);
return result; return result;
} }
gfc_expr * static gfc_expr *
gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) simplify_size (gfc_expr *array, gfc_expr *dim, int k)
{ {
mpz_t size; mpz_t size;
gfc_expr *return_value; gfc_expr *return_value;
int d; 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 /* 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 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) ...@@ -5603,7 +5609,7 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
replacement = array->value.op.op1; replacement = array->value.op.op1;
else else
{ {
simplified = gfc_simplify_size (array->value.op.op1, dim, kind); simplified = simplify_size (array->value.op.op1, dim, k);
if (simplified) if (simplified)
return simplified; return simplified;
...@@ -5613,18 +5619,20 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) ...@@ -5613,18 +5619,20 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
} }
/* Try to reduce it directly if possible. */ /* 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 /* Otherwise, we build a new SIZE call. This is hopefully at least
simpler than the original one. */ simpler than the original one. */
if (!simplified) if (!simplified)
simplified = gfc_build_intrinsic_call (gfc_current_ns, {
GFC_ISYM_SIZE, "size", gfc_expr *kind = gfc_get_int_expr (gfc_default_integer_kind, NULL, k);
array->where, 3, simplified = gfc_build_intrinsic_call (gfc_current_ns,
gfc_copy_expr (replacement), GFC_ISYM_SIZE, "size",
gfc_copy_expr (dim), array->where, 3,
gfc_copy_expr (kind)); gfc_copy_expr (replacement),
gfc_copy_expr (dim),
kind);
}
return simplified; return simplified;
} }
...@@ -5643,12 +5651,31 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) ...@@ -5643,12 +5651,31 @@ gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
return NULL; 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); mpz_clear (size);
return return_value; 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 /* SIZEOF and C_SIZEOF return the size in bytes of an array element
multiplied by the array size. */ multiplied by the array size. */
...@@ -5705,7 +5732,8 @@ gfc_simplify_storage_size (gfc_expr *x, ...@@ -5705,7 +5732,8 @@ gfc_simplify_storage_size (gfc_expr *x,
mpz_set_si (result->value.integer, gfc_element_size (x)); mpz_set_si (result->value.integer, gfc_element_size (x));
mpz_mul_ui (result->value.integer, result->value.integer, BITS_PER_UNIT); mpz_mul_ui (result->value.integer, result->value.integer, BITS_PER_UNIT);
return result;
return range_check (result, "STORAGE_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.
2013-05-02 Richard Biener <rguenther@suse.de> 2013-05-02 Richard Biener <rguenther@suse.de>
PR middle-end/57140 PR middle-end/57140
......
! { 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" } }
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment