Skip to content

R
riscv-gcc-1
Commit d45bc240 by Arnaud Charlet
Options

[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
Showing with 67 additions and 54 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/exp_util.adb
......@@ -1774,6 +1774,35 @@ package body Exp_Util is
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 --
--------------------
......
gcc/ada/exp_util.ads
......@@ -349,6 +349,10 @@ package Exp_Util is
-- 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
......
gcc/ada/g-spipat.ads
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -729,7 +729,7 @@ package GNAT.Spitbol.Patterns is
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.
......
gcc/ada/sem_prag.adb
......@@ -8917,11 +8917,6 @@ package body Sem_Prag is
-- 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
......@@ -9202,34 +9197,6 @@ package body Sem_Prag is
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 --
----------------------
......@@ -9279,26 +9246,26 @@ package body Sem_Prag 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
is
Elmt : Node_Id;
begin
Elmt := First (List);
Elmt := First (Inputs);
while Present (Elmt) loop
if Entity_Of (Elmt) = Id then
if Entity_Of (Elmt) = Item then
return True;
end if;
......@@ -9306,11 +9273,12 @@ package body Sem_Prag is
end loop;
return False;
end Contains;
end In_Input_List;
-- Local variables
Grouped : List_Id;
Output_Id : constant Entity_Id := Entity_Of (Output);
Grouped : List_Id;
-- Start of processing for Propagate_Output
......@@ -9340,7 +9308,10 @@ package body Sem_Prag is
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;
......@@ -9353,7 +9324,7 @@ package body Sem_Prag is
-- (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 (
......
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