Commit d1ec4768 by Robert Dewar Committed by Arnaud Charlet

sem_ch12.adb, [...]: Minor reformatting.

2013-04-25  Robert Dewar  <dewar@adacore.com>

	* sem_ch12.adb, sem_util.adb, sem_ch4.adb: Minor reformatting.

From-SVN: r198289
parent 57081559
2013-04-25 Robert Dewar <dewar@adacore.com>
* sem_ch12.adb, sem_util.adb, sem_ch4.adb: Minor reformatting.
2013-04-25 Hristian Kirtchev <kirtchev@adacore.com> 2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch4.adb (Analyze_Quantified_Expression): * sem_ch4.adb (Analyze_Quantified_Expression):
......
...@@ -5467,13 +5467,13 @@ package body Sem_Ch12 is ...@@ -5467,13 +5467,13 @@ package body Sem_Ch12 is
-- For a formal that is an array type, the component type is often a -- For a formal that is an array type, the component type is often a
-- previous formal in the same unit. The privacy status of the component -- previous formal in the same unit. The privacy status of the component
-- type will have been examined earlier in the traversal of the -- type will have been examined earlier in the traversal of the
-- corresponding actuals, and this status should not be modified for the -- corresponding actuals, and this status should not be modified for
-- array (sub)type itself. However, if the base type of the array -- the array (sub)type itself. However, if the base type of the array
-- (sub)type is private, its full view must be restored in the body to -- (sub)type is private, its full view must be restored in the body to
-- be consistent with subsequent index subtypes, etc. -- be consistent with subsequent index subtypes, etc.
-- --
-- To detect this case we have to rescan the list of formals, which -- To detect this case we have to rescan the list of formals, which is
-- is usually short enough to ignore the resulting inefficiency. -- usually short enough to ignore the resulting inefficiency.
----------------------------- -----------------------------
-- Denotes_Previous_Actual -- -- Denotes_Previous_Actual --
...@@ -5552,8 +5552,8 @@ package body Sem_Ch12 is ...@@ -5552,8 +5552,8 @@ package body Sem_Ch12 is
if Is_Discrete_Or_Fixed_Point_Type (E) then if Is_Discrete_Or_Fixed_Point_Type (E) then
Set_RM_Size (E, RM_Size (Astype)); Set_RM_Size (E, RM_Size (Astype));
-- In nested instances, the base type of an access actual -- In nested instances, the base type of an access actual may
-- may itself be private, and need to be exchanged. -- itself be private, and need to be exchanged.
elsif Is_Access_Type (E) elsif Is_Access_Type (E)
and then Is_Private_Type (Etype (E)) and then Is_Private_Type (Etype (E))
...@@ -5655,9 +5655,9 @@ package body Sem_Ch12 is ...@@ -5655,9 +5655,9 @@ package body Sem_Ch12 is
then then
Switch_View (Typ); Switch_View (Typ);
-- If the type of the entity is a subtype, it may also -- If the type of the entity is a subtype, it may also have
-- have to be made visible, together with the base type -- to be made visible, together with the base type of its
-- of its full view, after exchange. -- full view, after exchange.
if Is_Private_Type (Etype (E)) then if Is_Private_Type (Etype (E)) then
Switch_View (Etype (E)); Switch_View (Etype (E));
...@@ -5691,8 +5691,8 @@ package body Sem_Ch12 is ...@@ -5691,8 +5691,8 @@ package body Sem_Ch12 is
-- Search generic parent for possible child unit with the given name -- Search generic parent for possible child unit with the given name
function In_Enclosing_Instance return Boolean; function In_Enclosing_Instance return Boolean;
-- Within an instance of the parent, the child unit may be denoted -- Within an instance of the parent, the child unit may be denoted by
-- by a simple name, or an abbreviated expanded name. Examine enclosing -- a simple name, or an abbreviated expanded name. Examine enclosing
-- scopes to locate a possible parent instantiation. -- scopes to locate a possible parent instantiation.
------------------------ ------------------------
...@@ -5909,10 +5909,10 @@ package body Sem_Ch12 is ...@@ -5909,10 +5909,10 @@ package body Sem_Ch12 is
elsif In_Open_Scopes (Inst_Par) then elsif In_Open_Scopes (Inst_Par) then
-- If the parent is already installed, install the actuals -- If the parent is already installed, install the actuals
-- for its formal packages. This is necessary when the -- for its formal packages. This is necessary when the child
-- child instance is a child of the parent instance: -- instance is a child of the parent instance: in this case,
-- in this case, the parent is placed on the scope stack -- the parent is placed on the scope stack but the formal
-- but the formal packages are not made visible. -- packages are not made visible.
Install_Formal_Packages (Inst_Par); Install_Formal_Packages (Inst_Par);
end if; end if;
...@@ -6144,9 +6144,9 @@ package body Sem_Ch12 is ...@@ -6144,9 +6144,9 @@ package body Sem_Ch12 is
-- The normal exchange mechanism relies on the setting of a -- The normal exchange mechanism relies on the setting of a
-- flag on the reference in the generic. However, an additional -- flag on the reference in the generic. However, an additional
-- mechanism is needed for types that are not explicitly mentioned -- mechanism is needed for types that are not explicitly
-- in the generic, but may be needed in expanded code in the -- mentioned in the generic, but may be needed in expanded code
-- instance. This includes component types of arrays and -- in the instance. This includes component types of arrays and
-- designated types of access types. This processing must also -- designated types of access types. This processing must also
-- include the index types of arrays which we take care of here. -- include the index types of arrays which we take care of here.
...@@ -6328,10 +6328,10 @@ package body Sem_Ch12 is ...@@ -6328,10 +6328,10 @@ package body Sem_Ch12 is
New_N : Node_Id; New_N : Node_Id;
function Copy_Generic_Descendant (D : Union_Id) return Union_Id; function Copy_Generic_Descendant (D : Union_Id) return Union_Id;
-- Check the given value of one of the Fields referenced by the -- Check the given value of one of the Fields referenced by the current
-- current node to determine whether to copy it recursively. The -- node to determine whether to copy it recursively. The field may hold
-- field may hold a Node_Id, a List_Id, or an Elist_Id, or a plain -- a Node_Id, a List_Id, or an Elist_Id, or a plain value (Sloc, Uint,
-- value (Sloc, Uint, Char) in which case it need not be copied. -- Char) in which case it need not be copied.
procedure Copy_Descendants; procedure Copy_Descendants;
-- Common utility for various nodes -- Common utility for various nodes
...@@ -6345,10 +6345,10 @@ package body Sem_Ch12 is ...@@ -6345,10 +6345,10 @@ package body Sem_Ch12 is
-- Apply Copy_Node recursively to the members of a node list -- Apply Copy_Node recursively to the members of a node list
function In_Defining_Unit_Name (Nam : Node_Id) return Boolean; function In_Defining_Unit_Name (Nam : Node_Id) return Boolean;
-- True if an identifier is part of the defining program unit name -- True if an identifier is part of the defining program unit name of
-- of a child unit. The entity of such an identifier must be kept -- a child unit. The entity of such an identifier must be kept (for
-- (for ASIS use) even though as the name of an enclosing generic -- ASIS use) even though as the name of an enclosing generic it would
-- it would otherwise not be preserved in the generic tree. -- otherwise not be preserved in the generic tree.
---------------------- ----------------------
-- Copy_Descendants -- -- Copy_Descendants --
...@@ -6508,19 +6508,20 @@ package body Sem_Ch12 is ...@@ -6508,19 +6508,20 @@ package body Sem_Ch12 is
Set_Associated_Node (N, New_N); Set_Associated_Node (N, New_N);
-- If we are within an instantiation, this is a nested generic -- If we are within an instantiation, this is a nested generic
-- that has already been analyzed at the point of definition. We -- that has already been analyzed at the point of definition.
-- must preserve references that were global to the enclosing -- We must preserve references that were global to the enclosing
-- parent at that point. Other occurrences, whether global or -- parent at that point. Other occurrences, whether global or
-- local to the current generic, must be resolved anew, so we -- local to the current generic, must be resolved anew, so we
-- reset the entity in the generic copy. A global reference has a -- reset the entity in the generic copy. A global reference has a
-- smaller depth than the parent, or else the same depth in case -- smaller depth than the parent, or else the same depth in case
-- both are distinct compilation units. -- both are distinct compilation units.
-- A child unit is implicitly declared within the enclosing parent -- A child unit is implicitly declared within the enclosing parent
-- but is in fact global to it, and must be preserved. -- but is in fact global to it, and must be preserved.
-- It is also possible for Current_Instantiated_Parent to be -- It is also possible for Current_Instantiated_Parent to be
-- defined, and for this not to be a nested generic, namely if the -- defined, and for this not to be a nested generic, namely if
-- unit is loaded through Rtsfind. In that case, the entity of -- the unit is loaded through Rtsfind. In that case, the entity of
-- New_N is only a link to the associated node, and not a defining -- New_N is only a link to the associated node, and not a defining
-- occurrence. -- occurrence.
...@@ -6561,11 +6562,11 @@ package body Sem_Ch12 is ...@@ -6561,11 +6562,11 @@ package body Sem_Ch12 is
-- Case of instantiating identifier or some other name or operator -- Case of instantiating identifier or some other name or operator
else else
-- If the associated node is still defined, the entity in it is -- If the associated node is still defined, the entity in it
-- global, and must be copied to the instance. If this copy is -- is global, and must be copied to the instance. If this copy
-- being made for a body to inline, it is applied to an -- is being made for a body to inline, it is applied to an
-- instantiated tree, and the entity is already present and must -- instantiated tree, and the entity is already present and
-- be also preserved. -- must be also preserved.
declare declare
Assoc : constant Node_Id := Get_Associated_Node (N); Assoc : constant Node_Id := Get_Associated_Node (N);
...@@ -6640,7 +6641,7 @@ package body Sem_Ch12 is ...@@ -6640,7 +6641,7 @@ package body Sem_Ch12 is
-- If we are not instantiating, then this is where we load and -- If we are not instantiating, then this is where we load and
-- analyze subunits, i.e. at the point where the stub occurs. A -- analyze subunits, i.e. at the point where the stub occurs. A
-- more permissive system might defer this analysis to the point -- more permissive system might defer this analysis to the point
-- of instantiation, but this seems to complicated for now. -- of instantiation, but this seems too complicated for now.
if not Instantiating then if not Instantiating then
declare declare
...@@ -6665,8 +6666,8 @@ package body Sem_Ch12 is ...@@ -6665,8 +6666,8 @@ package body Sem_Ch12 is
Lib.Analysing_Subunit_Of_Main := False; Lib.Analysing_Subunit_Of_Main := False;
-- If the proper body is not found, a warning message will be -- If the proper body is not found, a warning message will be
-- emitted when analyzing the stub, or later at the point -- emitted when analyzing the stub, or later at the point of
-- of instantiation. Here we just leave the stub as is. -- instantiation. Here we just leave the stub as is.
if Unum = No_Unit then if Unum = No_Unit then
Subunits_Missing := True; Subunits_Missing := True;
...@@ -6904,7 +6905,6 @@ package body Sem_Ch12 is ...@@ -6904,7 +6905,6 @@ package body Sem_Ch12 is
begin begin
if Prag_Id = Pragma_Ident or else Prag_Id = Pragma_Comment then if Prag_Id = Pragma_Ident or else Prag_Id = Pragma_Comment then
New_N := Make_Null_Statement (Sloc (N)); New_N := Make_Null_Statement (Sloc (N));
else else
Copy_Descendants; Copy_Descendants;
end if; end if;
...@@ -7463,7 +7463,7 @@ package body Sem_Ch12 is ...@@ -7463,7 +7463,7 @@ package body Sem_Ch12 is
Corresponding_Spec (Proper_Body (Unit (Library_Unit (Enc_G)))); Corresponding_Spec (Proper_Body (Unit (Library_Unit (Enc_G))));
end if; end if;
-- Freeze package that encloses instance, and place node after -- Freeze package that encloses instance, and place node after the
-- package that encloses generic. If enclosing package is already -- package that encloses generic. If enclosing package is already
-- frozen we have to assume it is at the proper place. This may be a -- frozen we have to assume it is at the proper place. This may be a
-- potential ABE that requires dynamic checking. Do not add a freeze -- potential ABE that requires dynamic checking. Do not add a freeze
...@@ -7882,9 +7882,9 @@ package body Sem_Ch12 is ...@@ -7882,9 +7882,9 @@ package body Sem_Ch12 is
Par_N : Node_Id; Par_N : Node_Id;
function Enclosing_Body (N : Node_Id) return Node_Id; function Enclosing_Body (N : Node_Id) return Node_Id;
-- Find enclosing package or subprogram body, if any. Freeze node -- Find enclosing package or subprogram body, if any. Freeze node may
-- may be placed at end of current declarative list if previous -- be placed at end of current declarative list if previous instance
-- instance and current one have different enclosing bodies. -- and current one have different enclosing bodies.
function Previous_Instance (Gen : Entity_Id) return Entity_Id; function Previous_Instance (Gen : Entity_Id) return Entity_Id;
-- Find the local instance, if any, that declares the generic that is -- Find the local instance, if any, that declares the generic that is
...@@ -8393,8 +8393,8 @@ package body Sem_Ch12 is ...@@ -8393,8 +8393,8 @@ package body Sem_Ch12 is
-- Install the scopes of noninstance parent units ending with Par -- Install the scopes of noninstance parent units ending with Par
procedure Install_Spec (Par : Entity_Id); procedure Install_Spec (Par : Entity_Id);
-- The child unit is within the declarative part of the parent, so -- The child unit is within the declarative part of the parent, so the
-- the declarations within the parent are immediately visible. -- declarations within the parent are immediately visible.
------------------------------- -------------------------------
-- Install_Noninstance_Specs -- -- Install_Noninstance_Specs --
...@@ -8421,10 +8421,10 @@ package body Sem_Ch12 is ...@@ -8421,10 +8421,10 @@ package body Sem_Ch12 is
begin begin
-- If this parent of the child instance is a top-level unit, -- If this parent of the child instance is a top-level unit,
-- then record the unit and its visibility for later resetting -- then record the unit and its visibility for later resetting in
-- in Remove_Parent. We exclude units that are generic instances, -- Remove_Parent. We exclude units that are generic instances, as we
-- as we only want to record this information for the ultimate -- only want to record this information for the ultimate top-level
-- top-level noninstance parent (is that always correct???). -- noninstance parent (is that always correct???).
if Scope (Par) = Standard_Standard if Scope (Par) = Standard_Standard
and then not Is_Generic_Instance (Par) and then not Is_Generic_Instance (Par)
...@@ -8698,15 +8698,15 @@ package body Sem_Ch12 is ...@@ -8698,15 +8698,15 @@ package body Sem_Ch12 is
procedure Find_Matching_Actual procedure Find_Matching_Actual
(F : Node_Id; (F : Node_Id;
Act : in out Entity_Id); Act : in out Entity_Id);
-- We need to associate each formal entity in the formal package -- We need to associate each formal entity in the formal package with
-- with the corresponding entity in the actual package. The actual -- the corresponding entity in the actual package. The actual package
-- package has been analyzed and possibly expanded, and as a result -- has been analyzed and possibly expanded, and as a result there is
-- there is no one-to-one correspondence between the two lists (for -- no one-to-one correspondence between the two lists (for example,
-- example, the actual may include subtypes, itypes, and inherited -- the actual may include subtypes, itypes, and inherited primitive
-- primitive operations, interspersed among the renaming declarations -- operations, interspersed among the renaming declarations for the
-- for the actuals) . We retrieve the corresponding actual by name -- actuals) . We retrieve the corresponding actual by name because each
-- because each actual has the same name as the formal, and they do -- actual has the same name as the formal, and they do appear in the
-- appear in the same order. -- same order.
function Get_Formal_Entity (N : Node_Id) return Entity_Id; function Get_Formal_Entity (N : Node_Id) return Entity_Id;
-- Retrieve entity of defining entity of generic formal parameter. -- Retrieve entity of defining entity of generic formal parameter.
...@@ -8718,13 +8718,12 @@ package body Sem_Ch12 is ...@@ -8718,13 +8718,12 @@ package body Sem_Ch12 is
(Formal_Node : Node_Id; (Formal_Node : Node_Id;
Formal_Ent : Entity_Id; Formal_Ent : Entity_Id;
Actual_Ent : Entity_Id); Actual_Ent : Entity_Id);
-- Associates the formal entity with the actual. In the case -- Associates the formal entity with the actual. In the case where
-- where Formal_Ent is a formal package, this procedure iterates -- Formal_Ent is a formal package, this procedure iterates through all
-- through all of its formals and enters associations between the -- of its formals and enters associations between the actuals occurring
-- actuals occurring in the formal package's corresponding actual -- in the formal package's corresponding actual package (given by
-- package (given by Actual_Ent) and the formal package's formal -- Actual_Ent) and the formal package's formal parameters. This
-- parameters. This procedure recurses if any of the parameters is -- procedure recurses if any of the parameters is itself a package.
-- itself a package.
function Is_Instance_Of function Is_Instance_Of
(Act_Spec : Entity_Id; (Act_Spec : Entity_Id;
...@@ -9179,12 +9178,12 @@ package body Sem_Ch12 is ...@@ -9179,12 +9178,12 @@ package body Sem_Ch12 is
function From_Parent_Scope (Subp : Entity_Id) return Boolean; function From_Parent_Scope (Subp : Entity_Id) return Boolean;
-- If the generic is a child unit, the parent has been installed on the -- If the generic is a child unit, the parent has been installed on the
-- scope stack, but a default subprogram cannot resolve to something on -- scope stack, but a default subprogram cannot resolve to something
-- the parent because that parent is not really part of the visible -- on the parent because that parent is not really part of the visible
-- context (it is there to resolve explicit local entities). If the -- context (it is there to resolve explicit local entities). If the
-- default has resolved in this way, we remove the entity from -- default has resolved in this way, we remove the entity from immediate
-- immediate visibility and analyze the node again to emit an error -- visibility and analyze the node again to emit an error message or
-- message or find another visible candidate. -- find another visible candidate.
procedure Valid_Actual_Subprogram (Act : Node_Id); procedure Valid_Actual_Subprogram (Act : Node_Id);
-- Perform legality check and raise exception on failure -- Perform legality check and raise exception on failure
...@@ -9562,14 +9561,14 @@ package body Sem_Ch12 is ...@@ -9562,14 +9561,14 @@ package body Sem_Ch12 is
end if; end if;
-- The actual has to be resolved in order to check that it is a -- The actual has to be resolved in order to check that it is a
-- variable (due to cases such as F (1), where F returns access to an -- variable (due to cases such as F (1), where F returns access to
-- array, and for overloaded prefixes). -- an array, and for overloaded prefixes).
Ftyp := Get_Instance_Of (Etype (A_Gen_Obj)); Ftyp := Get_Instance_Of (Etype (A_Gen_Obj));
-- If the type of the formal is not itself a formal, and the -- If the type of the formal is not itself a formal, and the current
-- current unit is a child unit, the formal type must be declared -- unit is a child unit, the formal type must be declared in a
-- in a parent, and must be retrieved by visibility. -- parent, and must be retrieved by visibility.
if Ftyp = Orig_Ftyp if Ftyp = Orig_Ftyp
and then Is_Generic_Unit (Scope (Ftyp)) and then Is_Generic_Unit (Scope (Ftyp))
......
...@@ -3512,6 +3512,7 @@ package body Sem_Ch4 is ...@@ -3512,6 +3512,7 @@ package body Sem_Ch4 is
function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean; function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean;
-- Determine whether entity Id is referenced within expression Expr -- Determine whether entity Id is referenced within expression Expr
-- This should be moved to sem_util ???
-------------------- --------------------
-- Is_Empty_Range -- -- Is_Empty_Range --
...@@ -3575,6 +3576,10 @@ package body Sem_Ch4 is ...@@ -3575,6 +3576,10 @@ package body Sem_Ch4 is
-- Determine whether node N denotes a reference to Id. If this is the -- Determine whether node N denotes a reference to Id. If this is the
-- case, set global flag Seen to True and stop the traversal. -- case, set global flag Seen to True and stop the traversal.
------------------
-- Is_Reference --
------------------
function Is_Reference (N : Node_Id) return Traverse_Result is function Is_Reference (N : Node_Id) return Traverse_Result is
begin begin
if Is_Entity_Name (N) if Is_Entity_Name (N)
...@@ -3594,7 +3599,6 @@ package body Sem_Ch4 is ...@@ -3594,7 +3599,6 @@ package body Sem_Ch4 is
begin begin
Inspect_Expression (Expr); Inspect_Expression (Expr);
return Seen; return Seen;
end Referenced; end Referenced;
...@@ -3662,10 +3666,10 @@ package body Sem_Ch4 is ...@@ -3662,10 +3666,10 @@ package body Sem_Ch4 is
end if; end if;
-- Diagnose a possible misuse of the "some" existential quantifier. When -- Diagnose a possible misuse of the "some" existential quantifier. When
-- we have a quantified expression of the form -- we have a quantified expression of the form:
--
-- for some X => (if P then Q [else True]) -- for some X => (if P then Q [else True])
--
-- the if expression will not hold and render the quantified expression -- the if expression will not hold and render the quantified expression
-- trivially True. -- trivially True.
......
...@@ -2150,9 +2150,8 @@ package body Sem_Util is ...@@ -2150,9 +2150,8 @@ package body Sem_Util is
States : constant Elist_Id := Abstract_States (Pkg); States : constant Elist_Id := Abstract_States (Pkg);
begin begin
-- Check the first available state of the related package. A null -- Check first available state of related package. A null abstract
-- abstract state always appears as the sole element of the state -- state always appears as the sole element of the state list.
-- list.
return return
Present (States) Present (States)
......
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