diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 87ed68df6ca..969fa7d3e2b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2013-01-02 Geert Bosch + + * a-nllcef.ads, a-nlcefu.ads, a-nscefu.ads: Make Pure. + +2013-01-02 Robert Dewar + + * par_sco.adb: Minor reformatting. + +2013-01-02 Javier Miranda + + * sem_aggr.adb (Resolve_Array_Aggregate): Remove dead code. + +2013-01-02 Olivier Hainque + + * a-exctra.ads (Get_PC): New function. + +2013-01-02 Thomas Quinot + + * sem_ch8.adb: Minor reformatting. + +2013-01-02 Thomas Quinot + + * sem_ch7.adb: Minor reformatting. + +2013-01-02 Thomas Quinot + + * freeze.adb (Check_Component_Storage_Order): Do not crash on + _Tag component. + 2013-01-02 Robert Dewar * gnat1drv.adb, targparm.adb, targparm.ads: Minor name change: add diff --git a/gcc/ada/a-exctra.ads b/gcc/ada/a-exctra.ads index 8bb956248f8..6d22c1c746b 100644 --- a/gcc/ada/a-exctra.ads +++ b/gcc/ada/a-exctra.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2012, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -39,12 +39,12 @@ with System.Traceback_Entries; package Ada.Exceptions.Traceback is - package TBE renames System.Traceback_Entries; + package STBE renames System.Traceback_Entries; subtype Code_Loc is System.Address; -- Code location in executing program - type Tracebacks_Array is array (Positive range <>) of TBE.Traceback_Entry; + type Tracebacks_Array is array (Positive range <>) of STBE.Traceback_Entry; -- A traceback array is an array of traceback entries function Tracebacks (E : Exception_Occurrence) return Tracebacks_Array; @@ -52,4 +52,9 @@ package Ada.Exceptions.Traceback is -- occurrence, and returns it formatted in the manner required for -- processing in GNAT.Traceback. See g-traceb.ads for further details. + function Get_PC (TBE : STBE.Traceback_Entry) return Code_Loc + renames STBE.PC_For; + -- Returns the code address held by a given traceback entry, typically the + -- address of a call instruction. + end Ada.Exceptions.Traceback; diff --git a/gcc/ada/a-nlcefu.ads b/gcc/ada/a-nlcefu.ads index 9e985dfca6a..083f6a990e3 100644 --- a/gcc/ada/a-nlcefu.ads +++ b/gcc/ada/a-nlcefu.ads @@ -19,3 +19,4 @@ with Ada.Numerics.Generic_Complex_Elementary_Functions; package Ada.Numerics.Long_Complex_Elementary_Functions is new Ada.Numerics.Generic_Complex_Elementary_Functions (Ada.Numerics.Long_Complex_Types); +pragma Pure (Ada.Numerics.Long_Complex_Elementary_Functions); diff --git a/gcc/ada/a-nllcef.ads b/gcc/ada/a-nllcef.ads index 2867e1dbb03..7a1f4b17ac3 100644 --- a/gcc/ada/a-nllcef.ads +++ b/gcc/ada/a-nllcef.ads @@ -19,3 +19,4 @@ with Ada.Numerics.Generic_Complex_Elementary_Functions; package Ada.Numerics.Long_Long_Complex_Elementary_Functions is new Ada.Numerics.Generic_Complex_Elementary_Functions (Ada.Numerics.Long_Long_Complex_Types); +pragma Pure (Ada.Numerics.Long_Long_Complex_Elementary_Functions); diff --git a/gcc/ada/a-nscefu.ads b/gcc/ada/a-nscefu.ads index ac89d051c87..0d0aa154878 100644 --- a/gcc/ada/a-nscefu.ads +++ b/gcc/ada/a-nscefu.ads @@ -19,3 +19,4 @@ with Ada.Numerics.Generic_Complex_Elementary_Functions; package Ada.Numerics.Short_Complex_Elementary_Functions is new Ada.Numerics.Generic_Complex_Elementary_Functions (Ada.Numerics.Short_Complex_Types); +pragma Pure (Ada.Numerics.Short_Complex_Elementary_Functions); diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index de49b86a13c..2b8b53782ae 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1040,11 +1040,18 @@ package body Freeze is if Present (Comp) then Err_Node := Comp; Comp_Type := Etype (Comp); - Comp_Def := Component_Definition (Parent (Comp)); - Comp_Byte_Aligned := - Present (Component_Clause (Comp)) - and then Normalized_First_Bit (Comp) mod System_Storage_Unit = 0; + if Is_Tag (Comp) then + Comp_Def := Empty; + Comp_Byte_Aligned := True; + + else + Comp_Def := Component_Definition (Parent (Comp)); + Comp_Byte_Aligned := + Present (Component_Clause (Comp)) + and then + Normalized_First_Bit (Comp) mod System_Storage_Unit = 0; + end if; -- Array case @@ -1080,7 +1087,7 @@ package body Freeze is & "storage order as enclosing composite", Err_Node); end if; - elsif Aliased_Present (Comp_Def) then + elsif Present (Comp_Def) and then Aliased_Present (Comp_Def) then Error_Msg_N ("aliased component not permitted for type with " & "explicit Scalar_Storage_Order", Err_Node); diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 6253be19134..54fe0ddb8d7 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -2170,12 +2170,12 @@ package body Par_SCO is is Spec : constant Node_Id := Specification (N); Dom : Dominant_Info; - begin - Dom := Traverse_Declarations_Or_Statements - (Visible_Declarations (Spec), D); - -- The first private declaration is dominated by the last visible - -- declaration. + begin + Dom := + Traverse_Declarations_Or_Statements (Visible_Declarations (Spec), D); + + -- First private declaration is dominated by last visible declaration Traverse_Declarations_Or_Statements (Private_Declarations (Spec), Dom); end Traverse_Package_Declaration; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 007c3c76e55..7458324a9d6 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -1877,31 +1877,6 @@ package body Sem_Aggr is return Failure; end if; - if Others_Present - and then Nkind (Parent (N)) /= N_Component_Association - and then No (Expressions (N)) - and then - Nkind (First (Choices (First (Component_Associations (N))))) - = N_Others_Choice - and then Is_Elementary_Type (Component_Typ) - and then False - then - declare - Assoc : constant Node_Id := First (Component_Associations (N)); - begin - Rewrite (Assoc, - Make_Component_Association (Loc, - Choices => - New_List ( - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Index_Typ, Loc), - Attribute_Name => Name_Range)), - Expression => Relocate_Node (Expression (Assoc)))); - return Resolve_Array_Aggregate - (N, Index, Index_Constr, Component_Typ, Others_Allowed); - end; - end if; - -- Protect against cascaded errors if Etype (Index_Typ) = Any_Type then diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 5201463617c..b81f57554aa 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -2218,7 +2218,7 @@ package body Sem_Ch7 is Write_Eol; end if; - -- On exit from the package scope, we must preserve the visibility + -- On exit from the package scope, we must preserve the visibility -- established by use clauses in the current scope. Two cases: -- a) If the entity is an operator, it may be a primitive operator of @@ -2252,8 +2252,8 @@ package body Sem_Ch7 is -- of its parent unit. if Is_Child_Unit (Id) then - Set_Is_Potentially_Use_Visible (Id, - Is_Visible_Child_Unit (Id)); + Set_Is_Potentially_Use_Visible + (Id, Is_Visible_Child_Unit (Id)); else Set_Is_Potentially_Use_Visible (Id); end if; @@ -2272,9 +2272,7 @@ package body Sem_Ch7 is -- full view is also removed from visibility: it may be exposed when -- swapping views in an instantiation. - if Is_Type (Id) - and then Present (Full_View (Id)) - then + if Is_Type (Id) and then Present (Full_View (Id)) then Set_Is_Immediately_Visible (Full_View (Id), False); end if; @@ -2328,7 +2326,7 @@ package body Sem_Ch7 is -- OK if object declaration with the No_Initialization flag set and then not (Nkind (Parent (Id)) = N_Object_Declaration - and then No_Initialization (Parent (Id))) + and then No_Initialization (Parent (Id))) then -- If no private declaration is present, we assume the user did -- not intend a deferred constant declaration and the problem @@ -2354,13 +2352,13 @@ package body Sem_Ch7 is else Error_Msg_N - ("missing full declaration for deferred constant (RM 7.4)", - Id); + ("missing full declaration for deferred constant (RM 7.4)", + Id); if Is_Limited_Type (Etype (Id)) then Error_Msg_N ("\if variable intended, remove CONSTANT from declaration", - Parent (Id)); + Parent (Id)); end if; end if; end if; @@ -2396,9 +2394,7 @@ package body Sem_Ch7 is Set_Is_Immediately_Visible (Id, False); - if Is_Private_Base_Type (Id) - and then Present (Full_View (Id)) - then + if Is_Private_Base_Type (Id) and then Present (Full_View (Id)) then Full := Full_View (Id); -- If the partial view is not declared in the visible part of the @@ -2407,8 +2403,8 @@ package body Sem_Ch7 is -- no exchange takes place. if No (Parent (Id)) - or else List_Containing (Parent (Id)) - /= Visible_Declarations (Specification (Decl)) + or else List_Containing (Parent (Id)) /= + Visible_Declarations (Specification (Decl)) then goto Next_Id; end if; @@ -2433,9 +2429,9 @@ package body Sem_Ch7 is Priv_Elmt := First_Elmt (Private_Dependents (Id)); - -- Swap out the subtypes and derived types of Id that were - -- compiled in this scope, or installed previously by - -- Install_Private_Declarations. + -- Swap out the subtypes and derived types of Id that + -- were compiled in this scope, or installed previously + -- by Install_Private_Declarations. -- Before we do the swap, we verify the presence of the Full_View -- field which may be empty due to a swap by a previous call to @@ -2445,7 +2441,6 @@ package body Sem_Ch7 is Priv_Sub := Node (Priv_Elmt); if Present (Full_View (Priv_Sub)) then - if Scope (Priv_Sub) = P or else not In_Open_Scopes (Scope (Priv_Sub)) then @@ -2615,11 +2610,11 @@ package body Sem_Ch7 is -- expander will provide an implicit completion at some point. elsif (Is_Overloadable (E) - and then Ekind (E) /= E_Enumeration_Literal - and then Ekind (E) /= E_Operator - and then not Is_Abstract_Subprogram (E) - and then not Has_Completion (E) - and then Comes_From_Source (Parent (E))) + and then Ekind (E) /= E_Enumeration_Literal + and then Ekind (E) /= E_Operator + and then not Is_Abstract_Subprogram (E) + and then not Has_Completion (E) + and then Comes_From_Source (Parent (E))) or else (Ekind (E) = E_Package @@ -2633,12 +2628,12 @@ package body Sem_Ch7 is and then not Is_Generic_Type (E)) or else - ((Ekind (E) = E_Task_Type or else - Ekind (E) = E_Protected_Type) + (Ekind_In (E, E_Task_Type, E_Protected_Type) and then not Has_Completion (E)) or else - (Ekind (E) = E_Generic_Package and then E /= P + (Ekind (E) = E_Generic_Package + and then E /= P and then not Has_Completion (E) and then Unit_Requires_Body (E)) diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 33a80e5d9fc..c02a4c36883 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -4744,7 +4744,7 @@ package body Sem_Ch8 is goto Found; -- If there is more than one potentially use-visible entity and at - -- least one of them non-overloadable, we have an error (RM 8.4(11). + -- least one of them non-overloadable, we have an error (RM 8.4(11)). -- Note that E points to the first such entity on the homonym list. -- Special case: if one of the entities is declared in an actual -- package, it was visible in the generic, and takes precedence over