trans.c (loop_info_d): Add low_bound...
authorEric Botcazou <ebotcazou@adacore.com>
Fri, 26 Jun 2015 10:03:22 +0000 (10:03 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Fri, 26 Jun 2015 10:03:22 +0000 (10:03 +0000)
* 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) <N_Indexed_Component>: 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
gcc/ada/gcc-interface/trans.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/warn11.adb
gcc/testsuite/gnat.dg/warn12.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/warn12_pkg.ads [new file with mode: 0644]

index 3926d2df39fdabb6783da29ff00a35bfc6d47dfe..b2319aa0d5b1505fa0bec18cd09d7181c0321ecd 100644 (file)
@@ -1,3 +1,18 @@
+2015-06-26  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * 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) <N_Indexed_Component>: 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  <amacleod@redhat.com>
 
        * gcc-interface/trans.c: Remove ipa-ref.h and plugin-api.h from include
index e9a9e4ae5f87a84eef5d3e5d3441bc89bdcf6099..ff910cec343810e5bfd79bfa4fe9a1978c2610ba 100644 (file)
@@ -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<range_check_info, va_gc> *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;
 }
 \f
-/* 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<range_check_info_d> ();
-      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<range_check_info_d> ();
              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));
index bccda4a31dfd1f50253b5183c1b50e08fe5765a1..e3ae30a0a38f934540c3786ad6e1f61c45040d19 100644 (file)
@@ -1,3 +1,9 @@
+2015-06-26  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * 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  <rguenther@suse.de>
 
        * gfortran.dg/reassoc_3.f90: Adjust.
index ff24d7c336c3f912460320c337592ac5a60e2182..e92835f0533c03b84c75ddc2f7087a4266e06f3a 100644 (file)
@@ -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 (file)
index 0000000..8ffd0c7
--- /dev/null
@@ -0,0 +1,48 @@
+-- { dg-do compile }\r
+-- { dg-options "-O2" }\r
+\r
+with Text_IO; use Text_IO;\r
+with System.Storage_Elements; use System.Storage_Elements;\r
+with Warn12_Pkg; use Warn12_Pkg;\r
+\r
+procedure Warn12 (N : Natural) is\r
+\r
+   Buffer_Size : constant Storage_Offset\r
+      := Token_Groups'Size/System.Storage_Unit + 4096;\r
+\r
+   Buffer : Storage_Array (1 .. Buffer_Size);\r
+   for Buffer'Alignment use 8;\r
+\r
+   Tg1 : Token_Groups;\r
+   for Tg1'Address use Buffer'Address;\r
+\r
+   Tg2 : Token_Groups;\r
+   pragma Warnings (Off, Tg2);\r
+\r
+   sid : Sid_And_Attributes;\r
+\r
+   pragma Suppress (Index_Check, Sid_And_Attributes_Array);\r
+\r
+begin\r
+\r
+   for I in 0 .. 7 loop\r
+      sid :=  Tg1.Groups(I);  -- { dg-bogus "out-of-bounds access" }\r
+      Put_Line("Iteration");\r
+   end loop;\r
+\r
+   for I in 0 .. N loop\r
+      sid :=  Tg1.Groups(I);  -- { dg-bogus "out-of-bounds access" }\r
+      Put_Line("Iteration");\r
+   end loop;\r
+\r
+   for I in 0 .. 7 loop\r
+      sid :=  Tg2.Groups(I);  -- { dg-warning "out-of-bounds access" }\r
+      Put_Line("Iteration");\r
+   end loop;\r
+\r
+   for I in 0 .. N loop\r
+      sid :=  Tg2.Groups(I);  -- { dg-warning "out-of-bounds access" }\r
+      Put_Line("Iteration");\r
+   end loop;\r
+\r
+end;\r
diff --git a/gcc/testsuite/gnat.dg/warn12_pkg.ads b/gcc/testsuite/gnat.dg/warn12_pkg.ads
new file mode 100644 (file)
index 0000000..b3191cc
--- /dev/null
@@ -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;