diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
| -rwxr-xr-x | gcc/ada/aspects.ads | 1 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 24 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 36 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/sem_cat.adb | 109 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 1 |
8 files changed, 97 insertions, 99 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f0b84ca..829ae3b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2012-01-30 Robert Dewar <dewar@adacore.com> + * einfo.ads, sem_prag.adb, sem_attr.adb, aspects.ads, + sem_cat.adb, sem_aggr.adb, exp_aggr.adb: Minor reformatting. + +2012-01-30 Robert Dewar <dewar@adacore.com> + * a-cdlili.adb, a-cidlli.adb, a-cbdlli.adb: Minor reformatting. 2012-01-30 Olivier Hainque <hainque@adacore.com> diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 74eee35..187b645 100755 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -301,7 +301,6 @@ package Aspects is ----------------------------------------- -- Table linking aspect names and id's - -- Shouldn't this be automatically generated in Snames??? Aspect_Names : constant array (Aspect_Id) of Name_Id := ( No_Aspect => No_Name, diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 6151fc0..d89b15f 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2272,7 +2272,7 @@ package Einfo is -- Is_Generic_Type (Flag13) -- Present in all entities. Set for types which are generic formal types. -- Such types have an Ekind that corresponds to their classification, so --- the Ekind cannot be used to identify generic types. +-- the Ekind cannot be used to identify generic formal types. -- Is_Generic_Unit (synthesized) -- Applies to all entities. Yields True for a generic unit (generic @@ -2721,8 +2721,8 @@ package Einfo is -- Present in all entities. Set in E_Package and E_Generic_Package -- entities to which a pragma Remote_Types is applied, and also on -- entities declared in the visible part of the spec of such a package. --- Also set for generic formal types to which pragma Remote_Access_Type --- applies. +-- Also set for types which are generic formal types to which the +-- pragma Remote_Access_Type applies. -- Is_Renaming_Of_Object (Flag112) -- Present in all entities, set only for a variable or constant for diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 783772f..849a7e9 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -244,8 +244,8 @@ package body Exp_Aggr is Target : Node_Id) return List_Id; -- This routine implements top-down expansion of nested aggregates. In -- doing so, it avoids the generation of temporaries at each level. N is a - -- nested (record or array) aggregate that has been marked with 'Delay_ - -- Expansion'. Typ is the expected type of the aggregate. Target is a + -- nested (record or array) aggregate that has been marked with Expansion_ + -- Delayed. Typ is the expected type of the aggregate. Target is a -- (duplicable) expression that will hold the result of the aggregate -- expansion. @@ -5297,7 +5297,7 @@ package body Exp_Aggr is -- Ada 2005 (AI-318-2): We need to convert to assignments if components -- are build-in-place function calls. The assignments will each turn - -- into a build-in-place function call. If components are all static, + -- into a build-in-place function call. If components are all static, -- we can pass the aggregate to the backend regardless of limitedness. -- Extension aggregates, aggregates in extended return statements, and @@ -5547,16 +5547,16 @@ package body Exp_Aggr is if Is_Tagged_Type (Typ) then - -- The tagged case, _parent and _tag component must be created + -- In the tagged case, _parent and _tag component must be created - -- Reset null_present unconditionally. tagged records always have - -- at least one field (the tag or the parent) + -- Reset Null_Present unconditionally. Tagged records always have + -- at least one field (the tag or the parent). Set_Null_Record_Present (N, False); -- When the current aggregate comes from the expansion of an -- extension aggregate, the parent expr is replaced by an - -- aggregate formed by selected components of this expr + -- aggregate formed by selected components of this expr. if Present (Parent_Expr) and then Is_Empty_List (Comps) @@ -5596,12 +5596,14 @@ package body Exp_Aggr is -- Compute the value for the Tag now, if the type is a root it -- will be included in the aggregate right away, otherwise it will - -- be propagated to the parent aggregate + -- be propagated to the parent aggregate. if Present (Orig_Tag) then Tag_Value := Orig_Tag; + elsif not Tagged_Type_Expansion then Tag_Value := Empty; + else Tag_Value := New_Occurrence_Of @@ -5657,8 +5659,8 @@ package body Exp_Aggr is -- Expand recursively the parent propagating the right Tag - Expand_Record_Aggregate ( - Parent_Aggr, Tag_Value, Parent_Expr); + Expand_Record_Aggregate + (Parent_Aggr, Tag_Value, Parent_Expr); end; -- For a root type, the tag component is added (unless compiling diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index e70333c..920a42a 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -3185,14 +3185,18 @@ package body Sem_Aggr is -- dynamic-sized aggregate in the code, something that gigi cannot -- handle. - Relocate : Boolean; - -- Set to True if the resolved Expr node needs to be relocated - -- when attached to the newly created association list. This node - -- need not be relocated if its parent pointer is not set. - -- In fact in this case Expr is the output of a New_Copy_Tree call. - -- if Relocate is True then we have analyzed the expression node - -- in the original aggregate and hence it needs to be relocated - -- when moved over the new association list. + Relocate : Boolean; + -- Set to True if the resolved Expr node needs to be relocated when + -- attached to the newly created association list. This node need not + -- be relocated if its parent pointer is not set. In fact in this + -- case Expr is the output of a New_Copy_Tree call. If Relocate is + -- True then we have analyzed the expression node in the original + -- aggregate and hence it needs to be relocated when moved over to + -- the new association list. + + --------------------------- + -- Has_Expansion_Delayed -- + --------------------------- function Has_Expansion_Delayed (Expr : Node_Id) return Boolean is Kind : constant Node_Kind := Nkind (Expr); @@ -3205,7 +3209,7 @@ package body Sem_Aggr is and then Has_Expansion_Delayed (Expression (Expr))); end Has_Expansion_Delayed; - -- Start of processing for Resolve_Aggr_Expr + -- Start of processing for Resolve_Aggr_Expr begin -- If the type of the component is elementary or the type of the @@ -3315,8 +3319,8 @@ package body Sem_Aggr is Set_Raises_Constraint_Error (N); end if; - -- If the expression has been marked as requiring a range check, - -- then generate it here. + -- If the expression has been marked as requiring a range check, then + -- generate it here. if Do_Range_Check (Expr) then Set_Do_Range_Check (Expr, False); @@ -3396,10 +3400,10 @@ package body Sem_Aggr is -- If the type has no components, then the aggregate should either -- have "null record", or in Ada 2005 it could instead have a single - -- component association given by "others => <>". For Ada 95 we flag - -- an error at this point, but for Ada 2005 we proceed with checking - -- the associations below, which will catch the case where it's not - -- an aggregate with "others => <>". Note that the legality of a <> + -- component association given by "others => <>". For Ada 95 we flag an + -- error at this point, but for Ada 2005 we proceed with checking the + -- associations below, which will catch the case where it's not an + -- aggregate with "others => <>". Note that the legality of a <> -- aggregate for a null record type was established by AI05-016. elsif No (First_Entity (Typ)) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index d40f133..a832612 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -4638,19 +4638,19 @@ package body Sem_Attr is if Is_Remote_Access_To_Class_Wide_Type (Base_Type (P_Type)) then - if not Is_Generic_Type (P_Type) then - -- For a real RACW [sub]type, use corresponding stub type + -- For a real RACW [sub]type, use corresponding stub type + if not Is_Generic_Type (P_Type) then Rewrite (N, New_Occurrence_Of (Corresponding_Stub_Type (Base_Type (P_Type)), Loc)); - else - -- For a generic type (that has been marked as an RACW using - -- the Remote_Access_Type aspect or pragma), use a generic RACW - -- stub type. Note that if the actual is not a remote access - -- type, the instantiation will fail. + -- For a generic type (that has been marked as an RACW using the + -- Remote_Access_Type aspect or pragma), use a generic RACW stub + -- type. Note that if the actual is not a remote access type, the + -- instantiation will fail. + else -- Note: we go to the underlying type here because the view -- returned by RTE (RE_RACW_Stub_Type) might be incomplete. diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index d73314d..be594cb 100644 --- a/gcc/ada/sem_cat.adb +++ b/gcc/ada/sem_cat.adb @@ -161,7 +161,7 @@ package body Sem_Cat is if Is_Pure (E) and then not - (Has_Pragma_Pure_Function (E) and not Has_Pragma_Pure (E)) + (Has_Pragma_Pure_Function (E) and not Has_Pragma_Pure (E)) then return Pure; @@ -214,7 +214,7 @@ package body Sem_Cat is -- to WITH anything in the package body, per (RM E.2(5)). if (Unit_Category = Remote_Types - or else Unit_Category = Remote_Call_Interface) + or else Unit_Category = Remote_Call_Interface) and then In_Package_Body (Unit_Entity) then null; @@ -409,10 +409,10 @@ package body Sem_Cat is function Has_Read_Write_Attributes (E : Entity_Id) return Boolean is begin return True - and then Has_Stream_Attribute_Definition (E, - TSS_Stream_Read, At_Any_Place => True) - and then Has_Stream_Attribute_Definition (E, - TSS_Stream_Write, At_Any_Place => True); + and then Has_Stream_Attribute_Definition + (E, TSS_Stream_Read, At_Any_Place => True) + and then Has_Stream_Attribute_Definition + (E, TSS_Stream_Write, At_Any_Place => True); end Has_Read_Write_Attributes; ------------------------------------- @@ -500,7 +500,7 @@ package body Sem_Cat is or else Is_Shared_Passive (Unit_Entity) or else ((Is_Remote_Types (Unit_Entity) - or else Is_Remote_Call_Interface (Unit_Entity)) + or else Is_Remote_Call_Interface (Unit_Entity)) and then Ekind (Unit_Entity) = E_Package and then Unit_Kind /= N_Package_Body and then not In_Package_Body (Unit_Entity) @@ -533,8 +533,8 @@ package body Sem_Cat is and then Is_Package_Or_Generic_Package (Unit_Entity) and then Unit_Kind /= N_Package_Body and then List_Containing (N) = - Visible_Declarations - (Specification (Unit_Declaration_Node (Unit_Entity))) + Visible_Declarations + (Specification (Unit_Declaration_Node (Unit_Entity))) and then not In_Package_Body (Unit_Entity) and then not In_Instance; @@ -695,9 +695,7 @@ package body Sem_Cat is PN : Node_Id; begin - if Is_Child_Unit (S) - and then Is_Generic_Instance (S) - then + if Is_Child_Unit (S) and then Is_Generic_Instance (S) then Set_Parents (True); end if; @@ -722,9 +720,7 @@ package body Sem_Cat is Next (PN); end loop; - if Is_Child_Unit (S) - and then Is_Generic_Instance (S) - then + if Is_Child_Unit (S) and then Is_Generic_Instance (S) then Set_Parents (False); end if; end; @@ -739,24 +735,23 @@ package body Sem_Cat is Specification : Node_Id := Empty; begin - Set_Is_Pure (E, - Is_Pure (Scop) and then Is_Library_Level_Entity (E)); + Set_Is_Pure + (E, Is_Pure (Scop) and then Is_Library_Level_Entity (E)); if not Is_Remote_Call_Interface (E) then if Ekind (E) in Subprogram_Kind then Declaration := Unit_Declaration_Node (E); - if Nkind (Declaration) = N_Subprogram_Body - or else - Nkind (Declaration) = N_Subprogram_Renaming_Declaration + if Nkind_In (Declaration, N_Subprogram_Body, + N_Subprogram_Renaming_Declaration) then Specification := Corresponding_Spec (Declaration); end if; end if; - -- A subprogram body or renaming-as-body is a remote call - -- interface if it serves as the completion of a subprogram - -- declaration that is a remote call interface. + -- A subprogram body or renaming-as-body is a remote call interface + -- if it serves as the completion of a subprogram declaration that + -- is a remote call interface. if Nkind (Specification) in N_Entity then Set_Is_Remote_Call_Interface @@ -770,14 +765,14 @@ package body Sem_Cat is Set_Is_Remote_Call_Interface (E, Is_Remote_Call_Interface (Scop) and then not (In_Private_Part (Scop) - or else In_Package_Body (Scop))); + or else In_Package_Body (Scop))); end if; end if; Set_Is_Remote_Types (E, Is_Remote_Types (Scop) and then not (In_Private_Part (Scop) - or else In_Package_Body (Scop))); + or else In_Package_Body (Scop))); end Set_Categorization_From_Scope; ------------------------------ @@ -875,7 +870,7 @@ package body Sem_Cat is if Comes_From_Source (T) and then not (In_Package_Body (Scope (T)) - or else In_Private_Part (Scope (T))) + or else In_Private_Part (Scope (T))) then Set_Is_Remote_Call_Interface (T, Is_Remote_Call_Interface (Scope (T))); @@ -956,8 +951,7 @@ package body Sem_Cat is -- Body of RCI unit does not need validation if Is_Remote_Call_Interface (E) - and then (Nkind (N) = N_Package_Body - or else Nkind (N) = N_Subprogram_Body) + and then Nkind_In (N, N_Package_Body, N_Subprogram_Body) then return; end if; @@ -973,16 +967,16 @@ package body Sem_Cat is while Present (Item) loop if Nkind (Item) = N_With_Clause and then not (Implicit_With (Item) - or else Limited_Present (Item) + or else Limited_Present (Item) - -- Skip if error already posted on the WITH - -- clause (in which case the Name attribute - -- may be invalid). In particular, this fixes - -- the problem of hanging in the presence of a - -- WITH clause on a child that is an illegal - -- generic instantiation. + -- Skip if error already posted on the WITH + -- clause (in which case the Name attribute + -- may be invalid). In particular, this fixes + -- the problem of hanging in the presence of a + -- WITH clause on a child that is an illegal + -- generic instantiation. - or else Error_Posted (Item)) + or else Error_Posted (Item)) then Entity_Of_Withed := Entity (Name (Item)); Check_Categorization_Dependencies @@ -1298,9 +1292,7 @@ package body Sem_Cat is PEE : Node_Id; begin - if Has_Discriminants (ET) - and then Present (EE) - then + if Has_Discriminants (ET) and then Present (EE) then PEE := Parent (EE); if Nkind (PEE) = N_Full_Type_Declaration @@ -1425,7 +1417,7 @@ package body Sem_Cat is -- Check that the return type supports external streaming elsif No_External_Streaming (Rtyp) - and then not Error_Posted (Rtyp) + and then not Error_Posted (Rtyp) then Illegal_Remote_Subp ("return type containing non-remote access " & "must have Read and Write attributes", @@ -1671,7 +1663,7 @@ package body Sem_Cat is if not Comes_From_Source (T) or else (not In_RCI_Declaration (Parent (T)) - and then not In_RT_Declaration) + and then not In_RT_Declaration) then return; end if; @@ -1791,9 +1783,7 @@ package body Sem_Cat is -- If we have a true dereference that comes from source and that -- is a controlling argument for a dispatching call, accept it. - if Is_Actual_Parameter (N) - and then Is_Controlling_Actual (N) - then + if Is_Actual_Parameter (N) and then Is_Controlling_Actual (N) then return; end if; @@ -1803,8 +1793,7 @@ package body Sem_Cat is -- apply in the case of dereference that is the prefix of a selected -- component, which can be a call given in prefixed form. - if (Is_Actual_Parameter (N) - or else PK = N_Selected_Component) + if (Is_Actual_Parameter (N) or else PK = N_Selected_Component) and then not Analyzed (N) then return; @@ -1922,9 +1911,8 @@ package body Sem_Cat is -- partition (E.2.2(8)). if (Ada_Version < Ada_2005 and then Has_Non_Remote_Access (U_Typ)) - or else - (Stream_Attributes_Available (Typ) - and then No_External_Streaming (U_Typ)) + or else (Stream_Attributes_Available (Typ) + and then No_External_Streaming (U_Typ)) then if Is_Non_Remote_Access_Type (Typ) then Error_Msg_N ("error in non-remote access type", U_Typ); @@ -1958,8 +1946,8 @@ package body Sem_Cat is Direct_Designated_Type : Entity_Id; function Has_Entry_Declarations (E : Entity_Id) return Boolean; - -- Return true if the protected type designated by T has - -- entry declarations. + -- Return true if the protected type designated by T has entry + -- declarations. ---------------------------- -- Has_Entry_Declarations -- @@ -2134,16 +2122,15 @@ package body Sem_Cat is and then Enclosing_Lib_Unit_Node (N) /= Enclosing_Lib_Unit_Node (E) and then (Is_Preelaborated (Scope (E)) - or else Is_Pure (Scope (E)) - or else (Present (Renamed_Object (E)) - and then - Is_Entity_Name (Renamed_Object (E)) - and then - (Is_Preelaborated - (Scope (Renamed_Object (E))) - or else - Is_Pure (Scope - (Renamed_Object (E)))))) + or else Is_Pure (Scope (E)) + or else (Present (Renamed_Object (E)) + and then Is_Entity_Name (Renamed_Object (E)) + and then + (Is_Preelaborated + (Scope (Renamed_Object (E))) + or else + Is_Pure (Scope + (Renamed_Object (E)))))) then null; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index b4df53f..c0e0e58 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -12904,6 +12904,7 @@ package body Sem_Prag is Check_Arg_Count (1); Check_Optional_Identifier (Arg1, Name_Entity); Check_Arg_Is_Local_Name (Arg1); + E := Entity (Get_Pragma_Arg (Arg1)); if Nkind (Parent (E)) = N_Formal_Type_Declaration |