From: Thomas Koenig Date: Mon, 25 Sep 2017 16:49:48 +0000 (+0000) Subject: lang.opt: Add -Wdo-subscript. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=15e23330102f2c2a0815c70cf0ffca18fcdfdc40;p=gcc.git lang.opt: Add -Wdo-subscript. 2017-09-25 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-25 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. From-SVN: r253156 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4d64a959dbf..8cbf282e6cc 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,25 @@ +2017-09-25 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-25 Janne Blomqvist * trans.c (gfc_unlikely): Remove unnecessary fold_convert. diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 2631849743d..93f2c0fa038 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -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 ATTRIBUTE_UNUSED, gfc_formal_arglist *f; gfc_actual_arglist *a; gfc_code *cl; + do_t loop, *lp; + bool seen_goto; co = *c; @@ -2239,14 +2255,65 @@ doloop_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, 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: @@ -2265,9 +2332,10 @@ doloop_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, 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 ATTRIBUTE_UNUSED, "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 ATTRIBUTE_UNUSED, 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 ATTRIBUTE_UNUSED, 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 ATTRIBUTE_UNUSED, 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 codefn, walk_expr_fn_t exprfn, 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 codefn, walk_expr_fn_t exprfn, 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 codefn, walk_expr_fn_t exprfn, 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; } diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index f3f931fd3da..63a144276fa 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -145,8 +145,8 @@ by type. Explanations are in the following sections. @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 @@ -907,8 +907,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} @@ -1080,6 +1080,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 diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 34341e5b35b..37ed4a3291c 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ff6e5df441c..cee8e3c285c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2017-09-25 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. + 2017-09-25 Will Schmidt * gcc.target/powerpc/fold-vec-st-char.c: New. diff --git a/gcc/testsuite/gfortran.dg/do_subscript_1.f90 b/gcc/testsuite/gfortran.dg/do_subscript_1.f90 new file mode 100644 index 00000000000..a4b5058d67f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_subscript_1.f90 @@ -0,0 +1,57 @@ +! { dg-do compile } +program main + real, dimension(3) :: a + a = 42. + do i=-1,3,2 ! { dg-warning "out of bounds" } + a(i) = 0 ! { dg-warning "out of bounds \\(-1 < 1\\)" } + end do + do i=4,1,-1 ! { dg-warning "out of bounds" } + a(i) = 22 ! { dg-warning "out of bounds \\(4 > 3\\)" } + end do + do i=1,4 ! { dg-warning "out of bounds" } + a(i) = 32 ! { dg-warning "out of bounds \\(4 > 3\\)" } + end do + do i=3,0,-1 ! { dg-warning "out of bounds" } + a(i) = 12 ! { dg-warning "out of bounds \\(0 < 1\\)" } + end do + do i=-1,3 + if (i>0) a(i) = a(i) + 1 ! No warning inside if + end do + do i=-1,4 + select case(i) + case(1:3) + a(i) = -234 ! No warning inside select case + end select + end do + do i=1,3 ! { dg-warning "out of bounds" } + a(i+1) = a(i) ! { dg-warning "out of bounds \\(4 > 3\\)" } + a(i-1) = a(i) ! { dg-warning "out of bounds \\(0 < 1\\)" } + end do + do i=3,1,-1 ! { dg-warning "out of bounds" } + a(i) = a(i-1) ! { dg-warning "out of bounds \\(0 < 1\\)" } + a(i) = a(i+1) ! { dg-warning "out of bounds \\(4 > 3\\)" } + end do + do i=1,2 ! { dg-warning "out of bounds" } + a(i) = a(i*i) ! { dg-warning "out of bounds \\(4 > 3\\)" } + end do + do i=1,4,2 + a(i) = a(i)*2 ! No error + end do + do i=1,4 + if (i > 3) exit + a(i) = 33 + end do + do i=0,3 ! { dg-warning "out of bounds \\(0 < 1\\)" } + a(i) = 13. ! { dg-warning "out of bounds \\(0 < 1\\)" } + if (i < 1) exit + end do + do i=0,3 + if (i < 1) cycle + a(i) = -21. + end do + do i=0,3 ! { dg-warning "out of bounds \\(0 < 1\\)" } + do j=1,2 + a(i) = -123 ! { dg-warning "out of bounds \\(0 < 1\\)" } + end do + end do +end program main diff --git a/gcc/testsuite/gfortran.dg/do_subscript_2.f90 b/gcc/testsuite/gfortran.dg/do_subscript_2.f90 new file mode 100644 index 00000000000..efea428c7c7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_subscript_2.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! { dg-additional-options "-Wdo-subscript" } +program main + real, dimension(3) :: a + a = 42. + do i=-1,3 ! { dg-warning "out of bounds \\(-1 < 1\\)" } + select case(i) + case(1:3) + a(i) = -234 ! { dg-warning "out of bounds \\(-1 < 1\\)" } + end select + end do + do i=1,4,2 + a(i) = a(i)*2 ! No warning - end value is 3 + end do + do i=1,4 ! { dg-warning "out of bounds \\(4 > 3\\)" } + if (i > 3) exit + a(i) = 33 ! { dg-warning "out of bounds \\(4 > 3\\)" } + end do + do i=0,3 ! { dg-warning "out of bounds \\(0 < 1\\)" } + if (i < 1) cycle + a(i) = -21. ! { dg-warning "out of bounds \\(0 < 1\\)" } + end do +end program main