From 87ab2b04ae1997b5b90f5dd11494f2186ee4f3a8 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 26 Jun 2015 10:03:22 +0000 Subject: [PATCH] trans.c (loop_info_d): Add low_bound... * gcc-interface/trans.c (loop_info_d): Add low_bound, high_bound, artificial, has_checks and warned_aggressive_loop_optimizations. (gigi): Set warn_aggressive_loop_optimizations to 0. (inside_loop_p): New inline predicate. (push_range_check_info): Rename into... (find_loop_for): ...this and do not push range_check_info_d object. (Loop_Statement_to_gnu): Set artificial, low_bound and high_bound fields of gnu_loop_info. Adjust detection of checks enabled by -funswitch-loops and adds one for -faggressive-loop-optimizations. (gnat_to_gnu) : If aggressive loop optimizations are enabled, warn for loops overrunning an array of size 1 not at the end of a record. From-SVN: r224998 --- gcc/ada/ChangeLog | 15 +++++ gcc/ada/gcc-interface/trans.c | 87 ++++++++++++++++++++++------ gcc/testsuite/ChangeLog | 6 ++ gcc/testsuite/gnat.dg/warn11.adb | 2 + gcc/testsuite/gnat.dg/warn12.adb | 48 +++++++++++++++ gcc/testsuite/gnat.dg/warn12_pkg.ads | 21 +++++++ 6 files changed, 161 insertions(+), 18 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/warn12.adb create mode 100644 gcc/testsuite/gnat.dg/warn12_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3926d2df39f..b2319aa0d5b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2015-06-26 Eric Botcazou + + * gcc-interface/trans.c (loop_info_d): Add low_bound, high_bound, + artificial, has_checks and warned_aggressive_loop_optimizations. + (gigi): Set warn_aggressive_loop_optimizations to 0. + (inside_loop_p): New inline predicate. + (push_range_check_info): Rename into... + (find_loop_for): ...this and do not push range_check_info_d object. + (Loop_Statement_to_gnu): Set artificial, low_bound and high_bound + fields of gnu_loop_info. Adjust detection of checks enabled by + -funswitch-loops and adds one for -faggressive-loop-optimizations. + (gnat_to_gnu) : If aggressive loop optimizations + are enabled, warn for loops overrunning an array of size 1 not at the + end of a record. + 2015-06-25 Andrew MacLeod * gcc-interface/trans.c: Remove ipa-ref.h and plugin-api.h from include diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index e9a9e4ae5f8..ff910cec343 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -209,7 +209,12 @@ typedef struct range_check_info_d *range_check_info; struct GTY(()) loop_info_d { tree stmt; tree loop_var; + tree low_bound; + tree high_bound; vec *checks; + bool artificial; + bool has_checks; + bool warned_aggressive_loop_optimizations; }; typedef struct loop_info_d *loop_info; @@ -671,6 +676,10 @@ gigi (Node_Id gnat_root, /* Now translate the compilation unit proper. */ Compilation_Unit_to_gnu (gnat_root); + /* Disable -Waggressive-loop-optimizations since we implement our own + version of the warning. */ + warn_aggressive_loop_optimizations = 0; + /* Then process the N_Validate_Unchecked_Conversion nodes. We do this at the very end to avoid having to second-guess the front-end when we run into dummy nodes during the regular processing. */ @@ -2622,12 +2631,19 @@ Case_Statement_to_gnu (Node_Id gnat_node) return gnu_result; } -/* Find out whether VAR is an iteration variable of an enclosing loop in the - current function. If so, push a range_check_info structure onto the stack - of this enclosing loop and return it. Otherwise, return NULL. */ +/* Return true if we are in the body of a loop. */ + +static inline bool +inside_loop_p (void) +{ + return !vec_safe_is_empty (gnu_loop_stack); +} + +/* Find out whether VAR is the iteration variable of an enclosing loop in the + current function. If so, return the loop; otherwise, return NULL. */ -static struct range_check_info_d * -push_range_check_info (tree var) +static struct loop_info_d * +find_loop_for (tree var) { struct loop_info_d *iter = NULL; unsigned int i; @@ -2648,14 +2664,7 @@ push_range_check_info (tree var) if (var == iter->loop_var) break; - if (iter) - { - struct range_check_info_d *rci = ggc_alloc (); - vec_safe_push (iter->checks, rci); - return rci; - } - - return NULL; + return iter; } /* Return true if VAL (of type TYPE) can equal the minimum value if MAX is @@ -2746,6 +2755,7 @@ Loop_Statement_to_gnu (Node_Id gnat_node) /* Save the statement for later reuse. */ gnu_loop_info->stmt = gnu_loop_stmt; + gnu_loop_info->artificial = !Comes_From_Source (gnat_node); /* Set the condition under which the loop must keep going. For the case "LOOP .... END LOOP;" the condition is always true. */ @@ -2941,6 +2951,8 @@ Loop_Statement_to_gnu (Node_Id gnat_node) SET_DECL_INDUCTION_VAR (gnu_loop_var, gnu_loop_iv); } gnu_loop_info->loop_var = gnu_loop_var; + gnu_loop_info->low_bound = gnu_low; + gnu_loop_info->high_bound = gnu_high; /* Do all the arithmetics in the base type. */ gnu_loop_var = convert (gnu_base_type, gnu_loop_var); @@ -5334,7 +5346,7 @@ Raise_Error_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) { Node_Id gnat_range, gnat_index, gnat_type; tree gnu_index, gnu_low_bound, gnu_high_bound; - struct range_check_info_d *rci; + struct loop_info_d *loop; switch (Nkind (Right_Opnd (gnat_cond))) { @@ -5382,24 +5394,36 @@ Raise_Error_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) one of which has the checks eliminated and the other has the original checks reinstated, and a run time selection. The former loop will be suitable for vectorization. */ - if (flag_unswitch_loops - && !vec_safe_is_empty (gnu_loop_stack) + if (optimize + && flag_unswitch_loops + && inside_loop_p () && (!gnu_low_bound || (gnu_low_bound = gnat_invariant_expr (gnu_low_bound))) && (!gnu_high_bound || (gnu_high_bound = gnat_invariant_expr (gnu_high_bound))) - && (rci = push_range_check_info (gnu_index))) + && (loop = find_loop_for (gnu_index))) { + struct range_check_info_d *rci = ggc_alloc (); rci->low_bound = gnu_low_bound; rci->high_bound = gnu_high_bound; rci->type = get_unpadded_type (gnat_type); rci->invariant_cond = build1 (SAVE_EXPR, boolean_type_node, boolean_true_node); + vec_safe_push (loop->checks, rci); + loop->has_checks = true; gnu_cond = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node, rci->invariant_cond, gnat_to_gnu (gnat_cond)); } + + /* Or else, if aggressive loop optimizations are enabled, we just + record that there are checks applied to iteration variables. */ + else if (optimize + && flag_aggressive_loop_optimizations + && inside_loop_p () + && (loop = find_loop_for (gnu_index))) + loop->has_checks = true; } break; @@ -5939,11 +5963,13 @@ gnat_to_gnu (Node_Id gnat_node) gnat_expr_array[i] = gnat_temp; for (i = 0, gnu_type = TREE_TYPE (gnu_array_object); - i < ndim; i++, gnu_type = TREE_TYPE (gnu_type)) + i < ndim; + i++, gnu_type = TREE_TYPE (gnu_type)) { gcc_assert (TREE_CODE (gnu_type) == ARRAY_TYPE); gnat_temp = gnat_expr_array[i]; gnu_expr = gnat_to_gnu (gnat_temp); + struct loop_info_d *loop; if (Do_Range_Check (gnat_temp)) gnu_expr @@ -5965,6 +5991,31 @@ gnat_to_gnu (Node_Id gnat_node) && !(Nkind (gnat_temp) == N_Identifier && Ekind (Entity (gnat_temp)) == E_Constant)) TREE_THIS_NOTRAP (gnu_result) = 1; + + /* If aggressive loop optimizations are enabled, we warn for loops + overrunning a simple array of size 1 not at the end of a record. + This is aimed to catch misuses of the trailing array idiom. */ + if (optimize + && flag_aggressive_loop_optimizations + && inside_loop_p () + && TREE_CODE (TREE_TYPE (gnu_type)) != ARRAY_TYPE + && TREE_CODE (gnu_array_object) != ARRAY_REF + && tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_type)), + TYPE_MAX_VALUE (TYPE_DOMAIN (gnu_type))) + && !array_at_struct_end_p (gnu_result) + && (loop = find_loop_for (skip_simple_arithmetic (gnu_expr))) + && !loop->artificial + && !loop->has_checks + && tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_type)), + loop->low_bound) + && can_be_lower_p (loop->low_bound, loop->high_bound) + && !loop->warned_aggressive_loop_optimizations + && warning (OPT_Waggressive_loop_optimizations, + "out-of-bounds access may be optimized away")) + { + inform (EXPR_LOCATION (loop->stmt), "containing loop"); + loop->warned_aggressive_loop_optimizations = true; + } } gnu_result_type = get_unpadded_type (Etype (gnat_node)); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bccda4a31df..e3ae30a0a38 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2015-06-26 Eric Botcazou + + * gnat.dg/warn11.adb: Add missing dg directive. + * gnat.dg/warn12.adb: New test. + * gnat.dg/warn12_pkg.ads: New helper. + 2015-06-26 Richard Biener * gfortran.dg/reassoc_3.f90: Adjust. diff --git a/gcc/testsuite/gnat.dg/warn11.adb b/gcc/testsuite/gnat.dg/warn11.adb index ff24d7c336c..e92835f0533 100644 --- a/gcc/testsuite/gnat.dg/warn11.adb +++ b/gcc/testsuite/gnat.dg/warn11.adb @@ -1,3 +1,5 @@ +-- { dg-do compile } + with Ada.Text_IO; use Ada.Text_IO; procedure Warn11 is diff --git a/gcc/testsuite/gnat.dg/warn12.adb b/gcc/testsuite/gnat.dg/warn12.adb new file mode 100644 index 00000000000..8ffd0c7dff0 --- /dev/null +++ b/gcc/testsuite/gnat.dg/warn12.adb @@ -0,0 +1,48 @@ +-- { dg-do compile } +-- { dg-options "-O2" } + +with Text_IO; use Text_IO; +with System.Storage_Elements; use System.Storage_Elements; +with Warn12_Pkg; use Warn12_Pkg; + +procedure Warn12 (N : Natural) is + + Buffer_Size : constant Storage_Offset + := Token_Groups'Size/System.Storage_Unit + 4096; + + Buffer : Storage_Array (1 .. Buffer_Size); + for Buffer'Alignment use 8; + + Tg1 : Token_Groups; + for Tg1'Address use Buffer'Address; + + Tg2 : Token_Groups; + pragma Warnings (Off, Tg2); + + sid : Sid_And_Attributes; + + pragma Suppress (Index_Check, Sid_And_Attributes_Array); + +begin + + for I in 0 .. 7 loop + sid := Tg1.Groups(I); -- { dg-bogus "out-of-bounds access" } + Put_Line("Iteration"); + end loop; + + for I in 0 .. N loop + sid := Tg1.Groups(I); -- { dg-bogus "out-of-bounds access" } + Put_Line("Iteration"); + end loop; + + for I in 0 .. 7 loop + sid := Tg2.Groups(I); -- { dg-warning "out-of-bounds access" } + Put_Line("Iteration"); + end loop; + + for I in 0 .. N loop + sid := Tg2.Groups(I); -- { dg-warning "out-of-bounds access" } + Put_Line("Iteration"); + end loop; + +end; diff --git a/gcc/testsuite/gnat.dg/warn12_pkg.ads b/gcc/testsuite/gnat.dg/warn12_pkg.ads new file mode 100644 index 00000000000..b3191cc304f --- /dev/null +++ b/gcc/testsuite/gnat.dg/warn12_pkg.ads @@ -0,0 +1,21 @@ +with Interfaces.C; use Interfaces.C; +with System; + +package Warn12_Pkg is + + Anysize_Array: constant := 0; + + type Sid_And_Attributes is record + Sid : System.Address; + Attributes : Interfaces.C.Unsigned_Long; + end record; + + type Sid_And_Attributes_Array + is array (Integer range 0..Anysize_Array) of aliased Sid_And_Attributes; + + type Token_Groups is record + GroupCount : Interfaces.C.Unsigned_Long; + Groups : Sid_And_Attributes_Array; + end record; + +end Warn12_Pkg; -- 2.30.2