diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 18 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 57 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 34 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 19 |
5 files changed, 118 insertions, 26 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 85f4f7c..bd7154f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,23 @@ 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> diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 3fb352e..f75f1c6 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -1795,6 +1795,8 @@ package body Checks is 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). @@ -1855,6 +1857,8 @@ package body Checks is -- 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, @@ -5110,6 +5114,8 @@ package body Checks is Lo : Uint; Hi : Uint; + Do_Ovflow_Check : Boolean; + begin if Debug_Flag_CC then w ("Enable_Overflow_Check for node ", Int (N)); @@ -5187,15 +5193,52 @@ package body Checks is -- 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; diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 9dd983c..19debb3 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4039,13 +4039,15 @@ package body Exp_Aggr is -- 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. @@ -4071,6 +4073,10 @@ package body Exp_Aggr is 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; @@ -4119,7 +4125,7 @@ package body Exp_Aggr is 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; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 189695c..aea29d0 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -5695,10 +5695,10 @@ package body Sem_Ch10 is 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 @@ -5721,12 +5721,12 @@ package body Sem_Ch10 is -- 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 @@ -5734,14 +5734,26 @@ package body Sem_Ch10 is 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; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 983cb32..10ffab9 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -10519,10 +10519,23 @@ package body Sem_Prag is 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 |