Commit 72267417 by Arnaud Charlet

[multiple changes]

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

	* xoscons.adb: Minor reformatting.

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

	* sem_prag.adb (Check_Mode): Ensure that a
	self-referential output appears in both input and output lists of
	the subprogram as categorized by aspect Global.
	(Check_Usage): Rename formal parameters to better illustrate their
	function. Update all uses of the said formals.

2013-04-23  Thomas Quinot  <quinot@adacore.com>

	* exp_util.adb, exp_util.ads (Fully_Qualified_Name_String): New
	parameter Append_NUL to make NUL-termination optional.
	* exp_dist.adb: Consistently use the above throughout instead of
	Get_Library_Unit_Name_String.

From-SVN: r198183
parent 2fabf41e
2013-04-23 Robert Dewar <dewar@adacore.com> 2013-04-23 Robert Dewar <dewar@adacore.com>
* xoscons.adb: Minor reformatting.
2013-04-23 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Check_Mode): Ensure that a
self-referential output appears in both input and output lists of
the subprogram as categorized by aspect Global.
(Check_Usage): Rename formal parameters to better illustrate their
function. Update all uses of the said formals.
2013-04-23 Thomas Quinot <quinot@adacore.com>
* exp_util.adb, exp_util.ads (Fully_Qualified_Name_String): New
parameter Append_NUL to make NUL-termination optional.
* exp_dist.adb: Consistently use the above throughout instead of
Get_Library_Unit_Name_String.
2013-04-23 Robert Dewar <dewar@adacore.com>
* sem_util.adb, sem_res.adb, prj-tree.adb, prj-tree.ads: Minor * sem_util.adb, sem_res.adb, prj-tree.adb, prj-tree.ads: Minor
reformatting. reformatting.
......
...@@ -2318,7 +2318,7 @@ package body Exp_Dist is ...@@ -2318,7 +2318,7 @@ package body Exp_Dist is
procedure Build_Passive_Partition_Stub (U : Node_Id) is procedure Build_Passive_Partition_Stub (U : Node_Id) is
Pkg_Spec : Node_Id; Pkg_Spec : Node_Id;
Pkg_Name : String_Id; Pkg_Ent : Entity_Id;
L : List_Id; L : List_Id;
Reg : Node_Id; Reg : Node_Id;
Loc : constant Source_Ptr := Sloc (U); Loc : constant Source_Ptr := Sloc (U);
...@@ -2343,18 +2343,17 @@ package body Exp_Dist is ...@@ -2343,18 +2343,17 @@ package body Exp_Dist is
Pkg_Spec := Parent (Corresponding_Spec (U)); Pkg_Spec := Parent (Corresponding_Spec (U));
L := Declarations (U); L := Declarations (U);
end if; end if;
Pkg_Ent := Defining_Entity (Pkg_Spec);
Get_Library_Unit_Name_String (Pkg_Spec);
Pkg_Name := String_From_Name_Buffer;
Reg := Reg :=
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => Name =>
New_Occurrence_Of (RTE (RE_Register_Passive_Package), Loc), New_Occurrence_Of (RTE (RE_Register_Passive_Package), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
Make_String_Literal (Loc, Pkg_Name), Make_String_Literal (Loc,
Fully_Qualified_Name_String (Pkg_Ent, Append_NUL => False)),
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Prefix => New_Occurrence_Of (Pkg_Ent, Loc),
New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc),
Attribute_Name => Name_Version))); Attribute_Name => Name_Version)));
Append_To (L, Reg); Append_To (L, Reg);
Analyze (Reg); Analyze (Reg);
...@@ -4111,13 +4110,13 @@ package body Exp_Dist is ...@@ -4111,13 +4110,13 @@ package body Exp_Dist is
Append_To (Decls, Pkg_RPC_Receiver_Body); Append_To (Decls, Pkg_RPC_Receiver_Body);
Analyze (Last (Decls)); Analyze (Last (Decls));
Get_Library_Unit_Name_String (Pkg_Spec);
-- Name -- Name
Append_To (Register_Pkg_Actuals, Append_To (Register_Pkg_Actuals,
Make_String_Literal (Loc, Make_String_Literal (Loc,
Strval => String_From_Name_Buffer)); Strval =>
Fully_Qualified_Name_String
(Defining_Entity (Pkg_Spec), Append_NUL => False)));
-- Receiver -- Receiver
...@@ -5591,7 +5590,7 @@ package body Exp_Dist is ...@@ -5591,7 +5590,7 @@ package body Exp_Dist is
-- Name -- Name
Make_String_Literal (Loc, Make_String_Literal (Loc,
Fully_Qualified_Name_String (Desig)), Fully_Qualified_Name_String (Desig, Append_NUL => False)),
-- Handler -- Handler
...@@ -5938,7 +5937,8 @@ package body Exp_Dist is ...@@ -5938,7 +5937,8 @@ package body Exp_Dist is
New_Occurrence_Of (RACW_Parameter, Loc)), New_Occurrence_Of (RACW_Parameter, Loc)),
Make_String_Literal (Loc, Make_String_Literal (Loc,
Strval => Fully_Qualified_Name_String Strval => Fully_Qualified_Name_String
(Etype (Designated_Type (RACW_Type)))), (Etype (Designated_Type (RACW_Type)),
Append_NUL => False)),
Build_Stub_Tag (Loc, RACW_Type), Build_Stub_Tag (Loc, RACW_Type),
New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc), New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
...@@ -6134,7 +6134,8 @@ package body Exp_Dist is ...@@ -6134,7 +6134,8 @@ package body Exp_Dist is
Unchecked_Convert_To (RTE (RE_Address), Object), Unchecked_Convert_To (RTE (RE_Address), Object),
Make_String_Literal (Loc, Make_String_Literal (Loc,
Strval => Fully_Qualified_Name_String Strval => Fully_Qualified_Name_String
(Etype (Designated_Type (RACW_Type)))), (Etype (Designated_Type (RACW_Type)),
Append_NUL => False)),
Build_Stub_Tag (Loc, RACW_Type), Build_Stub_Tag (Loc, RACW_Type),
New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc), New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
...@@ -7069,13 +7070,13 @@ package body Exp_Dist is ...@@ -7069,13 +7070,13 @@ package body Exp_Dist is
Append_To (Decls, Pkg_RPC_Receiver_Object); Append_To (Decls, Pkg_RPC_Receiver_Object);
Analyze (Last (Decls)); Analyze (Last (Decls));
Get_Library_Unit_Name_String (Pkg_Spec);
-- Name -- Name
Append_To (Register_Pkg_Actuals, Append_To (Register_Pkg_Actuals,
Make_String_Literal (Loc, Make_String_Literal (Loc,
Strval => String_From_Name_Buffer)); Strval =>
Fully_Qualified_Name_String
(Defining_Entity (Pkg_Spec), Append_NUL => False)));
-- Version -- Version
...@@ -9210,20 +9211,12 @@ package body Exp_Dist is ...@@ -9210,20 +9211,12 @@ package body Exp_Dist is
Repo_Id_Str : out String_Id) Repo_Id_Str : out String_Id)
is is
begin begin
Name_Str := Fully_Qualified_Name_String (E, Append_NUL => False);
Start_String; Start_String;
Store_String_Chars ("DSA:"); Store_String_Chars ("DSA:");
Get_Library_Unit_Name_String (Scope (E)); Store_String_Chars (Name_Str);
Store_String_Chars
(Name_Buffer (Name_Buffer'First ..
Name_Buffer'First + Name_Len - 1));
Store_String_Char ('.');
Get_Name_String (Chars (E));
Store_String_Chars
(Name_Buffer (Name_Buffer'First ..
Name_Buffer'First + Name_Len - 1));
Store_String_Chars (":1.0"); Store_String_Chars (":1.0");
Repo_Id_Str := End_String; Repo_Id_Str := End_String;
Name_Str := String_From_Name_Buffer;
end Build_Name_And_Repository_Id; end Build_Name_And_Repository_Id;
----------------------- -----------------------
...@@ -11134,11 +11127,11 @@ package body Exp_Dist is ...@@ -11134,11 +11127,11 @@ package body Exp_Dist is
Package_Spec : Node_Id) return Node_Id Package_Spec : Node_Id) return Node_Id
is is
Inst : Node_Id; Inst : Node_Id;
Pkg_Name : String_Id; Pkg_Name : constant String_Id :=
Fully_Qualified_Name_String
(Defining_Entity (Package_Spec), Append_NUL => False);
begin begin
Get_Library_Unit_Name_String (Package_Spec);
Pkg_Name := String_From_Name_Buffer;
Inst := Inst :=
Make_Package_Instantiation (Loc, Make_Package_Instantiation (Loc,
Defining_Unit_Name => Make_Temporary (Loc, 'R'), Defining_Unit_Name => Make_Temporary (Loc, 'R'),
......
...@@ -2535,7 +2535,10 @@ package body Exp_Util is ...@@ -2535,7 +2535,10 @@ package body Exp_Util is
-- Fully_Qualified_Name_String -- -- Fully_Qualified_Name_String --
--------------------------------- ---------------------------------
function Fully_Qualified_Name_String (E : Entity_Id) return String_Id is function Fully_Qualified_Name_String
(E : Entity_Id;
Append_NUL : Boolean := True) return String_Id
is
procedure Internal_Full_Qualified_Name (E : Entity_Id); procedure Internal_Full_Qualified_Name (E : Entity_Id);
-- Compute recursively the qualified name without NUL at the end, adding -- Compute recursively the qualified name without NUL at the end, adding
-- it to the currently started string being generated -- it to the currently started string being generated
...@@ -2583,7 +2586,9 @@ package body Exp_Util is ...@@ -2583,7 +2586,9 @@ package body Exp_Util is
begin begin
Start_String; Start_String;
Internal_Full_Qualified_Name (E); Internal_Full_Qualified_Name (E);
Store_String_Char (Get_Char_Code (ASCII.NUL)); if Append_NUL then
Store_String_Char (Get_Char_Code (ASCII.NUL));
end if;
return End_String; return End_String;
end Fully_Qualified_Name_String; end Fully_Qualified_Name_String;
......
...@@ -442,10 +442,12 @@ package Exp_Util is ...@@ -442,10 +442,12 @@ package Exp_Util is
-- Force_Evaluation further guarantees that all evaluations will yield -- Force_Evaluation further guarantees that all evaluations will yield
-- the same result. -- the same result.
function Fully_Qualified_Name_String (E : Entity_Id) return String_Id; function Fully_Qualified_Name_String
(E : Entity_Id;
Append_NUL : Boolean := True) return String_Id;
-- Generates the string literal corresponding to the fully qualified name -- Generates the string literal corresponding to the fully qualified name
-- of entity E, in all upper case, with an ASCII.NUL appended at the end -- of entity E, in all upper case, with an ASCII.NUL appended at the end
-- of the name. -- of the name if Append_NUL is True.
procedure Generate_Poll_Call (N : Node_Id); procedure Generate_Poll_Call (N : Node_Id);
-- If polling is active, then a call to the Poll routine is built, -- If polling is active, then a call to the Poll routine is built,
......
...@@ -9365,10 +9365,10 @@ package body Sem_Prag is ...@@ -9365,10 +9365,10 @@ package body Sem_Prag is
-- dependency clause has operator "+". -- dependency clause has operator "+".
procedure Check_Usage procedure Check_Usage
(Subp_List : Elist_Id; (Subp_Items : Elist_Id;
Item_List : Elist_Id; Used_Items : Elist_Id;
Is_Input : Boolean); Is_Input : Boolean);
-- Verify that all items from list Subp_List appear in Item_List. -- Verify that all items from Subp_Items appear in Used_Items.
-- Emit an error if this is not the case. -- Emit an error if this is not the case.
procedure Collect_Subprogram_Inputs_Outputs; procedure Collect_Subprogram_Inputs_Outputs;
...@@ -9765,7 +9765,10 @@ package body Sem_Prag is ...@@ -9765,7 +9765,10 @@ package body Sem_Prag is
if Ekind_In (Item_Id, E_Abstract_State, E_Variable) then if Ekind_In (Item_Id, E_Abstract_State, E_Variable) then
if Global_Seen if Global_Seen
and then not Appears_In (Subp_Inputs, Item_Id) and then not
(Appears_In (Subp_Inputs, Item_Id)
and then
Appears_In (Subp_Outputs, Item_Id))
then then
Error_Msg_NE Error_Msg_NE
("item & must have mode in out", Item, Item_Id); ("item & must have mode in out", Item, Item_Id);
...@@ -9795,9 +9798,9 @@ package body Sem_Prag is ...@@ -9795,9 +9798,9 @@ package body Sem_Prag is
----------------- -----------------
procedure Check_Usage procedure Check_Usage
(Subp_List : Elist_Id; (Subp_Items : Elist_Id;
Item_List : Elist_Id; Used_Items : Elist_Id;
Is_Input : Boolean) Is_Input : Boolean)
is is
procedure Usage_Error (Item : Node_Id; Item_Id : Entity_Id); procedure Usage_Error (Item : Node_Id; Item_Id : Entity_Id);
-- Emit an error concerning the erroneous usage of an item -- Emit an error concerning the erroneous usage of an item
...@@ -9828,14 +9831,14 @@ package body Sem_Prag is ...@@ -9828,14 +9831,14 @@ package body Sem_Prag is
-- Start of processing for Check_Usage -- Start of processing for Check_Usage
begin begin
if No (Subp_List) then if No (Subp_Items) then
return; return;
end if; end if;
-- Each input or output of the subprogram must appear in a -- Each input or output of the subprogram must appear in a
-- dependency relation. -- dependency relation.
Elmt := First_Elmt (Subp_List); Elmt := First_Elmt (Subp_Items);
while Present (Elmt) loop while Present (Elmt) loop
Item := Node (Elmt); Item := Node (Elmt);
...@@ -9847,7 +9850,7 @@ package body Sem_Prag is ...@@ -9847,7 +9850,7 @@ package body Sem_Prag is
-- The item does not appear in a dependency -- The item does not appear in a dependency
if not Contains (Item_List, Item_Id) then if not Contains (Used_Items, Item_Id) then
if Is_Formal (Item_Id) then if Is_Formal (Item_Id) then
Usage_Error (Item, Item_Id); Usage_Error (Item, Item_Id);
......
...@@ -441,7 +441,6 @@ procedure XOSCons is ...@@ -441,7 +441,6 @@ procedure XOSCons is
Ada_Ofile, C_Ofile : Sfile; Ada_Ofile, C_Ofile : Sfile;
Current_Line : in out Integer) Current_Line : in out Integer)
is is
function Get_Value (Name : String) return Int_Value_Type; function Get_Value (Name : String) return Int_Value_Type;
-- Returns the value of the variable Name -- Returns the value of the variable Name
......
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