Commit 22243c12 by Robert Dewar Committed by Arnaud Charlet

einfo.ads, [...]: Minor reformatting.

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.

From-SVN: r183699
parent 25081892
2012-01-30 Robert Dewar <dewar@adacore.com> 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. * a-cdlili.adb, a-cidlli.adb, a-cbdlli.adb: Minor reformatting.
2012-01-30 Olivier Hainque <hainque@adacore.com> 2012-01-30 Olivier Hainque <hainque@adacore.com>
......
...@@ -301,7 +301,6 @@ package Aspects is ...@@ -301,7 +301,6 @@ package Aspects is
----------------------------------------- -----------------------------------------
-- Table linking aspect names and id's -- Table linking aspect names and id's
-- Shouldn't this be automatically generated in Snames???
Aspect_Names : constant array (Aspect_Id) of Name_Id := ( Aspect_Names : constant array (Aspect_Id) of Name_Id := (
No_Aspect => No_Name, No_Aspect => No_Name,
......
...@@ -2272,7 +2272,7 @@ package Einfo is ...@@ -2272,7 +2272,7 @@ package Einfo is
-- Is_Generic_Type (Flag13) -- Is_Generic_Type (Flag13)
-- Present in all entities. Set for types which are generic formal types. -- Present in all entities. Set for types which are generic formal types.
-- Such types have an Ekind that corresponds to their classification, so -- 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) -- Is_Generic_Unit (synthesized)
-- Applies to all entities. Yields True for a generic unit (generic -- Applies to all entities. Yields True for a generic unit (generic
...@@ -2721,8 +2721,8 @@ package Einfo is ...@@ -2721,8 +2721,8 @@ package Einfo is
-- Present in all entities. Set in E_Package and E_Generic_Package -- 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 to which a pragma Remote_Types is applied, and also on
-- entities declared in the visible part of the spec of such a package. -- 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 -- Also set for types which are generic formal types to which the
-- applies. -- pragma Remote_Access_Type applies.
-- Is_Renaming_Of_Object (Flag112) -- Is_Renaming_Of_Object (Flag112)
-- Present in all entities, set only for a variable or constant for -- Present in all entities, set only for a variable or constant for
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -244,8 +244,8 @@ package body Exp_Aggr is ...@@ -244,8 +244,8 @@ package body Exp_Aggr is
Target : Node_Id) return List_Id; Target : Node_Id) return List_Id;
-- This routine implements top-down expansion of nested aggregates. In -- This routine implements top-down expansion of nested aggregates. In
-- doing so, it avoids the generation of temporaries at each level. N is a -- 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_ -- nested (record or array) aggregate that has been marked with Expansion_
-- Expansion'. Typ is the expected type of the aggregate. Target is a -- Delayed. Typ is the expected type of the aggregate. Target is a
-- (duplicable) expression that will hold the result of the aggregate -- (duplicable) expression that will hold the result of the aggregate
-- expansion. -- expansion.
...@@ -5547,16 +5547,16 @@ package body Exp_Aggr is ...@@ -5547,16 +5547,16 @@ package body Exp_Aggr is
if Is_Tagged_Type (Typ) then 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 -- Reset Null_Present unconditionally. Tagged records always have
-- at least one field (the tag or the parent) -- at least one field (the tag or the parent).
Set_Null_Record_Present (N, False); Set_Null_Record_Present (N, False);
-- When the current aggregate comes from the expansion of an -- When the current aggregate comes from the expansion of an
-- extension aggregate, the parent expr is replaced by 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) if Present (Parent_Expr)
and then Is_Empty_List (Comps) and then Is_Empty_List (Comps)
...@@ -5596,12 +5596,14 @@ package body Exp_Aggr is ...@@ -5596,12 +5596,14 @@ package body Exp_Aggr is
-- Compute the value for the Tag now, if the type is a root it -- 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 -- 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 if Present (Orig_Tag) then
Tag_Value := Orig_Tag; Tag_Value := Orig_Tag;
elsif not Tagged_Type_Expansion then elsif not Tagged_Type_Expansion then
Tag_Value := Empty; Tag_Value := Empty;
else else
Tag_Value := Tag_Value :=
New_Occurrence_Of New_Occurrence_Of
...@@ -5657,8 +5659,8 @@ package body Exp_Aggr is ...@@ -5657,8 +5659,8 @@ package body Exp_Aggr is
-- Expand recursively the parent propagating the right Tag -- Expand recursively the parent propagating the right Tag
Expand_Record_Aggregate ( Expand_Record_Aggregate
Parent_Aggr, Tag_Value, Parent_Expr); (Parent_Aggr, Tag_Value, Parent_Expr);
end; end;
-- For a root type, the tag component is added (unless compiling -- For a root type, the tag component is added (unless compiling
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -3186,13 +3186,17 @@ package body Sem_Aggr is ...@@ -3186,13 +3186,17 @@ package body Sem_Aggr is
-- handle. -- handle.
Relocate : Boolean; Relocate : Boolean;
-- Set to True if the resolved Expr node needs to be relocated -- Set to True if the resolved Expr node needs to be relocated when
-- when attached to the newly created association list. This node -- attached to the newly created association list. This node need not
-- need not be relocated if its parent pointer is not set. -- be relocated if its parent pointer is not set. In fact in this
-- In fact in this case Expr is the output of a New_Copy_Tree call. -- case Expr is the output of a New_Copy_Tree call. If Relocate is
-- if Relocate is True then we have analyzed the expression node -- True then we have analyzed the expression node in the original
-- in the original aggregate and hence it needs to be relocated -- aggregate and hence it needs to be relocated when moved over to
-- when moved over the new association list. -- the new association list.
---------------------------
-- Has_Expansion_Delayed --
---------------------------
function Has_Expansion_Delayed (Expr : Node_Id) return Boolean is function Has_Expansion_Delayed (Expr : Node_Id) return Boolean is
Kind : constant Node_Kind := Nkind (Expr); Kind : constant Node_Kind := Nkind (Expr);
...@@ -3315,8 +3319,8 @@ package body Sem_Aggr is ...@@ -3315,8 +3319,8 @@ package body Sem_Aggr is
Set_Raises_Constraint_Error (N); Set_Raises_Constraint_Error (N);
end if; end if;
-- If the expression has been marked as requiring a range check, -- If the expression has been marked as requiring a range check, then
-- then generate it here. -- generate it here.
if Do_Range_Check (Expr) then if Do_Range_Check (Expr) then
Set_Do_Range_Check (Expr, False); Set_Do_Range_Check (Expr, False);
...@@ -3396,10 +3400,10 @@ package body Sem_Aggr is ...@@ -3396,10 +3400,10 @@ package body Sem_Aggr is
-- If the type has no components, then the aggregate should either -- If the type has no components, then the aggregate should either
-- have "null record", or in Ada 2005 it could instead have a single -- have "null record", or in Ada 2005 it could instead have a single
-- component association given by "others => <>". For Ada 95 we flag -- component association given by "others => <>". For Ada 95 we flag an
-- an error at this point, but for Ada 2005 we proceed with checking -- error at this point, but for Ada 2005 we proceed with checking the
-- the associations below, which will catch the case where it's not -- associations below, which will catch the case where it's not an
-- an aggregate with "others => <>". Note that the legality of a <> -- aggregate with "others => <>". Note that the legality of a <>
-- aggregate for a null record type was established by AI05-016. -- aggregate for a null record type was established by AI05-016.
elsif No (First_Entity (Typ)) elsif No (First_Entity (Typ))
......
...@@ -4638,19 +4638,19 @@ package body Sem_Attr is ...@@ -4638,19 +4638,19 @@ package body Sem_Attr is
if Is_Remote_Access_To_Class_Wide_Type (Base_Type (P_Type)) then 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, Rewrite (N,
New_Occurrence_Of New_Occurrence_Of
(Corresponding_Stub_Type (Base_Type (P_Type)), Loc)); (Corresponding_Stub_Type (Base_Type (P_Type)), Loc));
else -- For a generic type (that has been marked as an RACW using the
-- For a generic type (that has been marked as an RACW using -- Remote_Access_Type aspect or pragma), use a generic RACW stub
-- the Remote_Access_Type aspect or pragma), use a generic RACW -- type. Note that if the actual is not a remote access type, the
-- stub type. Note that if the actual is not a remote access -- instantiation will fail.
-- type, the instantiation will fail.
else
-- Note: we go to the underlying type here because the view -- Note: we go to the underlying type here because the view
-- returned by RTE (RE_RACW_Stub_Type) might be incomplete. -- returned by RTE (RE_RACW_Stub_Type) might be incomplete.
......
...@@ -409,10 +409,10 @@ package body Sem_Cat is ...@@ -409,10 +409,10 @@ package body Sem_Cat is
function Has_Read_Write_Attributes (E : Entity_Id) return Boolean is function Has_Read_Write_Attributes (E : Entity_Id) return Boolean is
begin begin
return True return True
and then Has_Stream_Attribute_Definition (E, and then Has_Stream_Attribute_Definition
TSS_Stream_Read, At_Any_Place => True) (E, TSS_Stream_Read, At_Any_Place => True)
and then Has_Stream_Attribute_Definition (E, and then Has_Stream_Attribute_Definition
TSS_Stream_Write, At_Any_Place => True); (E, TSS_Stream_Write, At_Any_Place => True);
end Has_Read_Write_Attributes; end Has_Read_Write_Attributes;
------------------------------------- -------------------------------------
...@@ -695,9 +695,7 @@ package body Sem_Cat is ...@@ -695,9 +695,7 @@ package body Sem_Cat is
PN : Node_Id; PN : Node_Id;
begin begin
if Is_Child_Unit (S) if Is_Child_Unit (S) and then Is_Generic_Instance (S) then
and then Is_Generic_Instance (S)
then
Set_Parents (True); Set_Parents (True);
end if; end if;
...@@ -722,9 +720,7 @@ package body Sem_Cat is ...@@ -722,9 +720,7 @@ package body Sem_Cat is
Next (PN); Next (PN);
end loop; end loop;
if Is_Child_Unit (S) if Is_Child_Unit (S) and then Is_Generic_Instance (S) then
and then Is_Generic_Instance (S)
then
Set_Parents (False); Set_Parents (False);
end if; end if;
end; end;
...@@ -739,24 +735,23 @@ package body Sem_Cat is ...@@ -739,24 +735,23 @@ package body Sem_Cat is
Specification : Node_Id := Empty; Specification : Node_Id := Empty;
begin begin
Set_Is_Pure (E, Set_Is_Pure
Is_Pure (Scop) and then Is_Library_Level_Entity (E)); (E, Is_Pure (Scop) and then Is_Library_Level_Entity (E));
if not Is_Remote_Call_Interface (E) then if not Is_Remote_Call_Interface (E) then
if Ekind (E) in Subprogram_Kind then if Ekind (E) in Subprogram_Kind then
Declaration := Unit_Declaration_Node (E); Declaration := Unit_Declaration_Node (E);
if Nkind (Declaration) = N_Subprogram_Body if Nkind_In (Declaration, N_Subprogram_Body,
or else N_Subprogram_Renaming_Declaration)
Nkind (Declaration) = N_Subprogram_Renaming_Declaration
then then
Specification := Corresponding_Spec (Declaration); Specification := Corresponding_Spec (Declaration);
end if; end if;
end if; end if;
-- A subprogram body or renaming-as-body is a remote call -- A subprogram body or renaming-as-body is a remote call interface
-- interface if it serves as the completion of a subprogram -- if it serves as the completion of a subprogram declaration that
-- declaration that is a remote call interface. -- is a remote call interface.
if Nkind (Specification) in N_Entity then if Nkind (Specification) in N_Entity then
Set_Is_Remote_Call_Interface Set_Is_Remote_Call_Interface
...@@ -956,8 +951,7 @@ package body Sem_Cat is ...@@ -956,8 +951,7 @@ package body Sem_Cat is
-- Body of RCI unit does not need validation -- Body of RCI unit does not need validation
if Is_Remote_Call_Interface (E) if Is_Remote_Call_Interface (E)
and then (Nkind (N) = N_Package_Body and then Nkind_In (N, N_Package_Body, N_Subprogram_Body)
or else Nkind (N) = N_Subprogram_Body)
then then
return; return;
end if; end if;
...@@ -1298,9 +1292,7 @@ package body Sem_Cat is ...@@ -1298,9 +1292,7 @@ package body Sem_Cat is
PEE : Node_Id; PEE : Node_Id;
begin begin
if Has_Discriminants (ET) if Has_Discriminants (ET) and then Present (EE) then
and then Present (EE)
then
PEE := Parent (EE); PEE := Parent (EE);
if Nkind (PEE) = N_Full_Type_Declaration if Nkind (PEE) = N_Full_Type_Declaration
...@@ -1791,9 +1783,7 @@ package body Sem_Cat is ...@@ -1791,9 +1783,7 @@ package body Sem_Cat is
-- If we have a true dereference that comes from source and that -- If we have a true dereference that comes from source and that
-- is a controlling argument for a dispatching call, accept it. -- is a controlling argument for a dispatching call, accept it.
if Is_Actual_Parameter (N) if Is_Actual_Parameter (N) and then Is_Controlling_Actual (N) then
and then Is_Controlling_Actual (N)
then
return; return;
end if; end if;
...@@ -1803,8 +1793,7 @@ package body Sem_Cat is ...@@ -1803,8 +1793,7 @@ package body Sem_Cat is
-- apply in the case of dereference that is the prefix of a selected -- apply in the case of dereference that is the prefix of a selected
-- component, which can be a call given in prefixed form. -- component, which can be a call given in prefixed form.
if (Is_Actual_Parameter (N) if (Is_Actual_Parameter (N) or else PK = N_Selected_Component)
or else PK = N_Selected_Component)
and then not Analyzed (N) and then not Analyzed (N)
then then
return; return;
...@@ -1922,8 +1911,7 @@ package body Sem_Cat is ...@@ -1922,8 +1911,7 @@ package body Sem_Cat is
-- partition (E.2.2(8)). -- partition (E.2.2(8)).
if (Ada_Version < Ada_2005 and then Has_Non_Remote_Access (U_Typ)) if (Ada_Version < Ada_2005 and then Has_Non_Remote_Access (U_Typ))
or else or else (Stream_Attributes_Available (Typ)
(Stream_Attributes_Available (Typ)
and then No_External_Streaming (U_Typ)) and then No_External_Streaming (U_Typ))
then then
if Is_Non_Remote_Access_Type (Typ) then if Is_Non_Remote_Access_Type (Typ) then
...@@ -1958,8 +1946,8 @@ package body Sem_Cat is ...@@ -1958,8 +1946,8 @@ package body Sem_Cat is
Direct_Designated_Type : Entity_Id; Direct_Designated_Type : Entity_Id;
function Has_Entry_Declarations (E : Entity_Id) return Boolean; function Has_Entry_Declarations (E : Entity_Id) return Boolean;
-- Return true if the protected type designated by T has -- Return true if the protected type designated by T has entry
-- entry declarations. -- declarations.
---------------------------- ----------------------------
-- Has_Entry_Declarations -- -- Has_Entry_Declarations --
...@@ -2136,8 +2124,7 @@ package body Sem_Cat is ...@@ -2136,8 +2124,7 @@ package body Sem_Cat is
and then (Is_Preelaborated (Scope (E)) and then (Is_Preelaborated (Scope (E))
or else Is_Pure (Scope (E)) or else Is_Pure (Scope (E))
or else (Present (Renamed_Object (E)) or else (Present (Renamed_Object (E))
and then and then Is_Entity_Name (Renamed_Object (E))
Is_Entity_Name (Renamed_Object (E))
and then and then
(Is_Preelaborated (Is_Preelaborated
(Scope (Renamed_Object (E))) (Scope (Renamed_Object (E)))
......
...@@ -12904,6 +12904,7 @@ package body Sem_Prag is ...@@ -12904,6 +12904,7 @@ package body Sem_Prag is
Check_Arg_Count (1); Check_Arg_Count (1);
Check_Optional_Identifier (Arg1, Name_Entity); Check_Optional_Identifier (Arg1, Name_Entity);
Check_Arg_Is_Local_Name (Arg1); Check_Arg_Is_Local_Name (Arg1);
E := Entity (Get_Pragma_Arg (Arg1)); E := Entity (Get_Pragma_Arg (Arg1));
if Nkind (Parent (E)) = N_Formal_Type_Declaration if Nkind (Parent (E)) = N_Formal_Type_Declaration
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment