From patchwork Sun Sep 10 17:05:28 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 812172 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-461788-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="hy5sskop"; 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 3xqyB44cz5z9s7C for ; Mon, 11 Sep 2017 03:05:47 +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=pO8PnCbCZafed5sh5Aauu0nX+Z6QsI3lzxuUxTf4PSnbLhQVmT 2IefYvOnbza0pKVYRE4W7rjM459ZWUucHlpIBvFcPWYRLB32nMZLMWYuBeLOTDZb yzucBuIfbI2Apq40RauEfBJTT5TvzZv8AQVS6rMFLxfMopva7bFAKxOtw= 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=lFuH63nSuEPzZGIq5jtBAm5f8sc=; b=hy5sskopNkXM+vHW3IkA ErDA/5qC9JgDfPeRUXH7CutxuPjDT4CdikS2B+nXY8WUUybYizdKDNjcB8yasKbe nrMqp+E2aQED1gSulzhProkVoZ8Q1Irs5ihBYHeKF5zhRfuYxEb8anJrGyG1ow5L +rQcoa1byA8I8ZTTwH5Nfio= Received: (qmail 62205 invoked by alias); 10 Sep 2017 17:05:36 -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 61859 invoked by uid 89); 10 Sep 2017 17:05:36 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-15.1 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 autolearn=ham version=3.3.2 spammy=22659, UD:netcologne.de X-Spam-User: qpsmtpd, 2 recipients X-HELO: cc-smtpout2.netcologne.de Received: from cc-smtpout2.netcologne.de (HELO cc-smtpout2.netcologne.de) (89.1.8.212) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 10 Sep 2017 17:05:32 +0000 Received: from cc-smtpin3.netcologne.de (cc-smtpin3.netcologne.de [89.1.8.203]) by cc-smtpout2.netcologne.de (Postfix) with ESMTP id 356AA12770; Sun, 10 Sep 2017 19:05:30 +0200 (CEST) Received: from localhost (localhost [127.0.0.1]) by cc-smtpin3.netcologne.de (Postfix) with ESMTP id 24D4B11D9B; Sun, 10 Sep 2017 19:05:30 +0200 (CEST) Received: from [78.35.141.123] (helo=cc-smtpin3.netcologne.de) by localhost with ESMTP (eXpurgate 4.1.9) (envelope-from ) id 59b570d9-02b7-7f0000012729-7f0000019a00-1 for ; Sun, 10 Sep 2017 19:05:29 +0200 Received: from [192.168.178.20] (xdsl-78-35-141-123.netcologne.de [78.35.141.123]) (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; Sun, 10 Sep 2017 19:05:28 +0200 (CEST) To: "fortran@gcc.gnu.org" , gcc-patches From: Thomas Koenig Subject: [patch, fortran, RFC] warn about out-of-bounds errors in DO loops Message-ID: Date: Sun, 10 Sep 2017 19:05:28 +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, the attached patch warns about certain cases where out-of-bound array accesses can be detected at compile time. This was inspired by an out-of-bound access in Polyhedron. A preliminary version of this patch has already found one error in the testsuite. The problem is what to warn for. Cases like real, dimension(10) :: a do i=1,11 if (somecondition) a(i) = 42. end do could be valid if somecondition is false for i=11. What I did was to check if the subscript reference was - warn for all cases with the new option -Wdo-subscript-extra, included in -Wextra - not warn if an expression is found in an if or select case statement inside the do loop for -Wdo-subscript, included in -Wall. The patch also checks for slightly complicated expressions like i*i - the only condition is that it should evaluate to a constant if the loop variable is inserted. Only constant bounds are checked. See the test cases for some more details. So, what do you think, especially about the choice of options and warning levels? Regards Thomas Index: frontend-passes.c =================================================================== --- frontend-passes.c (Revision 251375) +++ frontend-passes.c (Arbeitskopie) @@ -39,6 +39,8 @@ 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,19 @@ /* Keep track of DO loop levels. */ -static vec doloop_list; +typedef struct { + gfc_code *c; + int branch_level; +} 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 +144,8 @@ change. */ doloop_level = 0; + if_level = 0; + select_level = 0; doloop_warn (ns); doloop_list.release (); int w, e; @@ -2231,6 +2244,7 @@ gfc_formal_arglist *f; gfc_actual_arglist *a; gfc_code *cl; + do_t loop, *lp; co = *c; @@ -2244,9 +2258,12 @@ 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; + doloop_list.safe_push (loop); break; case EXEC_CALL: @@ -2265,9 +2282,10 @@ 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 +2300,14 @@ "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); } } @@ -2304,17 +2322,268 @@ 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) { + + int errors; + + if (doloop_list.length () == 0) + return 0; + + if ((*e)->expr_type == EXPR_FUNCTION) + do_intent (e); + +#if 0 + printf("warn_do_subscript = %d, warn_do_subscript_extra = %d" + "cond = %d\n", + warn_do_subscript, warn_do_subscript_extra, + !(warn_do_subscript || warn_do_subscript_extra)); +#endif + if (!(warn_do_subscript || warn_do_subscript_extra)) + return 0; + + gfc_get_errors (NULL, &errors); + if (errors) + 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. */ + +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; + + 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; + 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; + + dl = lp->c; + if (dl == NULL) + break; + + /* If we are inside an IF statement within the DO loop + we are currently looking at, the expression may not + be evaluated. Only warn with -Wo-subscript-extra + case to avoid false positives. */ + if (lp->branch_level < if_level + select_level + && !warn_do_subscript_extra) + break; + + 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; + + /* 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); + } + + if (have_do_start || have_do_end) + { + int warn; + + if (lp->branch_level >= if_level + select_level) + warn = OPT_Wdo_subscript; + else + warn = OPT_Wdo_subscript_extra; + + for (i = 0; i< ar->dimen; i++) + { + if (ar->dimen_type[i] == DIMEN_ELEMENT && have_do_start) + { + mpz_t val; + + if (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 may be " + "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 may be " + "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) + { + mpz_t val; + + if (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 may be " + "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 may be " + "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 +2606,10 @@ 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 +2622,13 @@ 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 +4324,10 @@ WALK_SUBEXPR (co->ext.iterator->step); break; + case EXEC_IF: + if_level ++; + break; + case EXEC_WHERE: in_where = true; break; @@ -4073,6 +4346,7 @@ case EXEC_SELECT: WALK_SUBEXPR (co->expr1); + select_level ++; for (b = co->block; b; b = b->block) { gfc_case *cp; @@ -4329,6 +4603,12 @@ 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: lang.opt =================================================================== --- lang.opt (Revision 251375) +++ lang.opt (Arbeitskopie) @@ -237,6 +237,14 @@ Fortran Var(warn_conversion_extra) Warning Warn about most implicit conversions. +Wdo-subscript +Fortran Var(warn_do_subscript) Warning LangEnabledBy(Fortran,Wall || Wdo-subscript-extra) +Warn about possibly incorrect subscripts in do loops + +Wdo-subscript-extra +Fortran Var(warn_do_subscript_extra) Warning LangEnabledBy(Fortran,Wextra) +Warn about more possibly incorrect subscripts in do loops + Wextra Fortran Warning ; Documented in common