From patchwork Wed Jun 26 13:14:01 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 254737 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id 84E4F2C008E for ; Wed, 26 Jun 2013 23:14:18 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=oTOg5z4Ru79z17+sZAE+NBDpICDtNjqmId7ik20SEDCfpZ HUvOaRScTYlHbn44t+9vqHPJGN3oncPn/1zfdZ7nb7q5Osf4Ohb4Nxt1mcjjeWAD sNQPcMUDPqBC2movRKG3D2q1hXHXBO1G3ulSLkDEXy1coI62G75tVDZ4vCj58= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=Qj682IfVpNgxGkSjVVQmRNATvQM=; b=dObJ8SSCWj9aY2qNd/no 5nUIATfJjyMLCHQvzTg+kycrcMavLQCSTonrJl90ZCTfmOw15/3mhnmAxKCI4bzZ F8NH2N7M/1frC9kTMbfnFVQYJALUB13srnvkHo9TziKZccTfbnE93OhJ7D3FP5jU wUnLnrDKIdaq29UawLJ/3S0= Received: (qmail 12581 invoked by alias); 26 Jun 2013 13:14:12 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 12540 invoked by uid 89); 26 Jun 2013 13:14:06 -0000 X-Spam-SWARE-Status: No, score=-2.3 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, TW_CP autolearn=ham version=3.3.1 X-Spam-User: qpsmtpd, 2 recipients Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Wed, 26 Jun 2013 13:14:05 +0000 Received: from archimedes.net-b.de (port-92-206-14-23.dynamic.qsc.de [92.206.14.23]) by mx02.qsc.de (Postfix) with ESMTP id D680C276C7; Wed, 26 Jun 2013 15:14:01 +0200 (CEST) Message-ID: <51CAE919.4000800@net-b.de> Date: Wed, 26 Jun 2013 15:14:01 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130510 Thunderbird/17.0.6 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR57721 - improve out-of-bounds error message for components X-Virus-Found: No The patch changes the out-of-bounds message for "k==11" z(i)%y(j)%x(k)=0 from: Fortran runtime error: Index '11' of dimension 1 of array 'z' above upper bound of 10 to Fortran runtime error: Index '11' of dimension 1 of array 'z%y%x' above upper bound of 10 (For j out of bounds, it would show "z%y" and for i out of bounds "z".) Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias 2013-06-26 Tobias Burnus PR fortran/29800 * trans-array.c (gfc_conv_array_ref): Improve out-of-bounds diagnostic message. * trans-array.c (gfc_conv_array_ref): Update prototype. * trans-expr.c (gfc_conv_variable): Update call. 2013-06-26 Tobias Burnus PR fortran/29800 * gfortran.dg/bounds_check_17.f90: New. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 96162e5..d118f75 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3145,7 +3145,7 @@ build_array_ref (tree desc, tree offset, tree decl) a(i, j, k) = base[offset + i * stride[0] + j * stride[1] + k * stride[2]]*/ void -gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, +gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr, locus * where) { int n; @@ -3154,6 +3154,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, tree stride; gfc_se indexse; gfc_se tmpse; + gfc_symbol * sym = expr->symtree->n.sym; + char *var_name = NULL; if (ar->dimen == 0) { @@ -3184,6 +3186,35 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, return; } + if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) + { + size_t len; + gfc_ref *ref; + + len = strlen (sym->name) + 1; + for (ref = expr->ref; ref; ref = ref->next) + { + if (ref->type == REF_ARRAY && &ref->u.ar == ar) + break; + if (ref->type == REF_COMPONENT) + len += 1 + strlen (ref->u.c.component->name); + } + + var_name = XALLOCAVEC (char, len); + strcpy (var_name, sym->name); + + for (ref = expr->ref; ref; ref = ref->next) + { + if (ref->type == REF_ARRAY && &ref->u.ar == ar) + break; + if (ref->type == REF_COMPONENT) + { + strcat (var_name, "%%"); + strcat (var_name, ref->u.c.component->name); + } + } + } + cst_offset = offset = gfc_index_zero_node; add_to_offset (&cst_offset, &offset, gfc_conv_array_offset (se->expr)); @@ -3219,7 +3250,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, indexse.expr, tmp); asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " - "below lower bound of %%ld", n+1, sym->name); + "below lower bound of %%ld", n+1, var_name); gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg, fold_convert (long_integer_type_node, indexse.expr), @@ -3243,7 +3274,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, indexse.expr, tmp); asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " - "above upper bound of %%ld", n+1, sym->name); + "above upper bound of %%ld", n+1, var_name); gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg, fold_convert (long_integer_type_node, indexse.expr), diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 8d9e461..878a5c0 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -123,7 +123,7 @@ void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *); tree gfc_build_null_descriptor (tree); /* Get a single array element. */ -void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_symbol *, locus *); +void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *); /* Translate a reference to a temporary array. */ void gfc_conv_tmp_array_ref (gfc_se * se); /* Translate a reference to an array temporary. */ diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 56dc766..7a726db 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1910,7 +1910,7 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) && ref->next == NULL && (se->descriptor_only)) return; - gfc_conv_array_ref (se, &ref->u.ar, sym, &expr->where); + gfc_conv_array_ref (se, &ref->u.ar, expr, &expr->where); /* Return a pointer to an element. */ break; --- /dev/null 2013-06-26 08:23:53.976189029 +0200 +++ gcc/gcc/testsuite/gfortran.dg/bounds_check_17.f90 2013-06-26 15:10:24.528309201 +0200 @@ -0,0 +1,26 @@ +! { dg-do run } +! { dg-options "-fcheck=bounds" } +! { dg-shouldfail "above upper bound" } +! +! PR fortran/29800 +! +! Contributed by Joost VandeVondele +! + +TYPE data + INTEGER :: x(10) +END TYPE +TYPE data_areas + TYPE(data) :: y(10) +END TYPE + +TYPE(data_areas) :: z(10) + +integer, volatile :: i,j,k +i=1 ; j=1 ; k=11 + +z(i)%y(j)%x(k)=0 + +END + +! { dg-output "At line 22 of file .*bounds_check_17.f90.*Fortran runtime error: Index '11' of dimension 1 of array 'z%y%x' above upper bound of 10" }