From f782f3fd5dea4bed1219f2f07080df624a9cc573 Mon Sep 17 00:00:00 2001 From: burnus Date: Thu, 2 May 2013 16:29:14 +0000 Subject: [PATCH] 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-05-02 Tobias Burnus PR fortran/57142 * gfortran.dg/size_kind_2.f90: New. * gfortran.dg/size_kind_3.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@198549 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 10 +++++ gcc/fortran/resolve.c | 1 + gcc/fortran/simplify.c | 74 +++++++++++++++++++++---------- gcc/testsuite/ChangeLog | 6 +++ gcc/testsuite/gfortran.dg/size_kind_2.f90 | 17 +++++++ gcc/testsuite/gfortran.dg/size_kind_3.f90 | 11 +++++ 6 files changed, 96 insertions(+), 23 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/size_kind_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/size_kind_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e154fa2..c523473 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +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-05-01 Thomas Koenig * frontend-passes.c (optimize_power): Fix typo 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 @@ -2861,6 +2861,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 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"); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0dcb015..c8dc189 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2013-05-02 Tobias Burnus + + PR fortran/57142 + * gfortran.dg/size_kind_2.f90: New. + * gfortran.dg/size_kind_3.f90: New. + 2013-05-02 Richard Biener PR middle-end/57140 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 0000000..002221c --- /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 0000000..ae57bd9 --- /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 -- 2.7.4