From: Tobias Burnus Date: Tue, 7 May 2013 17:28:12 +0000 (+0200) Subject: backport: re PR fortran/57142 (SIZE/SHAPE overflow despite kind=8) X-Git-Tag: releases/gcc-4.7.4~679 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=f91de6b522368e797b3a63f578d3c839be91c644;p=thirdparty%2Fgcc.git backport: re PR fortran/57142 (SIZE/SHAPE overflow despite kind=8) 2013-05-07 Tobias Burnus Backport from mainline 2013-05-02 Tobias Burnus 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 Backport from mainline 2013-05-02 Tobias Burnus PR fortran/57142 * gfortran.dg/size_kind_2.f90: New. * gfortran.dg/size_kind_3.f90: New. From-SVN: r198690 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index af2c5dc6d045..2698389c8108 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2013-05-07 Tobias Burnus + + Backport from mainline + 2013-05-02 Tobias Burnus + + 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 Backports from trunk: diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 8729e1567be4..8e00739604d7 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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) diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 4ce7d138e458..bf176739c0b5 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -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) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 83dca575f7da..cb16efdf83bd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,10 +1,19 @@ +2013-05-07 Tobias Burnus + + Backport from mainline + 2013-05-02 Tobias Burnus + + PR fortran/57142 + * gfortran.dg/size_kind_2.f90: New. + * gfortran.dg/size_kind_3.f90: New. + 2013-05-03 Marek Polacek Backport from mainline 2013-04-25 Marek Polacek 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 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 000000000000..002221c5b34d --- /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 000000000000..ae57bd9a1576 --- /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