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
This commit is contained in:
Tobias Burnus 2013-05-07 19:28:12 +02:00
parent d32bb8fc13
commit f91de6b522
6 changed files with 101 additions and 23 deletions

View File

@ -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:

View File

@ -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)

View File

@ -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)
{

View File

@ -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>

View File

@ -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" } }

View File

@ -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