This patch cleans up some uses of global variables in Sem_Prag.
No change in behavior; no test available.
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-25 Bob Duff <d...@adacore.com>
* sem_prag.adb: Remove suspicious uses of Name_Buf.
* stringt.ads, stringt.adb, exp_dbug.adb, sem_dim.adb: Remove
Add_String_To_Name_Buffer, to avoid using the global Name_Buf.
Add String_To_Name with no side effects.
Index: sem_dim.adb
===================================================================
--- sem_dim.adb (revision 247135)
+++ sem_dim.adb (working copy)
@@ -2521,8 +2521,9 @@
Add_Str_To_Name_Buffer ("has dimension ");
end if;
- Add_String_To_Name_Buffer
- (From_Dim_To_Str_Of_Dim_Symbols (Dims_Of_N, System, True));
+ Append
+ (Global_Name_Buffer,
+ From_Dim_To_Str_Of_Dim_Symbols (Dims_Of_N, System, True));
-- N is dimensionless
@@ -2562,12 +2563,12 @@
Name_Len := 0;
- Add_String_To_Name_Buffer (String_From_Numeric_Literal (N));
+ Append (Global_Name_Buffer, String_From_Numeric_Literal (N));
-- Insert a blank between the literal and the symbol
Add_Str_To_Name_Buffer (" ");
- Add_String_To_Name_Buffer (Symbol_Of (Typ));
+ Append (Global_Name_Buffer, Symbol_Of (Typ));
Error_Msg_Name_1 := Name_Find;
Error_Msg_N ("assumed to be%%??", N);
Index: stringt.adb
===================================================================
--- stringt.adb (revision 247135)
+++ stringt.adb (working copy)
@@ -75,15 +75,10 @@
-- Release to get a snapshot of the tables and to restore them to their
-- previous situation.
- -------------------------------
- -- Add_String_To_Name_Buffer --
- -------------------------------
+ ------------
+ -- Append --
+ ------------
- procedure Add_String_To_Name_Buffer (S : String_Id) is
- begin
- Append (Global_Name_Buffer, S);
- end Add_String_To_Name_Buffer;
-
procedure Append (Buf : in out Bounded_String; S : String_Id) is
begin
for X in 1 .. String_Length (S) loop
@@ -324,6 +319,17 @@
return Strings.Table (Id).Length;
end String_Length;
+ --------------------
+ -- String_To_Name --
+ --------------------
+
+ function String_To_Name (S : String_Id) return Name_Id is
+ Buf : Bounded_String;
+ begin
+ Append (Buf, S);
+ return Name_Find (Buf);
+ end String_To_Name;
+
---------------------------
-- String_To_Name_Buffer --
---------------------------
Index: stringt.ads
===================================================================
--- stringt.ads (revision 247135)
+++ stringt.ads (working copy)
@@ -47,9 +47,9 @@
-- is implemented in the scanner.
-- There is no guarantee that hashing is used in the implementation, although
--- it maybe. This means that the caller cannot count on having the same Id
+-- it may be. This means that the caller cannot count on having the same Id
-- value for two identical strings stored separately and also cannot count on
--- the two Id values being different.
+-- the two such Id values being different.
Null_String_Id : String_Id;
-- Gets set to a null string with length zero
@@ -119,18 +119,18 @@
function String_Equal (L, R : String_Id) return Boolean;
-- Determines if two string literals represent the same string
- procedure String_To_Name_Buffer (S : String_Id);
- -- Place characters of given string in Name_Buffer, setting Name_Len.
- -- Error if any characters are out of Character range. Does not attempt
- -- to do any encoding of any characters.
+ function String_To_Name (S : String_Id) return Name_Id;
+ -- Convert String_Id to Name_Id
procedure Append (Buf : in out Bounded_String; S : String_Id);
-- Append characters of given string to Buf. Error if any characters are
- -- out of Character range. Does not attempt to do any encoding of any
+ -- out of Character range. Does not attempt to do any encoding of
-- characters.
- procedure Add_String_To_Name_Buffer (S : String_Id);
- -- Same as Append (Global_Name_Buffer, S)
+ procedure String_To_Name_Buffer (S : String_Id);
+ -- Place characters of given string in Name_Buffer, setting Name_Len.
+ -- Error if any characters are out of Character range. Does not attempt
+ -- to do any encoding of any characters.
function String_Chars_Address return System.Address;
-- Return address of String_Chars table (used by Back_End call to Gigi)
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 247148)
+++ sem_prag.adb (working copy)
@@ -5941,9 +5941,7 @@
procedure Check_Optional_Identifier (Arg : Node_Id; Id : String) is
begin
- Name_Buffer (1 .. Id'Length) := Id;
- Name_Len := Id'Length;
- Check_Optional_Identifier (Arg, Name_Find);
+ Check_Optional_Identifier (Arg, Name_Find (Id));
end Check_Optional_Identifier;
-------------------------------------
@@ -8300,8 +8298,7 @@
Nam : Name_Id;
begin
- String_To_Name_Buffer (Strval (Expression (Arg3)));
- Nam := Name_Find;
+ Nam := String_To_Name (Strval (Expression (Arg3)));
Elmt := First_Elmt (Predefined_Float_Types);
while Present (Elmt) and then Chars (Node (Elmt)) /= Nam loop
@@ -9223,8 +9220,7 @@
begin
if Prag_Id = Pragma_Import then
- String_To_Name_Buffer (Strval (Expr_Value_S (Ext_Nam)));
- Nam := Name_Find;
+ Nam := String_To_Name (Strval (Expr_Value_S (Ext_Nam)));
E := Entity_Id (Get_Name_Table_Int (Nam));
if Nam /= Chars (Subprogram_Def)
@@ -10273,32 +10269,18 @@
-- No_Dependence => Ada.Execution_Time.Group_Budget
-- No_Dependence => Ada.Execution_Time.Timers
- -- ??? The use of Name_Buffer here is suspicious. The names should
- -- be registered in snames.ads-tmpl and used to build the qualified
- -- names of units.
-
if Ada_Version >= Ada_2005 then
- Name_Buffer (1 .. 3) := "ada";
- Name_Len := 3;
+ Pref_Id := Make_Identifier (Loc, Name_Find ("ada"));
+ Sel_Id := Make_Identifier (Loc, Name_Find ("execution_time"));
- Pref_Id := Make_Identifier (Loc, Name_Find);
-
- Name_Buffer (1 .. 14) := "execution_time";
- Name_Len := 14;
-
- Sel_Id := Make_Identifier (Loc, Name_Find);
-
Pref :=
Make_Selected_Component
(Sloc => Loc,
Prefix => Pref_Id,
Selector_Name => Sel_Id);
- Name_Buffer (1 .. 13) := "group_budgets";
- Name_Len := 13;
+ Sel_Id := Make_Identifier (Loc, Name_Find ("group_budgets"));
- Sel_Id := Make_Identifier (Loc, Name_Find);
-
Nod :=
Make_Selected_Component
(Sloc => Loc,
@@ -10310,11 +10292,8 @@
Warn => Treat_Restrictions_As_Warnings,
Profile => Ravenscar);
- Name_Buffer (1 .. 6) := "timers";
- Name_Len := 6;
+ Sel_Id := Make_Identifier (Loc, Name_Find ("timers"));
- Sel_Id := Make_Identifier (Loc, Name_Find);
-
Nod :=
Make_Selected_Component
(Sloc => Loc,
@@ -10332,27 +10311,17 @@
-- No_Dependence => System.Multiprocessors.Dispatching_Domains
if Ada_Version >= Ada_2012 then
- Name_Buffer (1 .. 6) := "system";
- Name_Len := 6;
+ Pref_Id := Make_Identifier (Loc, Name_Find ("system"));
+ Sel_Id := Make_Identifier (Loc, Name_Find ("multiprocessors"));
- Pref_Id := Make_Identifier (Loc, Name_Find);
-
- Name_Buffer (1 .. 15) := "multiprocessors";
- Name_Len := 15;
-
- Sel_Id := Make_Identifier (Loc, Name_Find);
-
Pref :=
Make_Selected_Component
(Sloc => Loc,
Prefix => Pref_Id,
Selector_Name => Sel_Id);
- Name_Buffer (1 .. 19) := "dispatching_domains";
- Name_Len := 19;
+ Sel_Id := Make_Identifier (Loc, Name_Find ("dispatching_domains"));
- Sel_Id := Make_Identifier (Loc, Name_Find);
-
Nod :=
Make_Selected_Component
(Sloc => Loc,
Index: exp_dbug.adb
===================================================================
--- exp_dbug.adb (revision 247135)
+++ exp_dbug.adb (working copy)
@@ -800,7 +800,7 @@
and then No (Address_Clause (E))
and then not Has_Suffix
then
- Add_String_To_Name_Buffer (Strval (Interface_Name (E)));
+ Append (Global_Name_Buffer, Strval (Interface_Name (E)));
-- All other cases besides the interface name case
