decl.c (gnat_to_gnu_entity): Do not force a non-null size if it has overflowed.
* decl.c (gnat_to_gnu_entity) <object>: Do not force a non-null size if it has overflowed. From-SVN: r133768
This commit is contained in:
parent
a12bdb97c9
commit
5a864002b8
4 changed files with 30 additions and 3 deletions
|
@ -1,5 +1,10 @@
|
|||
2008-03-31 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* decl.c (gnat_to_gnu_entity) <object>: Do not force a non-null
|
||||
size if it has overflowed.
|
||||
|
||||
2008-03-31 Olivier Hainque <hainque@adacore.com>
|
||||
Eric Botcazou <botcazou@adacore.com>
|
||||
Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* utils2.c (find_common_type): Document assumption on t1/t2 vs
|
||||
lhs/rhs. Force use of lhs type if smaller, whatever the modes.
|
||||
|
|
|
@ -640,8 +640,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
clause, as we would lose useful information on the view size
|
||||
(e.g. for null array slices) and we are not allocating the object
|
||||
here anyway. */
|
||||
if (((gnu_size && integer_zerop (gnu_size))
|
||||
|| (TYPE_SIZE (gnu_type) && integer_zerop (TYPE_SIZE (gnu_type))))
|
||||
if (((gnu_size
|
||||
&& integer_zerop (gnu_size)
|
||||
&& !TREE_OVERFLOW (gnu_size))
|
||||
|| (TYPE_SIZE (gnu_type)
|
||||
&& integer_zerop (TYPE_SIZE (gnu_type))
|
||||
&& !TREE_OVERFLOW (TYPE_SIZE (gnu_type))))
|
||||
&& (!Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
|
||||
|| !Is_Array_Type (Etype (gnat_entity)))
|
||||
&& !Present (Renamed_Object (gnat_entity))
|
||||
|
|
|
@ -1,3 +1,7 @@
|
|||
2008-03-31 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gnat.dg/object_overflow.adb: New test.
|
||||
|
||||
2008-03-31 Andrew Pinski <andrew_pinski@playstation.sony.com>
|
||||
|
||||
PR middle-end/30186
|
||||
|
|
14
gcc/testsuite/gnat.dg/object_overflow.adb
Normal file
14
gcc/testsuite/gnat.dg/object_overflow.adb
Normal file
|
@ -0,0 +1,14 @@
|
|||
-- { dg-do compile }
|
||||
|
||||
procedure Object_Overflow is
|
||||
|
||||
type Rec is null record;
|
||||
|
||||
procedure Proc (x : Rec) is begin null; end;
|
||||
|
||||
type Arr is array(Long_Integer) of Rec;
|
||||
Obj : Arr; -- { dg-warning "Storage_Error will be raised" }
|
||||
|
||||
begin
|
||||
Proc (Obj(1));
|
||||
end;
|
Loading…
Add table
Reference in a new issue