diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 90120e89d55..b4b679e8c0b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2009-07-30 Robert Dewar + + * a-teioed.adb, exp_disp.adb, s-linux-hppa.ads, s-linux.ads, + s-tasini.adb, sem_ch13.adb, sem_ch3.adb, sem_ch3.ads, sem_ch6.adb, + sem_ch7.adb: Minor reformatting + 2009-07-29 Javier Miranda * sem_ch3.ads, sem_ch3.adb (Add_Internal_Interface_Entities): Routine diff --git a/gcc/ada/a-teioed.adb b/gcc/ada/a-teioed.adb index e2408a45194..cfe64c3b64e 100644 --- a/gcc/ada/a-teioed.adb +++ b/gcc/ada/a-teioed.adb @@ -71,16 +71,16 @@ package body Ada.Text_IO.Editing is case Picture (Picture_Index) is when '(' => - Int_IO.Get (Picture (Picture_Index + 1 .. Picture'Last), - Count, Last); + Int_IO.Get + (Picture (Picture_Index + 1 .. Picture'Last), Count, Last); if Picture (Last + 1) /= ')' then raise Picture_Error; end if; - -- In what follows note that one copy of the repeated - -- character has already been made, so a count of one is a - -- no-op, and a count of zero erases a character. + -- In what follows note that one copy of the repeated character + -- has already been made, so a count of one is a no-op, and a + -- count of zero erases a character. if Result_Index + Count - 2 > Result'Last then raise Picture_Error; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index a38e4d8b943..f34b1e9af33 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -6915,13 +6915,12 @@ package body Exp_Disp is begin pragma Assert (Present (First_Tag_Component (Typ))); - -- Set the DT_Position for each primitive operation. Perform some - -- sanity checks to avoid to build completely inconsistent dispatch - -- tables. + -- Set the DT_Position for each primitive operation. Perform some sanity + -- checks to avoid building inconsistent dispatch tables. - -- First stage: Set the DTC entity of all the primitive operations - -- This is required to properly read the DT_Position attribute in - -- the latter stages. + -- First stage: Set the DTC entity of all the primitive operations. This + -- is required to properly read the DT_Position attribute in the latter + -- stages. Prim_Elmt := First_Prim; Count_Prim := 0; @@ -6931,7 +6930,8 @@ package body Exp_Disp is -- Predefined primitives have a separate dispatch table if not (Is_Predefined_Dispatching_Operation (Prim) - or else Is_Predefined_Dispatching_Alias (Prim)) + or else + Is_Predefined_Dispatching_Alias (Prim)) then Count_Prim := Count_Prim + 1; end if; diff --git a/gcc/ada/s-linux-hppa.ads b/gcc/ada/s-linux-hppa.ads index 16393c539f6..6176376cbeb 100644 --- a/gcc/ada/s-linux-hppa.ads +++ b/gcc/ada/s-linux-hppa.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2008-2009, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- diff --git a/gcc/ada/s-linux.ads b/gcc/ada/s-linux.ads index 83b07c018e6..29918d7d4ca 100644 --- a/gcc/ada/s-linux.ads +++ b/gcc/ada/s-linux.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2008-2009, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- diff --git a/gcc/ada/s-tasini.adb b/gcc/ada/s-tasini.adb index 28b86cb5765..cacd86c4c22 100644 --- a/gcc/ada/s-tasini.adb +++ b/gcc/ada/s-tasini.adb @@ -190,13 +190,14 @@ package body System.Tasking.Initialization is return; end if; + -- The following assertion is by default disabled. See the comment in + -- Defer_Abort on the situations in which it may be useful to uncomment + -- this assertion and enable the test. + -- pragma Assert -- (Self_ID.Pending_ATC_Level >= Self_ID.ATC_Nesting_Level or else -- Self_ID.Deferral_Level > 0); - -- See comment in Defer_Abort on the situations in which it may be - -- useful to uncomment the above assertion. - Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1; end Defer_Abort_Nestable; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 6542dd28174..d76475f7d30 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2202,6 +2202,11 @@ package body Sem_Ch13 is -- Analyze_Freeze_Entity -- --------------------------- + -- This does not belong in sem_ch13, and I don't like the big new + -- dependency on sem_ch3, I would in fact move this to sem_ch3 or + -- somewhere else, and then Add_Internal_Interface_Entitites can be + -- private to sem_ch3.adb. ??? + procedure Analyze_Freeze_Entity (N : Node_Id) is E : constant Entity_Id := Entity (N); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index d8f1e1dd36b..adea69db29e 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -753,6 +753,7 @@ package body Sem_Ch3 is -- is associated with one of the protected operations, and must -- be available in the scope that encloses the protected declaration. -- Otherwise the type is in the scope enclosing the subprogram. + -- If the function has formals, The return type of a subprogram -- declaration is analyzed in the scope of the subprogram (see -- Process_Formals) and thus the protected type, if present, is @@ -1532,11 +1533,10 @@ package body Sem_Ch3 is while Present (Iface_Elmt) loop Iface := Node (Iface_Elmt); - -- Exclude from this processing interfaces that are parents - -- of Tagged_Type because their primitives are located in the - -- primary dispatch table (and hence no auxiliary internal - -- entities are required to handle secondary dispatch tables - -- in such case). + -- Exclude from this processing interfaces that are parents of + -- Tagged_Type because their primitives are located in the primary + -- dispatch table (and hence no auxiliary internal entities are + -- required to handle secondary dispatch tables in such case). if not Is_Ancestor (Iface, Tagged_Type) then Elmt := First_Elmt (Primitive_Operations (Iface)); @@ -1572,19 +1572,19 @@ package body Sem_Ch3 is Set_Interface_Alias (New_Subp, Iface_Prim); -- Internal entities associated with interface types are - -- only registered in the list of primitives of the - -- tagged type. They are only used to fill the contents - -- of the secondary dispatch tables. Therefore they are - -- not needed in the homonym chains. + -- only registered in the list of primitives of the tagged + -- type. They are only used to fill the contents of the + -- secondary dispatch tables. Therefore they are not needed + -- in the homonym chains. Remove_Homonym (New_Subp); - -- Hidden entities associated with interfaces must have - -- set the Has_Delay_Freeze attribute to ensure that, in - -- case of locally defined tagged types (or compiling - -- with static dispatch tables generation disabled) the - -- corresponding entry of the secondary dispatch table is - -- filled when such entity is frozen. + -- Hidden entities associated with interfaces must have set + -- the Has_Delay_Freeze attribute to ensure that, in case of + -- locally defined tagged types (or compiling with static + -- dispatch tables generation disabled) the corresponding + -- entry of the secondary dispatch table is filled when + -- such an entity is frozen. Set_Has_Delayed_Freeze (New_Subp); end if; diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads index 477f0205f38..6bfa52844d0 100644 --- a/gcc/ada/sem_ch3.ads +++ b/gcc/ada/sem_ch3.ads @@ -100,23 +100,22 @@ package Sem_Ch3 is -- Could both mechanisms be merged ??? procedure Check_Abstract_Overriding (T : Entity_Id); - -- Check that all abstract subprograms inherited from T's parent type - -- have been overridden as required, and that nonabstract subprograms - -- have not been incorrectly overridden with an abstract subprogram. + -- Check that all abstract subprograms inherited from T's parent type have + -- been overridden as required, and that nonabstract subprograms have not + -- been incorrectly overridden with an abstract subprogram. procedure Check_Aliased_Component_Types (T : Entity_Id); -- Given an array type or record type T, check that if the type is - -- nonlimited, then the nominal subtype of any components of T - -- that have discriminants must be constrained. + -- nonlimited, then the nominal subtype of any components of T that + -- have discriminants must be constrained. procedure Check_Completion (Body_Id : Node_Id := Empty); - -- At the end of a declarative part, verify that all entities that - -- require completion have received one. If Body_Id is absent, the - -- error indicating a missing completion is placed on the declaration - -- that needs completion. If Body_Id is present, it is the defining - -- identifier of a package body, and errors are posted on that node, - -- rather than on the declarations that require completion in the package - -- declaration. + -- At the end of a declarative part, verify that all entities that require + -- completion have received one. If Body_Id is absent, the error indicating + -- a missing completion is placed on the declaration that needs completion. + -- If Body_Id is present, it is the defining identifier of a package body, + -- and errors are posted on that node, rather than on the declarations that + -- require completion in the package declaration. procedure Derive_Subprogram (New_Subp : in out Entity_Id; @@ -143,8 +142,8 @@ package Sem_Ch3 is -- the derived subprograms are aliased to those of the actual, not those of -- the ancestor. -- - -- Note: one might expect this to be private to the package body, but - -- there is one rather unusual usage in package Exp_Dist. + -- Note: one might expect this to be private to the package body, but there + -- is one rather unusual usage in package Exp_Dist. function Find_Hidden_Interface (Src : Elist_Id; @@ -167,8 +166,8 @@ package Sem_Ch3 is Typ_For_Constraint : Entity_Id; Constraint : Elist_Id) return Node_Id; -- ??? MORE DOCUMENTATION - -- Given a discriminant somewhere in the Typ_For_Constraint tree - -- and a Constraint, return the value of that discriminant. + -- Given a discriminant somewhere in the Typ_For_Constraint tree and a + -- Constraint, return the value of that discriminant. function Is_Null_Extension (T : Entity_Id) return Boolean; -- Returns True if the tagged type T has an N_Full_Type_Declaration that @@ -237,7 +236,7 @@ package Sem_Ch3 is -- of the dependant private subtypes. The second action is to recopy the -- primitive operations of the private view (in the tagged case). -- N is the N_Full_Type_Declaration node. - + -- -- Full_T is the full view of the type whose full declaration is in N. -- -- Priv_T is the private view of the type whose full declaration is in N. @@ -248,16 +247,16 @@ package Sem_Ch3 is Check_List : List_Id := Empty_List; R_Check_Off : Boolean := False); -- Process a range expression that appears in a declaration context. The - -- range is analyzed and resolved with the base type of the given type, - -- and an appropriate check for expressions in non-static contexts made - -- on the bounds. R is analyzed and resolved using T, so the caller should - -- if necessary link R into the tree before the call, and in particular in - -- the case of a subtype declaration, it is appropriate to set the parent - -- pointer of R so that the types get properly frozen. The Check_List - -- parameter is used when the subprogram is called from - -- Build_Record_Init_Proc and is used to return a set of constraint - -- checking statements generated by the Checks package. R_Check_Off is set - -- to True when the call to Range_Check is to be skipped. + -- range is analyzed and resolved with the base type of the given type, and + -- an appropriate check for expressions in non-static contexts made on the + -- bounds. R is analyzed and resolved using T, so the caller should if + -- necessary link R into the tree before the call, and in particular in the + -- case of a subtype declaration, it is appropriate to set the parent + -- pointer of R so that the types get properly frozen. Check_List is used + -- when the subprogram is called from Build_Record_Init_Proc and is used to + -- return a set of constraint checking statements generated by the Checks + -- package. R_Check_Off is set to True when the call to Range_Check is to + -- be skipped. function Process_Subtype (S : Node_Id; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index c72b3137ef8..32323400b6d 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -4496,25 +4496,26 @@ package body Sem_Ch6 is elsif Nkind (Subp) = N_Defining_Operator_Symbol then declare - Typ : constant Entity_Id := - Base_Type (Etype (First_Formal (Subp))); + Typ : constant Entity_Id := + Base_Type (Etype (First_Formal (Subp))); + Can_Override : constant Boolean := - Operator_Matches_Spec (Subp, Subp) - and then Scope (Subp) = Scope (Typ) - and then not Is_Class_Wide_Type (Typ); + Operator_Matches_Spec (Subp, Subp) + and then Scope (Subp) = Scope (Typ) + and then not Is_Class_Wide_Type (Typ); begin if Must_Not_Override (Spec) then - -- If this is not a primitive or a protected subprogram, - -- then "not overriding" is illegal. + -- If this is not a primitive or a protected subprogram, then + -- "not overriding" is illegal. if not Is_Primitive and then Ekind (Scope (Subp)) /= E_Protected_Type then Error_Msg_N ("overriding indicator only allowed " - & "if subprogram is primitive", Subp); + & "if subprogram is primitive", Subp); elsif Can_Override then Error_Msg_NE @@ -4535,7 +4536,7 @@ package body Sem_Ch6 is and then Can_Override and then not Is_Predefined_File_Name - (Unit_File_Name (Get_Source_Unit (Subp))) + (Unit_File_Name (Get_Source_Unit (Subp))) then Set_Is_Overriding_Operation (Subp); diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 4edcfe76bcb..27505f215a9 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -1912,7 +1912,7 @@ package body Sem_Ch7 is Set_Is_Limited_Record (Id, Limited_Present (Def)); Set_Has_Delayed_Freeze (Id, True); - -- Create a class-wide type with the same attributes. + -- Create a class-wide type with the same attributes Make_Class_Wide_Type (Id);