diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/ada/exp_strm.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 26 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 54 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 7 |
6 files changed, 71 insertions, 32 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 82e4b13..c66023d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2015-01-06 Robert Dewar <dewar@adacore.com> + + * exp_strm.adb (Build_Elementary_Input_Call): Clarify comments + in previous checkin. + * freeze.adb (Freeze_Fixed_Point_Type): Add warning for shaving + of bounds. + * sem_prag.adb, sem_ch10.adb, sem_ch6.adb: Minor reformatting. + 2015-01-06 Vincent Celier <celier@adacore.com> * a-strsup.adb (Times (Natural;String;Positive)): Raise diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index 7186de4..21d9447 100644 --- a/gcc/ada/exp_strm.adb +++ b/gcc/ada/exp_strm.adb @@ -650,7 +650,8 @@ package body Exp_Strm is -- Now convert to the base type if we do not have a biased type. Note -- that we did not do this in some older versions, and the result was - -- losing some required range checking for the 'Read case. + -- losing a required range check in the case where 'Input is being + -- called from 'Read. if not Has_Biased_Representation (P_Type) then return Unchecked_Convert_To (Base_Type (P_Type), Res); @@ -683,7 +684,6 @@ package body Exp_Strm is Libent : Entity_Id; begin - -- Compute the size of the stream element. This is either the size of -- the first subtype or if given the size of the Stream_Size attribute. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 4765d8e..cc5553e 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -6711,7 +6711,12 @@ package body Freeze is Hival : Ureal; Atype : Entity_Id; + Orig_Lo : Ureal; + Orig_Hi : Ureal; + -- Save original bounds (for shaving tests) + Actual_Size : Nat; + -- Actual size chosen function Fsize (Lov, Hiv : Ureal) return Nat; -- Returns size of type with given bounds. Also leaves these @@ -6762,6 +6767,9 @@ package body Freeze is Loval := Realval (Lo); Hival := Realval (Hi); + Orig_Lo := Loval; + Orig_Hi := Hival; + -- Ordinary fixed-point case if Is_Ordinary_Fixed_Point_Type (Typ) then @@ -7130,6 +7138,24 @@ package body Freeze is Set_RM_Size (Typ, Minsiz); end if; end; + + -- Check for shaving + + if Comes_From_Source (Typ) then + if Orig_Lo < Expr_Value_R (Lo) then + Error_Msg_N + ("declared low bound of type & is outside type range??", Typ); + Error_Msg_N + ("\low bound adjusted up by delta (RM 3.5.9(13))??", Typ); + end if; + + if Orig_Hi > Expr_Value_R (Hi) then + Error_Msg_N + ("declared high bound of type & is outside type range??", Typ); + Error_Msg_N + ("\high bound adjusted down by delta (RM 3.5.9(13))??", Typ); + end if; + end if; end Freeze_Fixed_Point_Type; ------------------ diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index f482245..39bbcd0 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -6494,6 +6494,10 @@ package body Sem_Ch10 is Item := First (Context_Items (Comp_Unit)); while Present (Item) loop if Nkind (Item) = N_With_Clause + + -- The following guard is needed to ensure that the name has + -- been properly analyzed before we go fetching its entity. + and then Is_Entity_Name (Name (Item)) and then Entity (Name (Item)) = E and then not Private_Present (Item) diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index d0c1f9e..946f217 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -321,7 +321,8 @@ package body Sem_Ch6 is -- check whether any of them is completed by the expression function. -- In a generic context a formal subprogram has no completion. - if Present (Prev) and then Is_Overloadable (Prev) + if Present (Prev) + and then Is_Overloadable (Prev) and then not Is_Formal_Subprogram (Prev) then Def_Id := Analyze_Subprogram_Specification (Spec); @@ -380,7 +381,8 @@ package body Sem_Ch6 is -- scope. The entity itself may be internally created if within a body -- to be inlined. - elsif Present (Prev) and then Comes_From_Source (Parent (Prev)) + elsif Present (Prev) + and then Comes_From_Source (Parent (Prev)) and then not Is_Formal_Subprogram (Prev) then Set_Has_Completion (Prev, False); @@ -2043,7 +2045,7 @@ package body Sem_Ch6 is elsif Ekind (Typ) = E_Incomplete_Type or else (Is_Class_Wide_Type (Typ) - and then Ekind (Root_Type (Typ)) = E_Incomplete_Type) + and then Ekind (Root_Type (Typ)) = E_Incomplete_Type) then -- AI05-0151: Tagged incomplete types are allowed in all formal -- parts. Untagged incomplete types are not allowed in bodies. @@ -2556,13 +2558,13 @@ package body Sem_Ch6 is -- a null access (see Expand_Interface_Conversion) and then not (Is_Interface (Designated_Type (Etype (Scop))) - and then not Comes_From_Source (Parent (Scop))) + and then not Comes_From_Source (Parent (Scop))) and then (Has_Task (Designated_Type (Etype (Scop))) or else - (Is_Class_Wide_Type (Designated_Type (Etype (Scop))) - and then - Is_Limited_Record (Designated_Type (Etype (Scop))))) + (Is_Class_Wide_Type (Designated_Type (Etype (Scop))) + and then + Is_Limited_Record (Designated_Type (Etype (Scop))))) and then Expander_Active -- Avoid cases with no tasking support @@ -2633,9 +2635,8 @@ package body Sem_Ch6 is Nkind (N) = N_Pragma and then (Pragma_Name (N) = Name_Inline_Always - or else - (Front_End_Inlining - and then Pragma_Name (N) = Name_Inline)) + or else (Front_End_Inlining + and then Pragma_Name (N) = Name_Inline)) and then Chars (Expression (First (Pragma_Argument_Associations (N)))) = @@ -2822,8 +2823,9 @@ package body Sem_Ch6 is if To_Corresponding then if Is_Concurrent_Type (Formal_Typ) and then Present (Corresponding_Record_Type (Formal_Typ)) - and then Present (Interfaces ( - Corresponding_Record_Type (Formal_Typ))) + and then + Present (Interfaces + (Corresponding_Record_Type (Formal_Typ))) then Set_Etype (Formal, Corresponding_Record_Type (Formal_Typ)); @@ -3018,7 +3020,7 @@ package body Sem_Ch6 is begin if Must_Override (Body_Spec) then if Nkind (Spec_Id) = N_Defining_Operator_Symbol - and then Operator_Matches_Spec (Spec_Id, Spec_Id) + and then Operator_Matches_Spec (Spec_Id, Spec_Id) then null; @@ -3044,7 +3046,7 @@ package body Sem_Ch6 is Body_Spec, Spec_Id); elsif Nkind (Spec_Id) = N_Defining_Operator_Symbol - and then Operator_Matches_Spec (Spec_Id, Spec_Id) + and then Operator_Matches_Spec (Spec_Id, Spec_Id) then Error_Msg_NE ("subprogram& overrides predefined operator ", @@ -3407,7 +3409,7 @@ package body Sem_Ch6 is and then not Comes_From_Source (N) and then (Nkind (Original_Node (Spec_Decl)) = - N_Subprogram_Renaming_Declaration + N_Subprogram_Renaming_Declaration or else (Present (Corresponding_Body (Spec_Decl)) and then Nkind (Unit_Declaration_Node @@ -4962,19 +4964,19 @@ package body Sem_Ch6 is -- F_Ptr. We catch this case in the code below. and then (Ekind (Old_Formal_Base) = Ekind (New_Formal_Base) - or else - (Is_Generic_Type (Old_Formal_Base) - and then Is_Generic_Type (New_Formal_Base) - and then Is_Internal (New_Formal_Base) - and then Etype (Etype (New_Formal_Base)) = - Old_Formal_Base)) - and then Directly_Designated_Type (Old_Formal_Base) = - Directly_Designated_Type (New_Formal_Base) + or else + (Is_Generic_Type (Old_Formal_Base) + and then Is_Generic_Type (New_Formal_Base) + and then Is_Internal (New_Formal_Base) + and then Etype (Etype (New_Formal_Base)) = + Old_Formal_Base)) + and then Directly_Designated_Type (Old_Formal_Base) = + Directly_Designated_Type (New_Formal_Base) and then ((Is_Itype (Old_Formal_Base) and then Can_Never_Be_Null (Old_Formal_Base)) - or else - (Is_Itype (New_Formal_Base) - and then Can_Never_Be_Null (New_Formal_Base))); + or else + (Is_Itype (New_Formal_Base) + and then Can_Never_Be_Null (New_Formal_Base))); -- Types must always match. In the visible part of an instance, -- usual overloading rules for dispatching operations apply, and diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 8798fa1..dad23da 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -1382,8 +1382,7 @@ package body Sem_Prag is -- (Output =>+ null) - -- Remove the null input and replace it with a copy of the - -- output: + -- Remove null input and replace it with a copy of the output: -- (Output => Output) @@ -1459,8 +1458,8 @@ package body Sem_Prag is Propagate_Output (Output, Inputs); -- A list with multiple outputs is slowly trimmed until only - -- one element remains. When this happens, replace the - -- aggregate with the element itself. + -- one element remains. When this happens, replace aggregate + -- with the element itself. if Multiple then Remove (Output); |