From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 26366 invoked by alias); 12 Aug 2011 14:06:55 -0000 Received: (qmail 26347 invoked by uid 22791); 12 Aug 2011 14:06:52 -0000 X-SWARE-Spam-Status: No, hits=-1.2 required=5.0 tests=AWL,BAYES_00,RCVD_IN_DNSWL_NONE,RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from smtp24.services.sfr.fr (HELO smtp24.services.sfr.fr) (93.17.128.82) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 12 Aug 2011 14:06:37 +0000 Received: from filter.sfr.fr (localhost [127.0.0.1]) by msfrf2409.sfr.fr (SMTP Server) with ESMTP id D63DB70000AD; Fri, 12 Aug 2011 16:06:34 +0200 (CEST) Received: from gimli.local (237.183.72.86.rev.sfr.net [86.72.183.237]) by msfrf2409.sfr.fr (SMTP Server) with ESMTP id 8BE9F7000085; Fri, 12 Aug 2011 16:06:34 +0200 (CEST) X-SFR-UUID: 20110812140634573.8BE9F7000085@msfrf2409.sfr.fr From: Mikael Morin To: fortran@gcc.gnu.org Subject: [Patch, fortran] PR fortran/50050 out of bounds whilst freeing an allocate-object. Date: Fri, 12 Aug 2011 15:17:00 -0000 User-Agent: KMail/1.13.5 (FreeBSD/8.2-PRERELEASE; KDE/4.5.5; amd64; ; ) Cc: "gcc-patches" MIME-Version: 1.0 Content-Type: Multipart/Mixed; boundary="Boundary-00=_nNTROKKWArUgG7n" Message-Id: <201108121606.32012.mikael.morin@sfr.fr> X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org X-SW-Source: 2011-08/txt/msg01131.txt.bz2 --Boundary-00=_nNTROKKWArUgG7n Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit Content-length: 750 Hello, This fixes an ICE triggered by resolve.c's gfc_expr_to_initialize reseting a range array ref into a full array ref, updating the rank, but leaving the shape as is, which eventually leads to an out of bound error. The right fix would probably be to avoid this kind of tricks. But I don't know what a patch impleting that would look like. This patch instead keeps the trick as is. It just frees the shape and re- resolves the expression, so that rank and shape are updated. It also does a bit of refactoring about shape freeing. I think it should be on the safe side, and I'm testing it on x86_64-unknown- freebsd8.2. OK for trunk if it passes? What about the branches? It is not a regression, but it looks like a genuine bug. Mikael --Boundary-00=_nNTROKKWArUgG7n Content-Type: text/x-patch; charset="utf-8"; name="pr50050_2.diff" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="pr50050_2.diff" Content-length: 4675 2011-08-12 Mikael Morin PR fortran/50050 * gfortran.h (gfc_clear_shape, gfc_free_shape): New prototypes. * expr.c (gfc_clear_shape, gfc_free_shape): New functions. (free_expr0): Re-use gfc_free_shape. * trans-expr.c (gfc_trans_subarray_assign): Ditto. * trans-io.c (transfer_array_component): Ditto. * resolve.c (check_host_association): Ditto. (gfc_expr_to_initialize): Don't force the rank value and free the shape after updating the expression. Recalculate shape and rank. (resolve_where_shape): Re-use gfc_clear_shape. * array.c (gfc_array_ref_shape): Ditto. 2011-08-12 Mikael Morin * gfortran.dg/alloc_comp_initializer_3.f90: New test. diff --git a/array.c b/array.c index 3074275..aa9cc0c 100644 --- a/array.c +++ b/array.c @@ -2281,9 +2281,7 @@ gfc_array_ref_shape (gfc_array_ref *ar, mpz_t *shape) } cleanup: - for (d--; d >= 0; d--) - mpz_clear (shape[d]); - + gfc_clear_shape (shape, d); return FAILURE; } diff --git a/expr.c b/expr.c index 549feee..c2f1553 100644 --- a/expr.c +++ b/expr.c @@ -396,6 +396,25 @@ gfc_copy_expr (gfc_expr *p) } +void +gfc_clear_shape (mpz_t *shape, int rank) +{ + int i; + + for (i = 0; i < rank; i++) + mpz_clear (shape[i]); +} + + +void +gfc_free_shape (mpz_t **shape, int rank) +{ + gfc_clear_shape (*shape, rank); + free (*shape); + *shape = NULL; +} + + /* Workhorse function for gfc_free_expr() that frees everything beneath an expression node, but not the node itself. This is useful when we want to simplify a node and replace it with @@ -404,8 +423,6 @@ gfc_copy_expr (gfc_expr *p) static void free_expr0 (gfc_expr *e) { - int n; - switch (e->expr_type) { case EXPR_CONSTANT: @@ -474,12 +491,7 @@ free_expr0 (gfc_expr *e) /* Free a shape array. */ if (e->shape != NULL) - { - for (n = 0; n < e->rank; n++) - mpz_clear (e->shape[n]); - - free (e->shape); - } + gfc_free_shape (&e->shape, e->rank); gfc_free_ref_list (e->ref); diff --git a/gfortran.h b/gfortran.h index 34afae4..09f2fe3 100644 --- a/gfortran.h +++ b/gfortran.h @@ -2711,6 +2711,8 @@ gfc_expr *gfc_get_int_expr (int, locus *, int); gfc_expr *gfc_get_logical_expr (int, locus *, bool); gfc_expr *gfc_get_iokind_expr (locus *, io_kind); +void gfc_clear_shape (mpz_t *shape, int rank); +void gfc_free_shape (mpz_t **shape, int rank); void gfc_free_expr (gfc_expr *); void gfc_replace_expr (gfc_expr *, gfc_expr *); mpz_t *gfc_copy_shape (mpz_t *, int); diff --git a/resolve.c b/resolve.c index b8a8ebb..a4645a2 100644 --- a/resolve.c +++ b/resolve.c @@ -5198,12 +5198,7 @@ check_host_association (gfc_expr *e) { /* Clear the shape, since it might not be valid. */ if (e->shape != NULL) - { - for (n = 0; n < e->rank; n++) - mpz_clear (e->shape[n]); - - free (e->shape); - } + gfc_free_shape (&e->shape, e->rank); /* Give the expression the right symtree! */ gfc_find_sym_tree (e->symtree->name, NULL, 1, &st); @@ -6558,10 +6553,13 @@ gfc_expr_to_initialize (gfc_expr *e) for (i = 0; i < ref->u.ar.dimen; i++) ref->u.ar.start[i] = ref->u.ar.end[i] = ref->u.ar.stride[i] = NULL; - result->rank = ref->u.ar.dimen; break; } + gfc_free_shape (&result->shape, result->rank); + + /* Recalculate rank, shape, etc. */ + gfc_resolve_expr (result); return result; } @@ -8429,11 +8427,8 @@ ignore: result = SUCCESS; over: - for (i--; i >= 0; i--) - { - mpz_clear (shape[i]); - mpz_clear (shape2[i]); - } + gfc_clear_shape (shape, i); + gfc_clear_shape (shape2, i); return result; } diff --git a/trans-expr.c b/trans-expr.c index 96510c2..b8ed4c5 100644 --- a/trans-expr.c +++ b/trans-expr.c @@ -4411,10 +4411,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr) gfc_add_block_to_block (&block, &loop.pre); gfc_add_block_to_block (&block, &loop.post); - for (n = 0; n < cm->as->rank; n++) - mpz_clear (lss->shape[n]); - free (lss->shape); - + gfc_free_shape (&lss->shape, cm->as->rank); gfc_cleanup_loop (&loop); return gfc_finish_block (&block); diff --git a/trans-io.c b/trans-io.c index 4e019a3..2ae34d8 100644 --- a/trans-io.c +++ b/trans-io.c @@ -1999,10 +1999,7 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where) gfc_add_block_to_block (&block, &loop.pre); gfc_add_block_to_block (&block, &loop.post); - for (n = 0; n < cm->as->rank; n++) - mpz_clear (ss->shape[n]); - free (ss->shape); - + gfc_free_shape (&ss->shape, cm->as->rank); gfc_cleanup_loop (&loop); return gfc_finish_block (&block); --Boundary-00=_nNTROKKWArUgG7n Content-Type: text/x-fortran; charset="utf-8"; name="alloc_comp_initializer_3.f90" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="alloc_comp_initializer_3.f90" Content-length: 357 ! { dg-do compile } ! ! PR fortran/50050 ! Out of bound whilst releasing initialization of allocate object ! ! Contributed by someone program bug implicit none type foo integer, pointer :: a => null() end type type(foo), dimension(:,:), allocatable :: data allocate(data(1:1,1)) ! This used to lead to an ICE end program --Boundary-00=_nNTROKKWArUgG7n--