aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/namet.adb
diff options
context:
space:
mode:
authorPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2017-11-09 11:24:53 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2017-11-09 11:24:53 +0000
commitc312b9f280e4bf77c5b2869a9508ea3e8a6c5744 (patch)
treefa6e4b6952c72e3548456b6e8cdb7e351e7731e5 /gcc/ada/namet.adb
parentc23f55b4932192981183ab6a3f914ef22476ec93 (diff)
downloadgcc-c312b9f280e4bf77c5b2869a9508ea3e8a6c5744.zip
gcc-c312b9f280e4bf77c5b2869a9508ea3e8a6c5744.tar.gz
gcc-c312b9f280e4bf77c5b2869a9508ea3e8a6c5744.tar.bz2
[multiple changes]
2017-11-09 Piotr Trojanek <trojanek@adacore.com> * sem_prag.adb (Analyze_Part_Of): Reword error message. (Get_SPARK_Mode_Type): Do not raise Program_Error in case pragma SPARK_Mode appears with an illegal mode, treat this as a non-existent mode. 2017-11-09 Ed Schonberg <schonberg@adacore.com> * sem_ch4.adb (Analyze_Call): Reject a call to a function that returns a limited view of a type T declared in unit U1, when the function is declared in another unit U2 and the call appears in a procedure within another unit. 2017-11-09 Justin Squirek <squirek@adacore.com> * sem_ch8.adb (Analyze_Use_Package): Force installation of use_clauses when processing generic instances. 2017-11-09 Bob Duff <duff@adacore.com> * namet.ads, namet.adb (Valid_Name_Id): New subtype that excludes Error_Name and No_Name. Use this (versus Name_Id) to indicate which objects can have those special values. Valid_Name_Id could usefully be used all over the compiler front end, but that's too much trouble for now. If we did that, we might want to rename: Name_Id --> Optional_Name_Id, Valid_Name_Id --> Name_Id. For parameters of type Valid_Name_Id, remove some redundant tests, including the ones found by CodePeer. Use Is_Valid_Name instead of membership test when appropriate. (Error_Name_Or_No_Name): Delete this; it's no longer needed. * sem_ch2.adb (Analyze_Identifier): Use "not Is_Valid_Name" instead of "in Error_Name_Or_No_Name". (Check_Parameterless_Call): Use "not Is_Valid_Name" instead of "in Error_Name_Or_No_Name". From-SVN: r254569
Diffstat (limited to 'gcc/ada/namet.adb')
-rw-r--r--gcc/ada/namet.adb133
1 files changed, 65 insertions, 68 deletions
diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb
index 2dcbe1a..ddb5482 100644
--- a/gcc/ada/namet.adb
+++ b/gcc/ada/namet.adb
@@ -159,8 +159,8 @@ package body Namet is
Append (Buf, Buf2.Chars (1 .. Buf2.Length));
end Append;
- procedure Append (Buf : in out Bounded_String; Id : Name_Id) is
- pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
+ procedure Append (Buf : in out Bounded_String; Id : Valid_Name_Id) is
+ pragma Assert (Is_Valid_Name (Id));
Index : constant Int := Name_Entries.Table (Id).Name_Chars_Index;
Len : constant Short := Name_Entries.Table (Id).Name_Len;
@@ -174,7 +174,9 @@ package body Namet is
-- Append_Decoded --
--------------------
- procedure Append_Decoded (Buf : in out Bounded_String; Id : Name_Id) is
+ procedure Append_Decoded
+ (Buf : in out Bounded_String; Id : Valid_Name_Id)
+ is
C : Character;
P : Natural;
Temp : Bounded_String;
@@ -449,7 +451,7 @@ package body Namet is
procedure Append_Decoded_With_Brackets
(Buf : in out Bounded_String;
- Id : Name_Id)
+ Id : Valid_Name_Id)
is
P : Natural;
@@ -596,7 +598,9 @@ package body Namet is
-- Append_Unqualified --
------------------------
- procedure Append_Unqualified (Buf : in out Bounded_String; Id : Name_Id) is
+ procedure Append_Unqualified
+ (Buf : in out Bounded_String; Id : Valid_Name_Id)
+ is
Temp : Bounded_String;
begin
Append (Temp, Id);
@@ -610,7 +614,7 @@ package body Namet is
procedure Append_Unqualified_Decoded
(Buf : in out Bounded_String;
- Id : Name_Id)
+ Id : Valid_Name_Id)
is
Temp : Bounded_String;
begin
@@ -773,7 +777,7 @@ package body Namet is
-- Get_Decoded_Name_String --
-----------------------------
- procedure Get_Decoded_Name_String (Id : Name_Id) is
+ procedure Get_Decoded_Name_String (Id : Valid_Name_Id) is
begin
Global_Name_Buffer.Length := 0;
Append_Decoded (Global_Name_Buffer, Id);
@@ -783,7 +787,7 @@ package body Namet is
-- Get_Decoded_Name_String_With_Brackets --
-------------------------------------------
- procedure Get_Decoded_Name_String_With_Brackets (Id : Name_Id) is
+ procedure Get_Decoded_Name_String_With_Brackets (Id : Valid_Name_Id) is
begin
Global_Name_Buffer.Length := 0;
Append_Decoded_With_Brackets (Global_Name_Buffer, Id);
@@ -794,7 +798,7 @@ package body Namet is
------------------------
procedure Get_Last_Two_Chars
- (N : Name_Id;
+ (N : Valid_Name_Id;
C1 : out Character;
C2 : out Character)
is
@@ -815,13 +819,13 @@ package body Namet is
-- Get_Name_String --
---------------------
- procedure Get_Name_String (Id : Name_Id) is
+ procedure Get_Name_String (Id : Valid_Name_Id) is
begin
Global_Name_Buffer.Length := 0;
Append (Global_Name_Buffer, Id);
end Get_Name_String;
- function Get_Name_String (Id : Name_Id) return String is
+ function Get_Name_String (Id : Valid_Name_Id) return String is
Buf : Bounded_String (Max_Length => Natural (Length_Of_Name (Id)));
begin
Append (Buf, Id);
@@ -832,7 +836,7 @@ package body Namet is
-- Get_Name_String_And_Append --
--------------------------------
- procedure Get_Name_String_And_Append (Id : Name_Id) is
+ procedure Get_Name_String_And_Append (Id : Valid_Name_Id) is
begin
Append (Global_Name_Buffer, Id);
end Get_Name_String_And_Append;
@@ -841,9 +845,9 @@ package body Namet is
-- Get_Name_Table_Boolean1 --
-----------------------------
- function Get_Name_Table_Boolean1 (Id : Name_Id) return Boolean is
+ function Get_Name_Table_Boolean1 (Id : Valid_Name_Id) return Boolean is
begin
- pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
+ pragma Assert (Is_Valid_Name (Id));
return Name_Entries.Table (Id).Boolean1_Info;
end Get_Name_Table_Boolean1;
@@ -851,9 +855,9 @@ package body Namet is
-- Get_Name_Table_Boolean2 --
-----------------------------
- function Get_Name_Table_Boolean2 (Id : Name_Id) return Boolean is
+ function Get_Name_Table_Boolean2 (Id : Valid_Name_Id) return Boolean is
begin
- pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
+ pragma Assert (Is_Valid_Name (Id));
return Name_Entries.Table (Id).Boolean2_Info;
end Get_Name_Table_Boolean2;
@@ -861,9 +865,9 @@ package body Namet is
-- Get_Name_Table_Boolean3 --
-----------------------------
- function Get_Name_Table_Boolean3 (Id : Name_Id) return Boolean is
+ function Get_Name_Table_Boolean3 (Id : Valid_Name_Id) return Boolean is
begin
- pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
+ pragma Assert (Is_Valid_Name (Id));
return Name_Entries.Table (Id).Boolean3_Info;
end Get_Name_Table_Boolean3;
@@ -871,9 +875,9 @@ package body Namet is
-- Get_Name_Table_Byte --
-------------------------
- function Get_Name_Table_Byte (Id : Name_Id) return Byte is
+ function Get_Name_Table_Byte (Id : Valid_Name_Id) return Byte is
begin
- pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
+ pragma Assert (Is_Valid_Name (Id));
return Name_Entries.Table (Id).Byte_Info;
end Get_Name_Table_Byte;
@@ -881,9 +885,9 @@ package body Namet is
-- Get_Name_Table_Int --
-------------------------
- function Get_Name_Table_Int (Id : Name_Id) return Int is
+ function Get_Name_Table_Int (Id : Valid_Name_Id) return Int is
begin
- pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
+ pragma Assert (Is_Valid_Name (Id));
return Name_Entries.Table (Id).Int_Info;
end Get_Name_Table_Int;
@@ -891,7 +895,7 @@ package body Namet is
-- Get_Unqualified_Decoded_Name_String --
-----------------------------------------
- procedure Get_Unqualified_Decoded_Name_String (Id : Name_Id) is
+ procedure Get_Unqualified_Decoded_Name_String (Id : Valid_Name_Id) is
begin
Global_Name_Buffer.Length := 0;
Append_Unqualified_Decoded (Global_Name_Buffer, Id);
@@ -901,7 +905,7 @@ package body Namet is
-- Get_Unqualified_Name_String --
---------------------------------
- procedure Get_Unqualified_Name_String (Id : Name_Id) is
+ procedure Get_Unqualified_Name_String (Id : Valid_Name_Id) is
begin
Global_Name_Buffer.Length := 0;
Append_Unqualified (Global_Name_Buffer, Id);
@@ -1032,15 +1036,11 @@ package body Namet is
return False;
end Is_Internal_Name;
- function Is_Internal_Name (Id : Name_Id) return Boolean is
+ function Is_Internal_Name (Id : Valid_Name_Id) return Boolean is
Buf : Bounded_String (Max_Length => Natural (Length_Of_Name (Id)));
begin
- if Id in Error_Name_Or_No_Name then
- return False;
- else
- Append (Buf, Id);
- return Is_Internal_Name (Buf);
- end if;
+ Append (Buf, Id);
+ return Is_Internal_Name (Buf);
end Is_Internal_Name;
function Is_Internal_Name return Boolean is
@@ -1066,10 +1066,10 @@ package body Namet is
-- Is_Operator_Name --
----------------------
- function Is_Operator_Name (Id : Name_Id) return Boolean is
+ function Is_Operator_Name (Id : Valid_Name_Id) return Boolean is
S : Int;
begin
- pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
+ pragma Assert (Is_Valid_Name (Id));
S := Name_Entries.Table (Id).Name_Chars_Index;
return Name_Chars.Table (S + 1) = 'O';
end Is_Operator_Name;
@@ -1087,7 +1087,7 @@ package body Namet is
-- Length_Of_Name --
--------------------
- function Length_Of_Name (Id : Name_Id) return Nat is
+ function Length_Of_Name (Id : Valid_Name_Id) return Nat is
begin
return Int (Name_Entries.Table (Id).Name_Len);
end Length_Of_Name;
@@ -1111,7 +1111,7 @@ package body Namet is
----------------
function Name_Enter
- (Buf : Bounded_String := Global_Name_Buffer) return Name_Id
+ (Buf : Bounded_String := Global_Name_Buffer) return Valid_Name_Id
is
begin
Name_Entries.Append
@@ -1136,7 +1136,7 @@ package body Namet is
return Name_Entries.Last;
end Name_Enter;
- function Name_Enter (S : String) return Name_Id is
+ function Name_Enter (S : String) return Valid_Name_Id is
Buf : Bounded_String (Max_Length => S'Length);
begin
Append (Buf, S);
@@ -1157,7 +1157,7 @@ package body Namet is
---------------
function Name_Find
- (Buf : Bounded_String := Global_Name_Buffer) return Name_Id
+ (Buf : Bounded_String := Global_Name_Buffer) return Valid_Name_Id
is
New_Id : Name_Id;
-- Id of entry in hash search, and value to be returned
@@ -1172,7 +1172,7 @@ package body Namet is
-- Quick handling for one character names
if Buf.Length = 1 then
- return Name_Id (First_Name_Id + Character'Pos (Buf.Chars (1)));
+ return Valid_Name_Id (First_Name_Id + Character'Pos (Buf.Chars (1)));
-- Otherwise search hash table for existing matching entry
@@ -1241,7 +1241,7 @@ package body Namet is
end if;
end Name_Find;
- function Name_Find (S : String) return Name_Id is
+ function Name_Find (S : String) return Valid_Name_Id is
Buf : Bounded_String (Max_Length => S'Length);
begin
Append (Buf, S);
@@ -1476,7 +1476,7 @@ package body Namet is
-- Name_Equals --
-----------------
- function Name_Equals (N1 : Name_Id; N2 : Name_Id) return Boolean is
+ function Name_Equals (N1, N2 : Valid_Name_Id) return Boolean is
begin
return N1 = N2 or else Get_Name_String (N1) = Get_Name_String (N2);
end Name_Equals;
@@ -1550,9 +1550,9 @@ package body Namet is
-- Set_Name_Table_Boolean1 --
-----------------------------
- procedure Set_Name_Table_Boolean1 (Id : Name_Id; Val : Boolean) is
+ procedure Set_Name_Table_Boolean1 (Id : Valid_Name_Id; Val : Boolean) is
begin
- pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
+ pragma Assert (Is_Valid_Name (Id));
Name_Entries.Table (Id).Boolean1_Info := Val;
end Set_Name_Table_Boolean1;
@@ -1560,9 +1560,9 @@ package body Namet is
-- Set_Name_Table_Boolean2 --
-----------------------------
- procedure Set_Name_Table_Boolean2 (Id : Name_Id; Val : Boolean) is
+ procedure Set_Name_Table_Boolean2 (Id : Valid_Name_Id; Val : Boolean) is
begin
- pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
+ pragma Assert (Is_Valid_Name (Id));
Name_Entries.Table (Id).Boolean2_Info := Val;
end Set_Name_Table_Boolean2;
@@ -1570,9 +1570,9 @@ package body Namet is
-- Set_Name_Table_Boolean3 --
-----------------------------
- procedure Set_Name_Table_Boolean3 (Id : Name_Id; Val : Boolean) is
+ procedure Set_Name_Table_Boolean3 (Id : Valid_Name_Id; Val : Boolean) is
begin
- pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
+ pragma Assert (Is_Valid_Name (Id));
Name_Entries.Table (Id).Boolean3_Info := Val;
end Set_Name_Table_Boolean3;
@@ -1580,9 +1580,9 @@ package body Namet is
-- Set_Name_Table_Byte --
-------------------------
- procedure Set_Name_Table_Byte (Id : Name_Id; Val : Byte) is
+ procedure Set_Name_Table_Byte (Id : Valid_Name_Id; Val : Byte) is
begin
- pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
+ pragma Assert (Is_Valid_Name (Id));
Name_Entries.Table (Id).Byte_Info := Val;
end Set_Name_Table_Byte;
@@ -1590,9 +1590,9 @@ package body Namet is
-- Set_Name_Table_Int --
-------------------------
- procedure Set_Name_Table_Int (Id : Name_Id; Val : Int) is
+ procedure Set_Name_Table_Int (Id : Valid_Name_Id; Val : Int) is
begin
- pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
+ pragma Assert (Is_Valid_Name (Id));
Name_Entries.Table (Id).Int_Info := Val;
end Set_Name_Table_Int;
@@ -1734,8 +1734,13 @@ package body Namet is
procedure wn (Id : Name_Id) is
begin
- if Id not in Name_Entries.First .. Name_Entries.Last then
- Write_Str ("<invalid name_id>");
+ if Is_Valid_Name (Id) then
+ declare
+ Buf : Bounded_String (Max_Length => Natural (Length_Of_Name (Id)));
+ begin
+ Append (Buf, Id);
+ Write_Str (Buf.Chars (1 .. Buf.Length));
+ end;
elsif Id = No_Name then
Write_Str ("<No_Name>");
@@ -1744,12 +1749,8 @@ package body Namet is
Write_Str ("<Error_Name>");
else
- declare
- Buf : Bounded_String (Max_Length => Natural (Length_Of_Name (Id)));
- begin
- Append (Buf, Id);
- Write_Str (Buf.Chars (1 .. Buf.Length));
- end;
+ Write_Str ("<invalid name_id>");
+ Write_Int (Int (Id));
end if;
Write_Eol;
@@ -1759,26 +1760,22 @@ package body Namet is
-- Write_Name --
----------------
- procedure Write_Name (Id : Name_Id) is
+ procedure Write_Name (Id : Valid_Name_Id) is
Buf : Bounded_String (Max_Length => Natural (Length_Of_Name (Id)));
begin
- if Id >= First_Name_Id then
- Append (Buf, Id);
- Write_Str (Buf.Chars (1 .. Buf.Length));
- end if;
+ Append (Buf, Id);
+ Write_Str (Buf.Chars (1 .. Buf.Length));
end Write_Name;
------------------------
-- Write_Name_Decoded --
------------------------
- procedure Write_Name_Decoded (Id : Name_Id) is
+ procedure Write_Name_Decoded (Id : Valid_Name_Id) is
Buf : Bounded_String;
begin
- if Id >= First_Name_Id then
- Append_Decoded (Buf, Id);
- Write_Str (Buf.Chars (1 .. Buf.Length));
- end if;
+ Append_Decoded (Buf, Id);
+ Write_Str (Buf.Chars (1 .. Buf.Length));
end Write_Name_Decoded;
-- Package initialization, initialize tables