* stor-layout.c (layout_type) <ARRAY_TYPE>: Do not clear TREE_OVERFLOW
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 28 Nov 2012 10:51:19 +0000 (10:51 +0000)
committerebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 28 Nov 2012 10:51:19 +0000 (10:51 +0000)
on overflowed zeroes, except in one specific case.
ada/
* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Use
valid_constant_size_p to detect too large objects.
<E_Subprogram_Type>: Likewise for too large return types.
(allocatable_size_p): Call valid_constant_size_p in the fixed case.
(annotate_value) <INTEGER_CST>: Simplify.
<BIT_AND_EXPR>: Deal with negative values here.
* gcc-interface/trans.c (gnat_to_gnu) <N_Assignment_Statement>: Use
valid_constant_size_p to detect too large objects on the LHS.
* gcc-interface/misc.c (default_pass_by_ref): Likewise for large types.
And use TYPE_SIZE_UNIT throughout.
(must_pass_by_ref): Likewise.
* gcc-interface/utils.c (max_size) <tcc_unary>: Split from common case.
<tcc_binary>: Likewise.  Call size_binop instead of fold_build2.
<tcc_expression>: Simplify.
* gcc-interface/utils2.c (build_allocator): Use valid_constant_size_p
to detect too large allocations.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@193886 138bc75d-0d04-0410-961f-82ee72b054a4

13 files changed:
gcc/ChangeLog
gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/misc.c
gcc/ada/gcc-interface/trans.c
gcc/ada/gcc-interface/utils.c
gcc/ada/gcc-interface/utils2.c
gcc/stor-layout.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/object_overflow1.adb [moved from gcc/testsuite/gnat.dg/object_overflow.adb with 87% similarity]
gcc/testsuite/gnat.dg/object_overflow2.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/object_overflow3.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/object_overflow4.adb [new file with mode: 0644]

index a15b5ef..4890147 100644 (file)
@@ -1,3 +1,8 @@
+2012-11-28  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * stor-layout.c (layout_type) <ARRAY_TYPE>: Do not clear TREE_OVERFLOW
+       on overflowed zeroes, except in one specific case.
+
 2012-11-28  Marc Glisse  <marc.glisse@inria.fr>
 
        PR middle-end/55266
index 7e1c7bc..0e7d3c8 100644 (file)
@@ -1,3 +1,22 @@
+2012-11-27  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Use
+       valid_constant_size_p to detect too large objects.
+       <E_Subprogram_Type>: Likewise for too large return types.
+       (allocatable_size_p): Call valid_constant_size_p in the fixed case.
+       (annotate_value) <INTEGER_CST>: Simplify.
+       <BIT_AND_EXPR>: Deal with negative values here.
+       * gcc-interface/trans.c (gnat_to_gnu) <N_Assignment_Statement>: Use
+       valid_constant_size_p to detect too large objects on the LHS.
+       * gcc-interface/misc.c (default_pass_by_ref): Likewise for large types.
+       And use TYPE_SIZE_UNIT throughout.
+       (must_pass_by_ref): Likewise.
+       * gcc-interface/utils.c (max_size) <tcc_unary>: Split from common case.
+       <tcc_binary>: Likewise.  Call size_binop instead of fold_build2.
+       <tcc_expression>: Simplify.
+       * gcc-interface/utils2.c (build_allocator): Use valid_constant_size_p
+       to detect too large allocations.
+
 2012-11-23  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/trans.c (Attribute_to_gnu) <Attr_Length>: Look through
index a5205ce..094d7e0 100644 (file)
@@ -1337,7 +1337,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                  }
 
                if (TREE_CODE (TYPE_SIZE_UNIT (gnu_alloc_type)) == INTEGER_CST
-                   && TREE_OVERFLOW (TYPE_SIZE_UNIT (gnu_alloc_type)))
+                   && !valid_constant_size_p (TYPE_SIZE_UNIT (gnu_alloc_type)))
                  post_error ("?`Storage_Error` will be raised at run time!",
                              gnat_entity);
 
@@ -4240,8 +4240,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
               a function that returns that type.  This usage doesn't make
               sense anyway, so give an error here.  */
            if (TYPE_SIZE_UNIT (gnu_return_type)
-               && TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_return_type))
-               && TREE_OVERFLOW (TYPE_SIZE_UNIT (gnu_return_type)))
+               && TREE_CODE (TYPE_SIZE_UNIT (gnu_return_type)) == INTEGER_CST
+               && !valid_constant_size_p (TYPE_SIZE_UNIT (gnu_return_type)))
              {
                post_error ("cannot return type whose size overflows",
                            gnat_entity);
@@ -5989,10 +5989,9 @@ elaborate_entity (Entity_Id gnat_entity)
 static bool
 allocatable_size_p (tree gnu_size, bool static_p)
 {
-  /* We can allocate a fixed size if it hasn't overflowed and can be handled
-     (efficiently) on the host.  */
+  /* We can allocate a fixed size if it is a valid for the middle-end.  */
   if (TREE_CODE (gnu_size) == INTEGER_CST)
-    return !TREE_OVERFLOW (gnu_size) && host_integerp (gnu_size, 1);
+    return valid_constant_size_p (gnu_size);
 
   /* We can allocate a variable size if this isn't a static allocation.  */
   else
@@ -7254,7 +7253,7 @@ static Uint
 annotate_value (tree gnu_size)
 {
   TCode tcode;
-  Node_Ref_Or_Val ops[3], ret;
+  Node_Ref_Or_Val ops[3], ret, pre_op1 = No_Uint;
   struct tree_int_map in;
   int i;
 
@@ -7283,24 +7282,7 @@ annotate_value (tree gnu_size)
   switch (TREE_CODE (gnu_size))
     {
     case INTEGER_CST:
-      if (TREE_OVERFLOW (gnu_size))
-       return No_Uint;
-
-      /* This may come from a conversion from some smaller type, so ensure
-        this is in bitsizetype.  */
-      gnu_size = convert (bitsizetype, gnu_size);
-
-      /* For a negative value, build NEGATE_EXPR of the opposite.  Such values
-        appear in expressions containing aligning patterns.  Note that, since
-        sizetype is sign-extended but nonetheless unsigned, we don't directly
-        use tree_int_cst_sgn.  */
-      if (TREE_INT_CST_HIGH (gnu_size) < 0)
-       {
-         tree op_size = fold_build1 (NEGATE_EXPR, bitsizetype, gnu_size);
-         return annotate_value (build1 (NEGATE_EXPR, bitsizetype, op_size));
-       }
-
-      return UI_From_gnu (gnu_size);
+      return TREE_OVERFLOW (gnu_size) ? No_Uint : UI_From_gnu (gnu_size);
 
     case COMPONENT_REF:
       /* The only case we handle here is a simple discriminant reference.  */
@@ -7339,7 +7321,6 @@ annotate_value (tree gnu_size)
     case TRUTH_OR_EXPR:                tcode = Truth_Or_Expr; break;
     case TRUTH_XOR_EXPR:       tcode = Truth_Xor_Expr; break;
     case TRUTH_NOT_EXPR:       tcode = Truth_Not_Expr; break;
-    case BIT_AND_EXPR:         tcode = Bit_And_Expr; break;
     case LT_EXPR:              tcode = Lt_Expr; break;
     case LE_EXPR:              tcode = Le_Expr; break;
     case GT_EXPR:              tcode = Gt_Expr; break;
@@ -7347,6 +7328,24 @@ annotate_value (tree gnu_size)
     case EQ_EXPR:              tcode = Eq_Expr; break;
     case NE_EXPR:              tcode = Ne_Expr; break;
 
+    case BIT_AND_EXPR:
+      tcode = Bit_And_Expr;
+      /* For negative values, build NEGATE_EXPR of the opposite.  Such values
+        appear in expressions containing aligning patterns.  Note that, since
+        sizetype is unsigned, we have to jump through some hoops.   */
+      if (TREE_CODE (TREE_OPERAND (gnu_size, 1)) == INTEGER_CST)
+       {
+         tree op1 = TREE_OPERAND (gnu_size, 1);
+         double_int signed_op1
+           = tree_to_double_int (op1).sext (TYPE_PRECISION (sizetype));
+         if (signed_op1.is_negative ())
+           {
+             op1 = double_int_to_tree (sizetype, -signed_op1);
+             pre_op1 = annotate_value (build1 (NEGATE_EXPR, sizetype, op1));
+           }
+       }
+      break;
+
     case CALL_EXPR:
       {
        tree t = maybe_inline_call_in_expr (gnu_size);
@@ -7367,7 +7366,10 @@ annotate_value (tree gnu_size)
 
   for (i = 0; i < TREE_CODE_LENGTH (TREE_CODE (gnu_size)); i++)
     {
-      ops[i] = annotate_value (TREE_OPERAND (gnu_size, i));
+      if (i == 1 && pre_op1 != No_Uint)
+       ops[i] = pre_op1;
+      else
+       ops[i] = annotate_value (TREE_OPERAND (gnu_size, i));
       if (ops[i] == No_Uint)
        return No_Uint;
     }
index baa44c9..3d3f161 100644 (file)
@@ -604,8 +604,8 @@ gnat_get_subrange_bounds (const_tree gnu_type, tree *lowval, tree *highval)
 bool
 default_pass_by_ref (tree gnu_type)
 {
-  /* We pass aggregates by reference if they are sufficiently large.  The
-     choice of constant here is somewhat arbitrary.  We also pass by
+  /* We pass aggregates by reference if they are sufficiently large for
+     their alignment.  The ratio is somewhat arbitrary.  We also pass by
      reference if the target machine would either pass or return by
      reference.  Strictly speaking, we need only check the return if this
      is an In Out parameter, but it's probably best to err on the side of
@@ -618,9 +618,9 @@ default_pass_by_ref (tree gnu_type)
     return true;
 
   if (AGGREGATE_TYPE_P (gnu_type)
-      && (!host_integerp (TYPE_SIZE (gnu_type), 1)
-         || 0 < compare_tree_int (TYPE_SIZE (gnu_type),
-                                  8 * TYPE_ALIGN (gnu_type))))
+      && (!valid_constant_size_p (TYPE_SIZE_UNIT (gnu_type))
+         || 0 < compare_tree_int (TYPE_SIZE_UNIT (gnu_type),
+                                  TYPE_ALIGN (gnu_type))))
     return true;
 
   return false;
@@ -639,8 +639,8 @@ must_pass_by_ref (tree gnu_type)
      not have such objects.  */
   return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
          || TYPE_IS_BY_REFERENCE_P (gnu_type)
-         || (TYPE_SIZE (gnu_type)
-             && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST));
+         || (TYPE_SIZE_UNIT (gnu_type)
+             && TREE_CODE (TYPE_SIZE_UNIT (gnu_type)) != INTEGER_CST));
 }
 
 /* This function is called by the front-end to enumerate all the supported
index 7194129..291d00f 100644 (file)
@@ -6115,7 +6115,7 @@ gnat_to_gnu (Node_Id gnat_node)
       /* If the type has a size that overflows, convert this into raise of
         Storage_Error: execution shouldn't have gotten here anyway.  */
       if (TREE_CODE (TYPE_SIZE_UNIT (TREE_TYPE (gnu_lhs))) == INTEGER_CST
-          && TREE_OVERFLOW (TYPE_SIZE_UNIT (TREE_TYPE (gnu_lhs))))
+          && !valid_constant_size_p (TYPE_SIZE_UNIT (TREE_TYPE (gnu_lhs))))
        gnu_result = build_call_raise (SE_Object_Too_Large, gnat_node,
                                       N_Raise_Storage_Error);
       else if (Nkind (Expression (gnat_node)) == N_Function_Call)
index 6aa465b..716ea9e 100644 (file)
@@ -3024,59 +3024,67 @@ max_size (tree exp, bool max_p)
       return max_p ? size_one_node : size_zero_node;
 
     case tcc_unary:
+      if (code == NON_LVALUE_EXPR)
+       return max_size (TREE_OPERAND (exp, 0), max_p);
+      return fold_build1 (code, type,
+                         max_size (TREE_OPERAND (exp, 0),
+                                   code == NEGATE_EXPR ? !max_p : max_p));
+
     case tcc_binary:
+      {
+       tree lhs = max_size (TREE_OPERAND (exp, 0), max_p);
+       tree rhs = max_size (TREE_OPERAND (exp, 1),
+                            code == MINUS_EXPR ? !max_p : max_p);
+
+       /* Special-case wanting the maximum value of a MIN_EXPR.
+          In that case, if one side overflows, return the other.  */
+       if (max_p && code == MIN_EXPR)
+         {
+           if (TREE_CODE (rhs) == INTEGER_CST && TREE_OVERFLOW (rhs))
+             return lhs;
+
+           if (TREE_CODE (lhs) == INTEGER_CST && TREE_OVERFLOW (lhs))
+             return rhs;
+         }
+
+       /* Likewise, handle a MINUS_EXPR or PLUS_EXPR with the LHS
+          overflowing and the RHS a variable.  */
+       if ((code == MINUS_EXPR || code == PLUS_EXPR)
+           && TREE_CODE (lhs) == INTEGER_CST
+           && TREE_OVERFLOW (lhs)
+           && !TREE_CONSTANT (rhs))
+         return lhs;
+
+       return size_binop (code, lhs, rhs);
+      }
+
     case tcc_expression:
       switch (TREE_CODE_LENGTH (code))
        {
        case 1:
          if (code == SAVE_EXPR)
            return exp;
-         else if (code == NON_LVALUE_EXPR)
-           return max_size (TREE_OPERAND (exp, 0), max_p);
-         else
-           return
-             fold_build1 (code, type,
-                          max_size (TREE_OPERAND (exp, 0),
-                                    code == NEGATE_EXPR ? !max_p : max_p));
+
+         return fold_build1 (code, type,
+                             max_size (TREE_OPERAND (exp, 0), max_p));
 
        case 2:
          if (code == COMPOUND_EXPR)
            return max_size (TREE_OPERAND (exp, 1), max_p);
 
-         {
-           tree lhs = max_size (TREE_OPERAND (exp, 0), max_p);
-           tree rhs = max_size (TREE_OPERAND (exp, 1),
-                                code == MINUS_EXPR ? !max_p : max_p);
-
-           /* Special-case wanting the maximum value of a MIN_EXPR.
-              In that case, if one side overflows, return the other.
-              sizetype is signed, but we know sizes are non-negative.
-              Likewise, handle a MINUS_EXPR or PLUS_EXPR with the LHS
-              overflowing and the RHS a variable.  */
-           if (max_p
-               && code == MIN_EXPR
-               && TREE_CODE (rhs) == INTEGER_CST
-               && TREE_OVERFLOW (rhs))
-             return lhs;
-           else if (max_p
-                    && code == MIN_EXPR
-                    && TREE_CODE (lhs) == INTEGER_CST
-                    && TREE_OVERFLOW (lhs))
-             return rhs;
-           else if ((code == MINUS_EXPR || code == PLUS_EXPR)
-                    && TREE_CODE (lhs) == INTEGER_CST
-                    && TREE_OVERFLOW (lhs)
-                    && !TREE_CONSTANT (rhs))
-             return lhs;
-           else
-             return fold_build2 (code, type, lhs, rhs);
-         }
+         return fold_build2 (code, type,
+                             max_size (TREE_OPERAND (exp, 0), max_p),
+                             max_size (TREE_OPERAND (exp, 1), max_p));
 
        case 3:
          if (code == COND_EXPR)
            return fold_build2 (max_p ? MAX_EXPR : MIN_EXPR, type,
                                max_size (TREE_OPERAND (exp, 1), max_p),
                                max_size (TREE_OPERAND (exp, 2), max_p));
+
+       default:
+         break;
        }
 
       /* Other tree classes cannot happen.  */
index 4bb16ec..71dd8e5 100644 (file)
@@ -2286,7 +2286,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
                                             init);
 
       /* If the size overflows, pass -1 so Storage_Error will be raised.  */
-      if (TREE_CODE (size) == INTEGER_CST && TREE_OVERFLOW (size))
+      if (TREE_CODE (size) == INTEGER_CST && !valid_constant_size_p (size))
        size = size_int (-1);
 
       storage = build_call_alloc_dealloc (NULL_TREE, size, storage_type,
@@ -2345,7 +2345,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
     }
 
   /* If the size overflows, pass -1 so Storage_Error will be raised.  */
-  if (TREE_CODE (size) == INTEGER_CST && TREE_OVERFLOW (size))
+  if (TREE_CODE (size) == INTEGER_CST && !valid_constant_size_p (size))
     size = size_int (-1);
 
   storage = convert (result_type,
index 4ac24f1..d0c093f 100644 (file)
@@ -2233,12 +2233,12 @@ layout_type (tree type)
                                              size_binop (MINUS_EXPR, ub, lb)));
              }
 
-           /* If we arrived at a length of zero ignore any overflow
-              that occurred as part of the calculation.  There exists
-              an association of the plus one where that overflow would
-              not happen.  */
+           /* ??? We have no way to distinguish a null-sized array from an
+              array spanning the whole sizetype range, so we arbitrarily
+              decide that [0, -1] is the only valid representation.  */
            if (integer_zerop (length)
-               && TREE_OVERFLOW (length))
+               && TREE_OVERFLOW (length)
+               && integer_zerop (lb))
              length = size_zero_node;
 
            TYPE_SIZE (type) = size_binop (MULT_EXPR, element_size,
index f13beba..d01a700 100644 (file)
@@ -1,3 +1,11 @@
+2012-11-28  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/object_overflow.adb: Rename to...
+       * gnat.dg/object_overflow1.adb: ...this.
+       * gnat.dg/object_overflow2.adb: New test.
+       * gnat.dg/object_overflow3.adb: Likewise.
+       * gnat.dg/object_overflow4.adb: Likewise.
+
 2012-11-28  Paolo Carlini  <paolo.carlini@oracle.com>
 
        PR c++/55497
similarity index 87%
rename from gcc/testsuite/gnat.dg/object_overflow.adb
rename to gcc/testsuite/gnat.dg/object_overflow1.adb
index 41b6184..ba7f657 100644 (file)
@@ -1,6 +1,6 @@
 -- { dg-do compile }
 
-procedure Object_Overflow is
+procedure Object_Overflow1 is
 
   procedure Proc (x : Boolean) is begin null; end;
 
diff --git a/gcc/testsuite/gnat.dg/object_overflow2.adb b/gcc/testsuite/gnat.dg/object_overflow2.adb
new file mode 100644 (file)
index 0000000..9601c56
--- /dev/null
@@ -0,0 +1,13 @@
+-- { dg-do compile }
+
+procedure Object_Overflow2 is
+
+  procedure Proc (x : Boolean) is begin null; end;
+
+  type Arr is array(0 .. Long_Integer'Last) of Boolean;
+  Obj : Arr; -- { dg-warning "Storage_Error" }
+
+begin
+  Obj(1) := True;
+  Proc (Obj(1));
+end;
diff --git a/gcc/testsuite/gnat.dg/object_overflow3.adb b/gcc/testsuite/gnat.dg/object_overflow3.adb
new file mode 100644 (file)
index 0000000..5e27b4f
--- /dev/null
@@ -0,0 +1,19 @@
+-- { dg-do compile }
+
+procedure Object_Overflow3 is
+
+  procedure Proc (x : Boolean) is begin null; end;
+
+  type Arr is array(0 .. Long_Integer'Last) of Boolean;
+
+  type Rec is record
+    A : Arr;
+    B : Arr;
+  end record;
+
+  Obj : Rec; -- { dg-warning "Storage_Error" }
+
+begin
+  Obj.A(1) := True;
+  Proc (Obj.A(1));
+end;
diff --git a/gcc/testsuite/gnat.dg/object_overflow4.adb b/gcc/testsuite/gnat.dg/object_overflow4.adb
new file mode 100644 (file)
index 0000000..643989d
--- /dev/null
@@ -0,0 +1,20 @@
+-- { dg-do compile }
+
+procedure Object_Overflow4 is
+
+  procedure Proc (x : Integer) is begin null; end;
+
+  type Index is new Long_Integer range 0 .. Long_Integer'Last;
+
+  type Arr is array(Index range <>) of Integer;
+
+  type Rec (Size: Index := 6) is record -- { dg-warning "Storage_Error" }
+    A: Arr (0..Size);
+  end record;
+
+  Obj : Rec; -- { dg-warning "Storage_Error" }
+
+begin
+  Obj.A(1) := 0;
+  Proc (Obj.A(1));
+end;