From patchwork Sat Sep 23 12:33:39 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 817798 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-462826-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="c74Cjx17"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3xzqXg61tfz9t42 for ; Sat, 23 Sep 2017 22:34:08 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=wldgyDiczo4c7B1RCi1y6KE32Di81i4HmsSiebbFvCqhUhq4ok O9jKmqD2Bx2+oPq0h+kn3Czuquy/zqZNrhqxn6ZuFnF38x5XuR6n0S3T0muxagI8 SXR6a4CNVs8Qp1fj7yuBYzIPh1aztqUghj5b9Mv5V8zOA6mx351ZvWon4= 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:to :from:subject:message-id:date:mime-version:content-type; s= default; bh=ouVRl7I1Rx6RmNzuuV31D8FcDOc=; b=c74Cjx179p5T312qt/EL Hp4Mprk0xyNH9CLHTTJK7vmRMmqI66bhXAbC5Xi+FzBgTnMEAthiQdmrOWfNRrQL KuwV+g4Fzzikcqicw/511QRy7Ants+UNuPeS7uKHb6GSGCB4mHHmm+HyPRpJAvm7 sfMgiz6gAK9r5bhS9YztUsg= Received: (qmail 19858 invoked by alias); 23 Sep 2017 12:33:52 -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 19827 invoked by uid 89); 23 Sep 2017 12:33:50 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-15.7 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_LOW, RP_MATCHES_RCVD, SPF_PASS autolearn=ham version=3.3.2 spammy=*cl, INTENT, tkoenig@gcc.gnu.org, tkoeniggccgnuorg X-Spam-User: qpsmtpd, 2 recipients X-HELO: cc-smtpout3.netcologne.de Received: from cc-smtpout3.netcologne.de (HELO cc-smtpout3.netcologne.de) (89.1.8.213) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sat, 23 Sep 2017 12:33:46 +0000 Received: from cc-smtpin3.netcologne.de (cc-smtpin3.netcologne.de [89.1.8.203]) by cc-smtpout3.netcologne.de (Postfix) with ESMTP id 1A79B125F3; Sat, 23 Sep 2017 14:33:42 +0200 (CEST) Received: from localhost (localhost [127.0.0.1]) by cc-smtpin3.netcologne.de (Postfix) with ESMTP id 0AD7311DDE; Sat, 23 Sep 2017 14:33:42 +0200 (CEST) Received: from [78.35.137.148] (helo=cc-smtpin3.netcologne.de) by localhost with ESMTP (eXpurgate 4.1.9) (envelope-from ) id 59c654a5-02b7-7f0000012729-7f000001a7d4-1 for ; Sat, 23 Sep 2017 14:33:41 +0200 Received: from [192.168.178.20] (xdsl-78-35-137-148.netcologne.de [78.35.137.148]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by cc-smtpin3.netcologne.de (Postfix) with ESMTPSA; Sat, 23 Sep 2017 14:33:40 +0200 (CEST) To: "fortran@gcc.gnu.org" , gcc-patches From: Thomas Koenig Subject: [patch, fortran] Warn about out-of-bounds access with DO subscripts Message-ID: <4f751299-7191-7a49-0bbe-676d194d50a9@netcologne.de> Date: Sat, 23 Sep 2017 14:33:39 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.3.0 MIME-Version: 1.0 Hello world, here is an update and a ping for my patch at https://gcc.gnu.org/ml/gcc-patches/2017-09/msg01104.html This patch warns unconditionally for REAL A(3) DO I=1,4 A(I) = 42. END DO while only warning conditionally, dependent on a new flag, for when the statement containing the expression is hidden behind some IF or SELECT CASE statement or if there is something in the DO loop which could potentially exit the loop, so REAL A(3) DO I=1,4 IF (CONDITON) A(I) = 42. END DO will require the new -Wdo-subscript or the -Wextra flag. Regression-tested. OK for trunk? Regards Thomas 2017-09-23 Thomas Koenig * lang.opt: Add -Wdo-subscript. * frontend-passes.c (do_t): New type. (doloop_list): Use variable of do_type. (if_level): Variable to track if levels. (select_level): Variable to track select levels. (gfc_run_passes): Initialize i_level and select_level. (doloop_code): Record current level of if + select level in doloop_list. Add seen_goto if there could be a branch outside the loop. Use different type for doloop_list. (doloop_function): Call do_intent and do_subscript; move functionality of checking INTENT to do_intent. (insert_index_t): New type, for callback_insert_index. (callback_insert_index): New function. (insert_index): New function. (do_subscript): New function. (do_intent): New function. (gfc_code_walker): Keep track of if_level and select_level. * invoke.texi: Document -Wdo-subscript. 2017-09-23 Thomas Koenig * gfortran.dg/do_subscript_1.f90: New test. * gfortran.dg/do_subscript_2.f90: New test. * gfortran.dg/gomp/associate1.f90: Add out of bounds warning. * gfortran.dg/predcom-1.f: Adjust loop bounds. * gfortran.dg/unconstrained_commons.f: Add out of bounds warning. Index: gcc/fortran/frontend-passes.c =================================================================== --- gcc/fortran/frontend-passes.c (Revision 253076) +++ gcc/fortran/frontend-passes.c (Arbeitskopie) @@ -39,6 +39,8 @@ static bool optimize_lexical_comparison (gfc_expr static void optimize_minmaxloc (gfc_expr **); static bool is_empty_string (gfc_expr *e); static void doloop_warn (gfc_namespace *); +static int do_intent (gfc_expr **); +static int do_subscript (gfc_expr **); static void optimize_reduction (gfc_namespace *); static int callback_reduction (gfc_expr **, int *, void *); static void realloc_strings (gfc_namespace *); @@ -98,10 +100,20 @@ static int iterator_level; /* Keep track of DO loop levels. */ -static vec doloop_list; +typedef struct { + gfc_code *c; + int branch_level; + bool seen_goto; +} do_t; +static vec doloop_list; static int doloop_level; +/* Keep track of if and select case levels. */ + +static int if_level; +static int select_level; + /* Vector of gfc_expr * to keep track of DO loops. */ struct my_struct *evec; @@ -133,6 +145,8 @@ gfc_run_passes (gfc_namespace *ns) change. */ doloop_level = 0; + if_level = 0; + select_level = 0; doloop_warn (ns); doloop_list.release (); int w, e; @@ -2231,6 +2245,8 @@ doloop_code (gfc_code **c, int *walk_subtrees ATTR gfc_formal_arglist *f; gfc_actual_arglist *a; gfc_code *cl; + do_t loop, *lp; + bool seen_goto; co = *c; @@ -2239,16 +2255,67 @@ doloop_code (gfc_code **c, int *walk_subtrees ATTR if ((unsigned) doloop_level < doloop_list.length()) doloop_list.truncate (doloop_level); + seen_goto = false; switch (co->op) { case EXEC_DO: if (co->ext.iterator && co->ext.iterator->var) - doloop_list.safe_push (co); + loop.c = co; else - doloop_list.safe_push ((gfc_code *) NULL); + loop.c = NULL; + + loop.branch_level = if_level + select_level; + loop.seen_goto = false; + doloop_list.safe_push (loop); break; + /* If anything could transfer control away from a suspicious + subscript, make sure to set seen_goto in the current DO loop + (if any). */ + case EXEC_GOTO: + case EXEC_EXIT: + case EXEC_STOP: + case EXEC_ERROR_STOP: + case EXEC_CYCLE: + seen_goto = true; + break; + + case EXEC_OPEN: + if (co->ext.open->err) + seen_goto = true; + break; + + case EXEC_CLOSE: + if (co->ext.close->err) + seen_goto = true; + break; + + case EXEC_BACKSPACE: + case EXEC_ENDFILE: + case EXEC_REWIND: + case EXEC_FLUSH: + + if (co->ext.filepos->err) + seen_goto = true; + break; + + case EXEC_INQUIRE: + if (co->ext.filepos->err) + seen_goto = true; + break; + + case EXEC_READ: + case EXEC_WRITE: + if (co->ext.dt->err || co->ext.dt->end || co->ext.dt->eor) + seen_goto = true; + break; + + case EXEC_WAIT: + if (co->ext.wait->err || co->ext.wait->end || co->ext.wait->eor) + loop.seen_goto = true; + break; + case EXEC_CALL: if (co->resolved_sym == NULL) @@ -2265,9 +2332,10 @@ doloop_code (gfc_code **c, int *walk_subtrees ATTR while (a && f) { - FOR_EACH_VEC_ELT (doloop_list, i, cl) + FOR_EACH_VEC_ELT (doloop_list, i, lp) { gfc_symbol *do_sym; + cl = lp->c; if (cl == NULL) break; @@ -2282,14 +2350,14 @@ doloop_code (gfc_code **c, int *walk_subtrees ATTR "value inside loop beginning at %L as " "INTENT(OUT) argument to subroutine %qs", do_sym->name, &a->expr->where, - &doloop_list[i]->loc, + &(doloop_list[i].c->loc), co->symtree->n.sym->name); else if (f->sym->attr.intent == INTENT_INOUT) gfc_error_now ("Variable %qs at %L not definable inside " "loop beginning at %L as INTENT(INOUT) " "argument to subroutine %qs", do_sym->name, &a->expr->where, - &doloop_list[i]->loc, + &(doloop_list[i].c->loc), co->symtree->n.sym->name); } } @@ -2301,20 +2369,267 @@ doloop_code (gfc_code **c, int *walk_subtrees ATTR default: break; } + if (seen_goto && doloop_level > 0) + doloop_list[doloop_level-1].seen_goto = true; + return 0; } -/* Callback function for functions checking that we do not pass a DO variable - to an INTENT(OUT) or INTENT(INOUT) dummy variable. */ +/* Callback function to warn about different things within DO loops. */ static int do_function (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, void *data ATTRIBUTE_UNUSED) { + do_t *last; + + if (doloop_list.length () == 0) + return 0; + + if ((*e)->expr_type == EXPR_FUNCTION) + do_intent (e); + + last = &doloop_list.last(); + if (last->seen_goto && !warn_do_subscript) + return 0; + + if ((*e)->expr_type == EXPR_VARIABLE) + do_subscript (e); + + return 0; +} + +typedef struct +{ + gfc_symbol *sym; + mpz_t val; +} insert_index_t; + +/* Callback function - if the expression is the variable in data->sym, + replace it with a constant from data->val. */ + +static int +callback_insert_index (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data) +{ + insert_index_t *d; + gfc_expr *ex, *n; + + ex = (*e); + if (ex->expr_type != EXPR_VARIABLE) + return 0; + + d = (insert_index_t *) data; + if (ex->symtree->n.sym != d->sym) + return 0; + + n = gfc_get_constant_expr (BT_INTEGER, ex->ts.kind, &ex->where); + mpz_set (n->value.integer, d->val); + + gfc_free_expr (ex); + *e = n; + return 0; +} + +/* In the expression e, replace occurrences of the variable sym with + val. If this results in a constant expression, return true and + return the value in ret. Return false if the expression already + is a constant. Caller has to clear ret in that case. */ + +static bool +insert_index (gfc_expr *e, gfc_symbol *sym, mpz_t val, mpz_t ret) +{ + gfc_expr *n; + insert_index_t data; + bool rc; + + if (e->expr_type == EXPR_CONSTANT) + return false; + + n = gfc_copy_expr (e); + data.sym = sym; + mpz_init_set (data.val, val); + gfc_expr_walker (&n, callback_insert_index, (void *) &data); + gfc_simplify_expr (n, 0); + + if (n->expr_type == EXPR_CONSTANT) + { + rc = true; + mpz_init_set (ret, n->value.integer); + } + else + rc = false; + + mpz_clear (data.val); + gfc_free_expr (n); + return rc; + +} + +/* Check array subscripts for possible out-of-bounds accesses in DO + loops with constant bounds. */ + +static int +do_subscript (gfc_expr **e) +{ + gfc_expr *v; + gfc_array_ref *ar; + gfc_ref *ref; + int i,j; + gfc_code *dl; + do_t *lp; + + v = *e; + /* Constants are already checked. */ + if (v->expr_type == EXPR_CONSTANT) + return 0; + + for (ref = v->ref; ref; ref = ref->next) + { + if (ref->type == REF_ARRAY && ref->u.ar.type == AR_ELEMENT) + { + ar = & ref->u.ar; + FOR_EACH_VEC_ELT (doloop_list, j, lp) + { + gfc_symbol *do_sym; + mpz_t do_start, do_step, do_end; + bool have_do_start, have_do_end; + bool error_not_proven; + int warn; + + dl = lp->c; + if (dl == NULL) + break; + + /* If we are within a branch, or a goto or equivalent + was seen in the DO loop before, then we cannot prove that + this expression is actually evaluated. Don't do anything + unless we want to see it all. */ + error_not_proven = lp->seen_goto + || lp->branch_level < if_level + select_level; + + if (error_not_proven && !warn_do_subscript) + break; + + if (error_not_proven) + warn = OPT_Wdo_subscript; + else + warn = 0; + + do_sym = dl->ext.iterator->var->symtree->n.sym; + if (do_sym->ts.type != BT_INTEGER) + continue; + + /* If we do not know about the stepsize, the loop may be zero trip. + Do not warn in this case. */ + + if (dl->ext.iterator->step->expr_type == EXPR_CONSTANT) + mpz_init_set (do_step, dl->ext.iterator->step->value.integer); + else + continue; + + if (dl->ext.iterator->start->expr_type == EXPR_CONSTANT) + { + have_do_start = true; + mpz_init_set (do_start, dl->ext.iterator->start->value.integer); + } + else + have_do_start = false; + + + if (dl->ext.iterator->end->expr_type == EXPR_CONSTANT) + { + have_do_end = true; + mpz_init_set (do_end, dl->ext.iterator->end->value.integer); + } + else + have_do_end = false; + + if (!have_do_start && !have_do_end) + return 0; + + /* May have to correct the end value if the step does not equal + one. */ + if (have_do_start && have_do_end && mpz_cmp_ui (do_step, 1) != 0) + { + mpz_t diff, rem; + + mpz_init (diff); + mpz_init (rem); + mpz_sub (diff, do_end, do_start); + mpz_tdiv_r (rem, diff, do_step); + mpz_sub (do_end, do_end, rem); + mpz_clear (diff); + mpz_clear (rem); + } + + for (i = 0; i< ar->dimen; i++) + { + mpz_t val; + if (ar->dimen_type[i] == DIMEN_ELEMENT && have_do_start + && insert_index (ar->start[i], do_sym, do_start, val)) + { + if (ar->as->lower[i] + && ar->as->lower[i]->expr_type == EXPR_CONSTANT + && mpz_cmp (val, ar->as->lower[i]->value.integer) < 0) + gfc_warning (warn, "Array reference at %L out of bounds " + "(%ld < %ld) in loop beginning at %L", + &ar->start[i]->where, mpz_get_si (val), + mpz_get_si (ar->as->lower[i]->value.integer), + &doloop_list[j].c->loc); + + if (ar->as->upper[i] + && ar->as->upper[i]->expr_type == EXPR_CONSTANT + && mpz_cmp (val, ar->as->upper[i]->value.integer) > 0) + gfc_warning (warn, "Array reference at %L out of bounds " + "(%ld > %ld) in loop beginning at %L", + &ar->start[i]->where, mpz_get_si (val), + mpz_get_si (ar->as->upper[i]->value.integer), + &doloop_list[j].c->loc); + + mpz_clear (val); + } + + if (ar->dimen_type[i] == DIMEN_ELEMENT && have_do_end + && insert_index (ar->start[i], do_sym, do_end, val)) + { + if (ar->as->lower[i] + && ar->as->lower[i]->expr_type == EXPR_CONSTANT + && mpz_cmp (val, ar->as->lower[i]->value.integer) < 0) + gfc_warning (warn, "Array reference at %L out of bounds " + "(%ld < %ld) in loop beginning at %L", + &ar->start[i]->where, mpz_get_si (val), + mpz_get_si (ar->as->lower[i]->value.integer), + &doloop_list[j].c->loc); + + if (ar->as->upper[i] + && ar->as->upper[i]->expr_type == EXPR_CONSTANT + && mpz_cmp (val, ar->as->upper[i]->value.integer) > 0) + gfc_warning (warn, "Array reference at %L out of bounds " + "(%ld > %ld) in loop beginning at %L", + &ar->start[i]->where, mpz_get_si (val), + mpz_get_si (ar->as->upper[i]->value.integer), + &doloop_list[j].c->loc); + + mpz_clear (val); + } + } + } + } + } + return 0; +} +/* Function for functions checking that we do not pass a DO variable + to an INTENT(OUT) or INTENT(INOUT) dummy variable. */ + +static int +do_intent (gfc_expr **e) +{ gfc_formal_arglist *f; gfc_actual_arglist *a; gfc_expr *expr; gfc_code *dl; + do_t *lp; int i; expr = *e; @@ -2337,10 +2652,10 @@ do_function (gfc_expr **e, int *walk_subtrees ATTR while (a && f) { - FOR_EACH_VEC_ELT (doloop_list, i, dl) + FOR_EACH_VEC_ELT (doloop_list, i, lp) { gfc_symbol *do_sym; - + dl = lp->c; if (dl == NULL) break; @@ -2353,13 +2668,13 @@ do_function (gfc_expr **e, int *walk_subtrees ATTR gfc_error_now ("Variable %qs at %L set to undefined value " "inside loop beginning at %L as INTENT(OUT) " "argument to function %qs", do_sym->name, - &a->expr->where, &doloop_list[i]->loc, + &a->expr->where, &doloop_list[i].c->loc, expr->symtree->n.sym->name); else if (f->sym->attr.intent == INTENT_INOUT) gfc_error_now ("Variable %qs at %L not definable inside loop" " beginning at %L as INTENT(INOUT) argument to" " function %qs", do_sym->name, - &a->expr->where, &doloop_list[i]->loc, + &a->expr->where, &doloop_list[i].c->loc, expr->symtree->n.sym->name); } } @@ -4055,6 +4370,10 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code WALK_SUBEXPR (co->ext.iterator->step); break; + case EXEC_IF: + if_level ++; + break; + case EXEC_WHERE: in_where = true; break; @@ -4073,6 +4392,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code case EXEC_SELECT: WALK_SUBEXPR (co->expr1); + select_level ++; for (b = co->block; b; b = b->block) { gfc_case *cp; @@ -4329,6 +4649,12 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code if (co->op == EXEC_DO) doloop_level --; + if (co->op == EXEC_IF) + if_level --; + + if (co->op == EXEC_SELECT) + select_level --; + in_omp_workshare = saved_in_omp_workshare; in_where = saved_in_where; } Index: gcc/fortran/invoke.texi =================================================================== --- gcc/fortran/invoke.texi (Revision 253076) +++ gcc/fortran/invoke.texi (Arbeitskopie) @@ -145,8 +145,8 @@ by type. Explanations are in the following sectio @xref{Error and Warning Options,,Options to request or suppress errors and warnings}. @gccoptlist{-Waliasing -Wall -Wampersand -Wargument-mismatch -Warray-bounds --Wc-binding-type -Wcharacter-truncation @gol --Wconversion -Wfunction-elimination -Wimplicit-interface @gol +-Wc-binding-type -Wcharacter-truncation -Wconversion @gol +-Wdo-subscript -Wfunction-elimination -Wimplicit-interface @gol -Wimplicit-procedure -Wintrinsic-shadow -Wuse-without-only -Wintrinsics-std @gol -Wline-truncation -Wno-align-commons -Wno-tabs -Wreal-q-constant @gol -Wsurprising -Wunderflow -Wunused-parameter -Wrealloc-lhs -Wrealloc-lhs-all @gol @@ -891,8 +891,8 @@ option does @emph{not} imply @option{-Wconversion} @cindex extra warnings @cindex warnings, extra Enables some warning options for usages of language features which -may be problematic. This currently includes @option{-Wcompare-reals} -and @option{-Wunused-parameter}. +may be problematic. This currently includes @option{-Wcompare-reals}, +@option{-Wunused-parameter} and @option{-Wdo-subscript}. @item -Wimplicit-interface @opindex @code{Wimplicit-interface} @@ -1064,6 +1064,21 @@ target. This option is implied by @option{-Wall}. Warn if a @code{DO} loop is known to execute zero times at compile time. This option is implied by @option{-Wall}. +@item -Wdo-subscript +@opindex @code{Wdo-subscript} +Warn if an array subscript inside a DO loop could lead to an +out-of-bounds access even if the compiler can not prove that the +statement is actually executed, in cases like +@smallexample + real a(3) + do i=1,4 + if (condition(i)) then + a(i) = 1.2 + end if + end do +@end smallexample +This option is implied by @option{-Wextra}. + @item -Werror @opindex @code{Werror} @cindex warnings, to errors Index: gcc/fortran/lang.opt =================================================================== --- gcc/fortran/lang.opt (Revision 253076) +++ gcc/fortran/lang.opt (Arbeitskopie) @@ -237,6 +237,10 @@ Wconversion-extra Fortran Var(warn_conversion_extra) Warning Warn about most implicit conversions. +Wdo-subscript +Fortran Var(warn_do_subscript) Warning LangEnabledBy(Fortran,Wextra) +Warn about possibly incorrect subscripts in do loops + Wextra Fortran Warning ; Documented in common Index: gcc/testsuite/gfortran.dg/gomp/associate1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/gomp/associate1.f90 (Revision 253076) +++ gcc/testsuite/gfortran.dg/gomp/associate1.f90 (Arbeitskopie) @@ -14,7 +14,7 @@ program associate1 type(dt) :: b(3) i = 1 j = 2 - associate(k => v, l => a(i, j), m => a(i, :)) + associate(k => v, l => a(i, j), m => a(i, :)) ! { dg-warning "out of bounds" } associate(n => b(j)%c(:, :)%i, o => a, p => b) !$omp parallel shared (l) ! { dg-error "ASSOCIATE name" } !$omp end parallel @@ -75,7 +75,7 @@ program associate1 end do k = 1 !$omp simd linear (k : 2) ! { dg-error "ASSOCIATE name" } - do i = 1, 10 + do i = 1, 10 ! { dg-warning "out of bounds" } k = k + 2 end do end associate Index: gcc/testsuite/gfortran.dg/predcom-1.f =================================================================== --- gcc/testsuite/gfortran.dg/predcom-1.f (Revision 253076) +++ gcc/testsuite/gfortran.dg/predcom-1.f (Arbeitskopie) @@ -8,7 +8,7 @@ INTEGER I REAL ANORM INTRINSIC ABS - DO 20 I = 1, N + DO 20 I = 2, N ANORM = ANORM +ABS( E( I ) )+ ABS( E( I-1 ) ) 20 CONTINUE CLANHT = ANORM Index: gcc/testsuite/gfortran.dg/unconstrained_commons.f =================================================================== --- gcc/testsuite/gfortran.dg/unconstrained_commons.f (Revision 253076) +++ gcc/testsuite/gfortran.dg/unconstrained_commons.f (Arbeitskopie) @@ -9,8 +9,8 @@ IMPLICIT DOUBLE PRECISION (X) INTEGER J COMMON /MYCOMMON / X(1) - DO 10 J=1,1024 - X(J+1)=X(J+7) + DO 10 J=1,1024 ! { dg-warning "out of bounds" } + X(J+1)=X(J+7) ! { dg-warning "out of bounds" } 10 CONTINUE RETURN END