* checks.adb (Enable_Overflow_Check): More precise setting of
Do_Overflow_Check flag for division.
2014-07-31 Eric Botcazou <ebotcazou@adacore.com>
* exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Reject packed
array types with implementation type.
2014-07-31 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch10.adb (Process_State): Remove local variable Name. Add
local variable Decl. Partially declare an abstract state by
generating an entity and storing it in the state declaration.
* sem_prag.adb (Create_Abstract_State): Fully declare a
semi-declared abstract state.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213335
138bc75d-0d04-0410-961f-
82ee72b054a4
2014-07-31 Robert Dewar <dewar@adacore.com>
+ * checks.adb (Enable_Overflow_Check): More precise setting of
+ Do_Overflow_Check flag for division.
+
+2014-07-31 Eric Botcazou <ebotcazou@adacore.com>
+
+ * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Reject packed
+ array types with implementation type.
+
+2014-07-31 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch10.adb (Process_State): Remove local variable Name. Add
+ local variable Decl. Partially declare an abstract state by
+ generating an entity and storing it in the state declaration.
+ * sem_prag.adb (Create_Abstract_State): Fully declare a
+ semi-declared abstract state.
+
+2014-07-31 Robert Dewar <dewar@adacore.com>
+
* prj-nmsc.adb: Minor reformatting.
2014-07-31 Bob Duff <duff@adacore.com>
if Do_Overflow_Check (N)
and then not Overflow_Checks_Suppressed (Etype (N))
then
+ Set_Do_Overflow_Check (N, False);
+
-- Test for extremely annoying case of xxx'First divided by -1
-- for division of signed integer types (only overflow case).
-- it is a Division_Check and not an Overflow_Check.
if Do_Division_Check (N) then
+ Set_Do_Division_Check (N, False);
+
if (not ROK) or else (Rlo <= 0 and then 0 <= Rhi) then
Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
Lo : Uint;
Hi : Uint;
+ Do_Ovflow_Check : Boolean;
+
begin
if Debug_Flag_CC then
w ("Enable_Overflow_Check for node ", Int (N));
-- c) The alternative is a lot of special casing in this routine
-- which would partially duplicate Determine_Range processing.
- if OK
- and then Lo > Expr_Value (Type_Low_Bound (Typ))
- and then Hi < Expr_Value (Type_High_Bound (Typ))
- then
- if Debug_Flag_CC then
- w ("No overflow check required");
+ if OK then
+ Do_Ovflow_Check := True;
+
+ -- Note that the following checks are quite deliberately > and <
+ -- rather than >= and <= as explained above.
+
+ if Lo > Expr_Value (Type_Low_Bound (Typ))
+ and then
+ Hi < Expr_Value (Type_High_Bound (Typ))
+ then
+ Do_Ovflow_Check := False;
+
+ -- Despite the comments above, it is worth dealing specially with
+ -- division specially. The only case where integer division can
+ -- overflow is (largest negative number) / (-1). So we will do
+ -- an extra range analysis to see if this is possible.
+
+ elsif Nkind (N) = N_Op_Divide then
+ Determine_Range
+ (Left_Opnd (N), OK, Lo, Hi, Assume_Valid => True);
+
+ if OK and then Lo > Expr_Value (Type_Low_Bound (Typ)) then
+ Do_Ovflow_Check := False;
+
+ else
+ Determine_Range
+ (Right_Opnd (N), OK, Lo, Hi, Assume_Valid => True);
+
+ if OK and then (Lo > Uint_Minus_1
+ or else
+ Hi < Uint_Minus_1)
+ then
+ Do_Ovflow_Check := False;
+ end if;
+ end if;
end if;
- return;
+ -- If no overflow check required, we are done
+
+ if not Do_Ovflow_Check then
+ if Debug_Flag_CC then
+ w ("No overflow check required");
+ end if;
+
+ return;
+ end if;
end if;
end if;
-- 1. N consists of a single OTHERS choice, possibly recursively
- -- 2. The array type has no atomic components
+ -- 2. The array type is not packed
- -- 3. The component type is discrete
+ -- 3. The array type has no atomic components
- -- 4. The component size is a multiple of Storage_Unit
+ -- 4. The component type is discrete
- -- 5. The component size is Storage_Unit or the value is of the form
+ -- 5. The component size is a multiple of Storage_Unit
+
+ -- 6. The component size is Storage_Unit or the value is of the form
-- M * (1 + A**1 + A**2 + .. A**(K-1)) where A = 2**(Storage_Unit)
-- and M in 1 .. A-1. This can also be viewed as K occurrences of
-- the 8-bit value M, concatenated together.
return False;
end if;
+ if Present (Packed_Array_Impl_Type (Ctyp)) then
+ return False;
+ end if;
+
if Has_Atomic_Components (Ctyp) then
return False;
end if;
Value := Value - Expr_Value (Type_Low_Bound (Ctyp));
end if;
- -- 0 and -1 immediately satisfy check #5
+ -- 0 and -1 immediately satisfy the last check
if Value = Uint_0 or else Value = Uint_Minus_1 then
return True;
procedure Process_State (State : Node_Id) is
Loc : constant Source_Ptr := Sloc (State);
+ Decl : Node_Id;
+ Dummy : Entity_Id;
Elmt : Node_Id;
Id : Entity_Id;
- Name : Name_Id;
- Dummy : Entity_Id;
begin
-- Multiple abstract states appear as an aggregate
-- extension aggregate.
elsif Nkind (State) = N_Extension_Aggregate then
- Name := Chars (Ancestor_Part (State));
+ Decl := Ancestor_Part (State);
-- Simple state declaration
elsif Nkind (State) = N_Identifier then
- Name := Chars (State);
+ Decl := State;
-- Possibly an illegal state declaration
return;
end if;
- -- Construct a dummy state for the purposes of establishing a
- -- non-limited => limited view relation. Note that the dummy
- -- state is not added to list Abstract_States to avoid multiple
- -- definitions.
+ -- Abstract states are elaborated when the related pragma is
+ -- elaborated. Since the withed package is not analyzed yet,
+ -- the entities of the abstract states are not available. To
+ -- overcome this complication, create the entities now and
+ -- store them in their respective declarations. The entities
+ -- are later used by routine Create_Abstract_State to declare
+ -- and enter the states into visibility.
+
+ if No (Entity (Decl)) then
+ Id := Make_Defining_Identifier (Loc, Chars (Decl));
+
+ Set_Entity (Decl, Id);
+ Set_Parent (Id, State);
+ Decorate_State (Id, Scop);
- Id := Make_Defining_Identifier (Loc, New_External_Name (Name));
- Set_Parent (Id, State);
- Decorate_State (Id, Scop);
+ -- Otherwise the package was previously withed
+
+ else
+ Id := Entity (Decl);
+ end if;
Build_Shadow_Entity (Id, Scop, Dummy);
end Process_State;
Is_Null : Boolean)
is
begin
- -- The generated state abstraction reuses the same chars
- -- from the original state declaration. Decorate the entity.
+ -- The abstract state may be semi-declared when the related
+ -- package was withed through a limited with clause. In that
+ -- case reuse the entity to fully declare the state.
- State_Id := Make_Defining_Identifier (Loc, Nam);
+ if Present (Decl) and then Present (Entity (Decl)) then
+ State_Id := Entity (Decl);
+
+ -- Otherwise the elaboration of pragma Abstract_State
+ -- declares the state.
+
+ else
+ State_Id := Make_Defining_Identifier (Loc, Nam);
+
+ if Present (Decl) then
+ Set_Entity (Decl, State_Id);
+ end if;
+ end if;
-- Null states never come from source
projects / platform / upstream / linaro-gcc.git / commitdiff