From: Paul Thomas Date: Fri, 10 Nov 2006 21:06:42 +0000 (+0000) Subject: re PR fortran/29758 (Runtime segfault in RESHAPE with insufficient elements in SOURCE) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=d8d8121add34439d69187182bacea680468270df;p=gcc.git re PR fortran/29758 (Runtime segfault in RESHAPE with insufficient elements in SOURCE) 2006-11-10 Paul Thomas PR fortran/29758 * check.c (gfc_check_reshape): Check that there are enough elements in the source array as to be able to fill an array defined by shape, when pad is absent. 2006-11-10 Paul Thomas PR fortran/29758 * gfortran.dg/reshape_source_size_1.f90: New test. From-SVN: r118664 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 40b714d60e0..445ed4b7702 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,7 +1,9 @@ -2006-11-10 Tobias Burnus +2006-11-10 Paul Thomas - PR fortran/29454 - * resolve.c (gfc_resolve_blocks): Fix error message. + PR fortran/29758 + * check.c (gfc_check_reshape): Check that there are enough + elements in the source array as to be able to fill an array + defined by shape, when pad is absent. 2006-11-10 Paul Thomas diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index f8983bd4a49..0c5fc130b5a 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -2110,6 +2110,7 @@ gfc_check_reshape (gfc_expr * source, gfc_expr * shape, gfc_expr * pad, gfc_expr * order) { mpz_t size; + mpz_t nelems; int m; if (array_check (source, 0) == FAILURE) @@ -2149,6 +2150,38 @@ gfc_check_reshape (gfc_expr * source, gfc_expr * shape, if (order != NULL && array_check (order, 3) == FAILURE) return FAILURE; + if (pad == NULL + && shape->expr_type == EXPR_ARRAY + && gfc_is_constant_expr (shape) + && !(source->expr_type == EXPR_VARIABLE + && source->symtree->n.sym->as + && source->symtree->n.sym->as->type == AS_ASSUMED_SIZE)) + { + /* Check the match in size between source and destination. */ + if (gfc_array_size (source, &nelems) == SUCCESS) + { + gfc_constructor *c; + bool test; + + c = shape->value.constructor; + mpz_init_set_ui (size, 1); + for (; c; c = c->next) + mpz_mul (size, size, c->expr->value.integer); + + test = mpz_cmp (nelems, size) < 0 && mpz_cmp_ui (size, 0) > 0; + mpz_clear (nelems); + mpz_clear (size); + + if (test) + { + gfc_error ("Without padding, there are not enough elements in the " + "intrinsic RESHAPE source at %L to match the shape", + &source->where); + return FAILURE; + } + } + } + return SUCCESS; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4189bb08d7e..3880cb9f224 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2006-11-10 Paul Thomas + + PR fortran/29758 + * gfortran.dg/reshape_source_size_1.f90: New test. + 2006-11-10 Paul Thomas PR fortran/29315 diff --git a/gcc/testsuite/gfortran.dg/reshape_source_size_1.f90 b/gcc/testsuite/gfortran.dg/reshape_source_size_1.f90 new file mode 100644 index 00000000000..8290f613577 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/reshape_source_size_1.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! Tests patch for PR29758, which arose from PR29431. There was no check that there +! were enough elements in the source to match the shape. +! +! Contributed by Paul Thomas +! + real :: a(2,2), b = 1.0, c(3), d(4) + a = reshape ([b], [2,2]) ! { dg-error "not enough elements" } + a = reshape (c, [2,2]) ! { dg-error "not enough elements" } + a = reshape (d, [2,2]) +end