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
+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>
* sem_prag.adb, sem_util.adb, sem_res.adb, exp_ch4.adb: Minor
2013-04-11 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, sem_util.adb, sem_res.adb, exp_ch4.adb: Minor
end if;
end Ensure_Defined;
end if;
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 --
--------------------
-- used to ensure that an Itype is properly defined outside a conditional
-- construct when it is referenced in more than one branch.
-- used to ensure that an Itype is properly defined outside a conditional
-- 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;
-- Determine whether it is appropriate to dynamically allocate strings
-- which represent entry [family member] names. These strings are created
function Entry_Names_OK return Boolean;
-- Determine whether it is appropriate to dynamically allocate strings
-- which represent entry [family member] names. These strings are created
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
-- --
-- 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- --
function "*" (P : PString; Var : VString_Var) return Pattern;
function "*" (P : PChar; Var : VString_Var) return Pattern;
-- Matches P, and if the match succeeds, assigns the matched substring
function "*" (P : PString; Var : VString_Var) return Pattern;
function "*" (P : PChar; Var : VString_Var) return Pattern;
-- 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
-- once during the course of the match, then the assignment will occur
-- more than once.
-- 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
-- more than once.
-- Verify the legality of a single dependency clause. Flag Is_Last
-- denotes whether Clause is the last clause in the relation.
-- Verify the legality of a single dependency clause. Flag Is_Last
-- 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);
-- Remove a self-dependency "+" from the input list of a clause.
-- Depending on the contents of the relation, either split the
procedure Normalize_Clause (Clause : Node_Id);
-- Remove a self-dependency "+" from the input list of a clause.
-- Depending on the contents of the relation, either split the
Analyze_Input_List (Inputs);
end Analyze_Dependency_Clause;
Analyze_Input_List (Inputs);
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 --
----------------------
(Output : Node_Id;
Inputs : Node_Id)
is
(Output : Node_Id;
Inputs : Node_Id)
is
- function Contains
- (List : List_Id;
- Id : Entity_Id) return Boolean;
- -- Determine whether List contains element Id
- -- Surely this should not be buried here??? exp_Util???
-
- --------------
- -- Contains --
- --------------
-
- function Contains
- (List : List_Id;
- Id : Entity_Id) return Boolean
+ function In_Input_List
+ (Item : Entity_Id;
+ Inputs : List_Id) return Boolean;
+ -- Determine whether a particulat item appears in the
+ -- input list of a clause.
+
+ -------------------
+ -- In_Input_List --
+ -------------------
+
+ function In_Input_List
+ (Item : Entity_Id;
+ Inputs : List_Id) return Boolean
+ Elmt := First (Inputs);
while Present (Elmt) loop
while Present (Elmt) loop
- if Entity_Of (Elmt) = Id then
+ if Entity_Of (Elmt) = Item then
+ Output_Id : constant Entity_Id := Entity_Of (Output);
+ Grouped : List_Id;
-- Start of processing for Propagate_Output
-- Start of processing for Propagate_Output
elsif Nkind (Inputs) = N_Aggregate then
Grouped := Expressions (Inputs);
elsif Nkind (Inputs) = N_Aggregate then
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));
end if;
Prepend_To (Grouped, New_Copy_Tree (Output));
end if;
-- (Output => (Output, Input))
-- (Output => (Output, Input))
- elsif Entity_Of (Output) /= Entity_Of (Inputs) then
+ elsif Entity_Of (Inputs) /= Output_Id then
Rewrite (Inputs,
Make_Aggregate (Loc,
Expressions => New_List (
Rewrite (Inputs,
Make_Aggregate (Loc,
Expressions => New_List (