aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2013-04-23 11:48:55 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2013-04-23 11:48:55 +0200
commit72267417bd5d1072812339dee3bf426b686f81b6 (patch)
tree3f9d224166c814f6fb0ac816eb4db4091da87f3d /gcc/ada
parent2fabf41e29b234852ef2d099977c27af9a24ec3f (diff)
downloadgcc-72267417bd5d1072812339dee3bf426b686f81b6.zip
gcc-72267417bd5d1072812339dee3bf426b686f81b6.tar.gz
gcc-72267417bd5d1072812339dee3bf426b686f81b6.tar.bz2
[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
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog19
-rw-r--r--gcc/ada/exp_dist.adb49
-rw-r--r--gcc/ada/exp_util.adb9
-rw-r--r--gcc/ada/exp_util.ads6
-rw-r--r--gcc/ada/sem_prag.adb25
-rw-r--r--gcc/ada/xoscons.adb1
6 files changed, 65 insertions, 44 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3c09dd0..c6d114d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,24 @@
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
reformatting.
diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index d7055f2..3643303 100644
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -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'),
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index d5f5f0e..c38b023 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -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;
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 39d1c0b..f83aebe 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -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,
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 8d6a38e..373828e 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -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);
diff --git a/gcc/ada/xoscons.adb b/gcc/ada/xoscons.adb
index 2aafe08..095101f5 100644
--- a/gcc/ada/xoscons.adb
+++ b/gcc/ada/xoscons.adb
@@ -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