2
0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-29 07:00:24 +08:00

[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
This commit is contained in:
Arnaud Charlet 2013-04-23 11:48:55 +02:00
parent 2fabf41e29
commit 72267417bd
6 changed files with 65 additions and 44 deletions

@ -1,3 +1,22 @@
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

@ -2318,7 +2318,7 @@ package body Exp_Dist is
procedure Build_Passive_Partition_Stub (U : Node_Id) is
Pkg_Spec : Node_Id;
Pkg_Name : String_Id;
Pkg_Ent : Entity_Id;
L : List_Id;
Reg : Node_Id;
Loc : constant Source_Ptr := Sloc (U);
@ -2343,18 +2343,17 @@ package body Exp_Dist is
Pkg_Spec := Parent (Corresponding_Spec (U));
L := Declarations (U);
end if;
Pkg_Ent := Defining_Entity (Pkg_Spec);
Get_Library_Unit_Name_String (Pkg_Spec);
Pkg_Name := String_From_Name_Buffer;
Reg :=
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Register_Passive_Package), Loc),
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,
Prefix =>
New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc),
Prefix => New_Occurrence_Of (Pkg_Ent, Loc),
Attribute_Name => Name_Version)));
Append_To (L, Reg);
Analyze (Reg);
@ -4111,13 +4110,13 @@ package body Exp_Dist is
Append_To (Decls, Pkg_RPC_Receiver_Body);
Analyze (Last (Decls));
Get_Library_Unit_Name_String (Pkg_Spec);
-- Name
Append_To (Register_Pkg_Actuals,
Make_String_Literal (Loc,
Strval => String_From_Name_Buffer));
Strval =>
Fully_Qualified_Name_String
(Defining_Entity (Pkg_Spec), Append_NUL => False)));
-- Receiver
@ -5591,7 +5590,7 @@ package body Exp_Dist is
-- Name
Make_String_Literal (Loc,
Fully_Qualified_Name_String (Desig)),
Fully_Qualified_Name_String (Desig, Append_NUL => False)),
-- Handler
@ -5938,7 +5937,8 @@ package body Exp_Dist is
New_Occurrence_Of (RACW_Parameter, Loc)),
Make_String_Literal (Loc,
Strval => Fully_Qualified_Name_String
(Etype (Designated_Type (RACW_Type)))),
(Etype (Designated_Type (RACW_Type)),
Append_NUL => False)),
Build_Stub_Tag (Loc, RACW_Type),
New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),
Make_Attribute_Reference (Loc,
@ -6134,7 +6134,8 @@ package body Exp_Dist is
Unchecked_Convert_To (RTE (RE_Address), Object),
Make_String_Literal (Loc,
Strval => Fully_Qualified_Name_String
(Etype (Designated_Type (RACW_Type)))),
(Etype (Designated_Type (RACW_Type)),
Append_NUL => False)),
Build_Stub_Tag (Loc, RACW_Type),
New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),
Make_Attribute_Reference (Loc,
@ -7069,13 +7070,13 @@ package body Exp_Dist is
Append_To (Decls, Pkg_RPC_Receiver_Object);
Analyze (Last (Decls));
Get_Library_Unit_Name_String (Pkg_Spec);
-- Name
Append_To (Register_Pkg_Actuals,
Make_String_Literal (Loc,
Strval => String_From_Name_Buffer));
Strval =>
Fully_Qualified_Name_String
(Defining_Entity (Pkg_Spec), Append_NUL => False)));
-- Version
@ -9210,20 +9211,12 @@ package body Exp_Dist is
Repo_Id_Str : out String_Id)
is
begin
Name_Str := Fully_Qualified_Name_String (E, Append_NUL => False);
Start_String;
Store_String_Chars ("DSA:");
Get_Library_Unit_Name_String (Scope (E));
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 (Name_Str);
Store_String_Chars (":1.0");
Repo_Id_Str := End_String;
Name_Str := String_From_Name_Buffer;
end Build_Name_And_Repository_Id;
-----------------------
@ -11134,11 +11127,11 @@ package body Exp_Dist is
Package_Spec : Node_Id) return Node_Id
is
Inst : Node_Id;
Pkg_Name : String_Id;
Pkg_Name : constant String_Id :=
Fully_Qualified_Name_String
(Defining_Entity (Package_Spec), Append_NUL => False);
begin
Get_Library_Unit_Name_String (Package_Spec);
Pkg_Name := String_From_Name_Buffer;
Inst :=
Make_Package_Instantiation (Loc,
Defining_Unit_Name => Make_Temporary (Loc, 'R'),

@ -2535,7 +2535,10 @@ package body Exp_Util is
-- 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);
-- Compute recursively the qualified name without NUL at the end, adding
-- it to the currently started string being generated
@ -2583,7 +2586,9 @@ package body Exp_Util is
begin
Start_String;
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;
end Fully_Qualified_Name_String;

@ -442,10 +442,12 @@ package Exp_Util is
-- Force_Evaluation further guarantees that all evaluations will yield
-- 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
-- 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);
-- If polling is active, then a call to the Poll routine is built,

@ -9365,10 +9365,10 @@ package body Sem_Prag is
-- dependency clause has operator "+".
procedure Check_Usage
(Subp_List : Elist_Id;
Item_List : Elist_Id;
Is_Input : Boolean);
-- Verify that all items from list Subp_List appear in Item_List.
(Subp_Items : Elist_Id;
Used_Items : Elist_Id;
Is_Input : Boolean);
-- Verify that all items from Subp_Items appear in Used_Items.
-- Emit an error if this is not the case.
procedure Collect_Subprogram_Inputs_Outputs;
@ -9765,7 +9765,10 @@ package body Sem_Prag is
if Ekind_In (Item_Id, E_Abstract_State, E_Variable) then
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
Error_Msg_NE
("item & must have mode in out", Item, Item_Id);
@ -9795,9 +9798,9 @@ package body Sem_Prag is
-----------------
procedure Check_Usage
(Subp_List : Elist_Id;
Item_List : Elist_Id;
Is_Input : Boolean)
(Subp_Items : Elist_Id;
Used_Items : Elist_Id;
Is_Input : Boolean)
is
procedure Usage_Error (Item : Node_Id; Item_Id : Entity_Id);
-- Emit an error concerning the erroneous usage of an item
@ -9828,14 +9831,14 @@ package body Sem_Prag is
-- Start of processing for Check_Usage
begin
if No (Subp_List) then
if No (Subp_Items) then
return;
end if;
-- Each input or output of the subprogram must appear in a
-- dependency relation.
Elmt := First_Elmt (Subp_List);
Elmt := First_Elmt (Subp_Items);
while Present (Elmt) loop
Item := Node (Elmt);
@ -9847,7 +9850,7 @@ package body Sem_Prag is
-- 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
Usage_Error (Item, Item_Id);

@ -441,7 +441,6 @@ procedure XOSCons is
Ada_Ofile, C_Ofile : Sfile;
Current_Line : in out Integer)
is
function Get_Value (Name : String) return Int_Value_Type;
-- Returns the value of the variable Name