Commit d45bc240 by Arnaud Charlet

[multiple changes]

2013-04-11  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Entity_Of): Moved to Exp_Util.
	* exp_util.ads, exp_util.adb (Entity_Of): New routine.

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

	* g-spipat.ads: Minor comment fix.

From-SVN: r197778
parent b2502161
2013-04-11 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Entity_Of): Moved to Exp_Util.
* exp_util.ads, exp_util.adb (Entity_Of): New routine.
2013-04-11 Robert Dewar <dewar@adacore.com>
* g-spipat.ads: Minor comment fix.
2013-04-11 Robert Dewar <dewar@adacore.com> 2013-04-11 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, sem_util.adb, sem_res.adb, exp_ch4.adb: Minor * sem_prag.adb, sem_util.adb, sem_res.adb, exp_ch4.adb: Minor
......
...@@ -1774,6 +1774,35 @@ package body Exp_Util is ...@@ -1774,6 +1774,35 @@ package body Exp_Util is
end if; end if;
end Ensure_Defined; end Ensure_Defined;
---------------
-- Entity_Of --
---------------
function Entity_Of (N : Node_Id) return Entity_Id is
Id : Entity_Id;
begin
Id := Empty;
if Is_Entity_Name (N) then
Id := Entity (N);
-- Follow a possible chain of renamings to reach the root renamed
-- object.
while Present (Renamed_Object (Id)) loop
if Is_Entity_Name (Renamed_Object (Id)) then
Id := Entity (Renamed_Object (Id));
else
Id := Empty;
exit;
end if;
end loop;
end if;
return Id;
end Entity_Of;
-------------------- --------------------
-- Entry_Names_OK -- -- Entry_Names_OK --
-------------------- --------------------
......
...@@ -349,6 +349,10 @@ package Exp_Util is ...@@ -349,6 +349,10 @@ package Exp_Util is
-- used to ensure that an Itype is properly defined outside a conditional -- used to ensure that an Itype is properly defined outside a conditional
-- construct when it is referenced in more than one branch. -- construct when it is referenced in more than one branch.
function Entity_Of (N : Node_Id) return Entity_Id;
-- Return the entity of N or Empty. If N is a renaming, return the entity
-- of the root renamed object.
function Entry_Names_OK return Boolean; function Entry_Names_OK return Boolean;
-- Determine whether it is appropriate to dynamically allocate strings -- Determine whether it is appropriate to dynamically allocate strings
-- which represent entry [family member] names. These strings are created -- which represent entry [family member] names. These strings are created
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1997-2010, AdaCore -- -- Copyright (C) 1997-2013, AdaCore --
-- -- -- --
-- 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- --
...@@ -729,7 +729,7 @@ package GNAT.Spitbol.Patterns is ...@@ -729,7 +729,7 @@ package GNAT.Spitbol.Patterns is
function "*" (P : PString; Var : VString_Var) return Pattern; function "*" (P : PString; Var : VString_Var) return Pattern;
function "*" (P : PChar; Var : VString_Var) return Pattern; function "*" (P : PChar; Var : VString_Var) return Pattern;
-- Matches P, and if the match succeeds, assigns the matched substring -- Matches P, and if the match succeeds, assigns the matched substring
-- to the given VString variable S. This assignment happens as soon as -- to the given VString variable Var. This assignment happens as soon as
-- the substring is matched, and if the pattern P1 is matched more than -- the substring is matched, and if the pattern P1 is matched more than
-- once during the course of the match, then the assignment will occur -- once during the course of the match, then the assignment will occur
-- more than once. -- more than once.
......
...@@ -8917,11 +8917,6 @@ package body Sem_Prag is ...@@ -8917,11 +8917,6 @@ package body Sem_Prag is
-- Verify the legality of a single dependency clause. Flag Is_Last -- Verify the legality of a single dependency clause. Flag Is_Last
-- denotes whether Clause is the last clause in the relation. -- denotes whether Clause is the last clause in the relation.
function Entity_Of (N : Node_Id) return Entity_Id;
-- Return the entity of N or Empty. If N is a renaming, find the
-- entity of the root renamed object.
-- Surely this should not be buried here??? exp_util???
procedure Normalize_Clause (Clause : Node_Id); procedure Normalize_Clause (Clause : Node_Id);
-- Remove a self-dependency "+" from the input list of a clause. -- Remove a self-dependency "+" from the input list of a clause.
-- Depending on the contents of the relation, either split the -- Depending on the contents of the relation, either split the
...@@ -9202,34 +9197,6 @@ package body Sem_Prag is ...@@ -9202,34 +9197,6 @@ package body Sem_Prag is
Analyze_Input_List (Inputs); Analyze_Input_List (Inputs);
end Analyze_Dependency_Clause; end Analyze_Dependency_Clause;
---------------
-- Entity_Of --
---------------
function Entity_Of (N : Node_Id) return Entity_Id is
Id : Entity_Id;
begin
-- Follow a possible chain of renamings to reach the root
-- renamed object.
Id := Entity (N);
while Present (Renamed_Object (Id)) loop
if Is_Entity_Name (Renamed_Object (Id)) then
Id := Entity (Renamed_Object (Id));
-- The root of the renaming is not an entire object or
-- variable, return Empty.
else
Id := Empty;
exit;
end if;
end loop;
return Id;
end Entity_Of;
---------------------- ----------------------
-- Normalize_Clause -- -- Normalize_Clause --
---------------------- ----------------------
...@@ -9279,26 +9246,26 @@ package body Sem_Prag is ...@@ -9279,26 +9246,26 @@ package body Sem_Prag is
(Output : Node_Id; (Output : Node_Id;
Inputs : Node_Id) Inputs : Node_Id)
is is
function Contains function In_Input_List
(List : List_Id; (Item : Entity_Id;
Id : Entity_Id) return Boolean; Inputs : List_Id) return Boolean;
-- Determine whether List contains element Id -- Determine whether a particulat item appears in the
-- Surely this should not be buried here??? exp_Util??? -- input list of a clause.
-------------- -------------------
-- Contains -- -- In_Input_List --
-------------- -------------------
function Contains function In_Input_List
(List : List_Id; (Item : Entity_Id;
Id : Entity_Id) return Boolean Inputs : List_Id) return Boolean
is is
Elmt : Node_Id; Elmt : Node_Id;
begin begin
Elmt := First (List); Elmt := First (Inputs);
while Present (Elmt) loop while Present (Elmt) loop
if Entity_Of (Elmt) = Id then if Entity_Of (Elmt) = Item then
return True; return True;
end if; end if;
...@@ -9306,11 +9273,12 @@ package body Sem_Prag is ...@@ -9306,11 +9273,12 @@ package body Sem_Prag is
end loop; end loop;
return False; return False;
end Contains; end In_Input_List;
-- Local variables -- Local variables
Grouped : List_Id; Output_Id : constant Entity_Id := Entity_Of (Output);
Grouped : List_Id;
-- Start of processing for Propagate_Output -- Start of processing for Propagate_Output
...@@ -9340,7 +9308,10 @@ package body Sem_Prag is ...@@ -9340,7 +9308,10 @@ package body Sem_Prag is
elsif Nkind (Inputs) = N_Aggregate then elsif Nkind (Inputs) = N_Aggregate then
Grouped := Expressions (Inputs); Grouped := Expressions (Inputs);
if not Contains (Grouped, Entity_Of (Output)) then if not In_Input_List
(Item => Output_Id,
Inputs => Grouped)
then
Prepend_To (Grouped, New_Copy_Tree (Output)); Prepend_To (Grouped, New_Copy_Tree (Output));
end if; end if;
...@@ -9353,7 +9324,7 @@ package body Sem_Prag is ...@@ -9353,7 +9324,7 @@ package body Sem_Prag is
-- (Output => (Output, Input)) -- (Output => (Output, Input))
elsif Entity_Of (Output) /= Entity_Of (Inputs) then elsif Entity_Of (Inputs) /= Output_Id then
Rewrite (Inputs, Rewrite (Inputs,
Make_Aggregate (Loc, Make_Aggregate (Loc,
Expressions => New_List ( Expressions => New_List (
......
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