aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/uname.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/uname.adb')
-rw-r--r--gcc/ada/uname.adb154
1 files changed, 73 insertions, 81 deletions
diff --git a/gcc/ada/uname.adb b/gcc/ada/uname.adb
index a9b9947..18cb6d1 100644
--- a/gcc/ada/uname.adb
+++ b/gcc/ada/uname.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2021, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -23,15 +23,18 @@
-- --
------------------------------------------------------------------------------
-with Atree; use Atree;
-with Casing; use Casing;
-with Einfo; use Einfo;
+with Atree; use Atree;
+with Casing; use Casing;
+with Einfo; use Einfo;
+with Einfo.Utils; use Einfo.Utils;
with Hostparm;
-with Lib; use Lib;
-with Nlists; use Nlists;
-with Output; use Output;
-with Sinfo; use Sinfo;
-with Sinput; use Sinput;
+with Lib; use Lib;
+with Nlists; use Nlists;
+with Output; use Output;
+with Sinfo; use Sinfo;
+with Sinfo.Nodes; use Sinfo.Nodes;
+with Sinfo.Utils; use Sinfo.Utils;
+with Sinput; use Sinput;
package body Uname is
@@ -44,15 +47,18 @@ package body Uname is
-------------------
function Get_Body_Name (N : Unit_Name_Type) return Unit_Name_Type is
+ Buffer : Bounded_String;
begin
- Get_Name_String (N);
+ Append (Buffer, N);
+
+ pragma Assert
+ (Buffer.Length > 2
+ and then Buffer.Chars (Buffer.Length - 1) = '%'
+ and then Buffer.Chars (Buffer.Length) = 's');
- pragma Assert (Name_Len > 2
- and then Name_Buffer (Name_Len - 1) = '%'
- and then Name_Buffer (Name_Len) = 's');
+ Buffer.Chars (Buffer.Length) := 'b';
- Name_Buffer (Name_Len) := 'b';
- return Name_Find;
+ return Name_Find (Buffer);
end Get_Body_Name;
-----------------------------------
@@ -108,19 +114,19 @@ package body Uname is
--------------------------
function Get_Parent_Body_Name (N : Unit_Name_Type) return Unit_Name_Type is
+ Buffer : Bounded_String;
begin
- Get_Name_String (N);
+ Append (Buffer, N);
- while Name_Buffer (Name_Len) /= '.' loop
- pragma Assert (Name_Len > 1); -- not a child or subunit name
- Name_Len := Name_Len - 1;
+ while Buffer.Chars (Buffer.Length) /= '.' loop
+ pragma Assert (Buffer.Length > 1); -- not a child or subunit name
+ Buffer.Length := Buffer.Length - 1;
end loop;
- Name_Buffer (Name_Len) := '%';
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := 'b';
- return Name_Find;
+ Buffer.Chars (Buffer.Length) := '%';
+ Append (Buffer, 'b');
+ return Name_Find (Buffer);
end Get_Parent_Body_Name;
--------------------------
@@ -128,22 +134,22 @@ package body Uname is
--------------------------
function Get_Parent_Spec_Name (N : Unit_Name_Type) return Unit_Name_Type is
+ Buffer : Bounded_String;
begin
- Get_Name_String (N);
+ Append (Buffer, N);
- while Name_Buffer (Name_Len) /= '.' loop
- if Name_Len = 1 then
+ while Buffer.Chars (Buffer.Length) /= '.' loop
+ if Buffer.Length = 1 then
return No_Unit_Name;
else
- Name_Len := Name_Len - 1;
+ Buffer.Length := Buffer.Length - 1;
end if;
end loop;
- Name_Buffer (Name_Len) := '%';
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := 's';
- return Name_Find;
+ Buffer.Chars (Buffer.Length) := '%';
+ Append (Buffer, 's');
+ return Name_Find (Buffer);
end Get_Parent_Spec_Name;
-------------------
@@ -151,15 +157,18 @@ package body Uname is
-------------------
function Get_Spec_Name (N : Unit_Name_Type) return Unit_Name_Type is
+ Buffer : Bounded_String;
begin
- Get_Name_String (N);
+ Append (Buffer, N);
+
+ pragma Assert
+ (Buffer.Length > 2
+ and then Buffer.Chars (Buffer.Length - 1) = '%'
+ and then Buffer.Chars (Buffer.Length) = 'b');
- pragma Assert (Name_Len > 2
- and then Name_Buffer (Name_Len - 1) = '%'
- and then Name_Buffer (Name_Len) = 'b');
+ Buffer.Chars (Buffer.Length) := 's';
- Name_Buffer (Name_Len) := 's';
- return Name_Find;
+ return Name_Find (Buffer);
end Get_Spec_Name;
-------------------
@@ -168,13 +177,8 @@ package body Uname is
function Get_Unit_Name (N : Node_Id) return Unit_Name_Type is
- Unit_Name_Buffer : String (1 .. Hostparm.Max_Name_Length);
- -- Buffer used to build name of unit. Note that we cannot use the
- -- Name_Buffer in package Name_Table because we use it to read
- -- component names.
-
- Unit_Name_Length : Natural := 0;
- -- Length of name stored in Unit_Name_Buffer
+ Unit_Name_Buffer : Bounded_String;
+ -- Buffer used to build name of unit
Node : Node_Id;
-- Program unit node
@@ -197,9 +201,7 @@ package body Uname is
procedure Add_Char (C : Character) is
begin
- -- Should really check for max length exceeded here???
- Unit_Name_Length := Unit_Name_Length + 1;
- Unit_Name_Buffer (Unit_Name_Length) := C;
+ Append (Unit_Name_Buffer, C);
end Add_Char;
--------------
@@ -208,11 +210,7 @@ package body Uname is
procedure Add_Name (Name : Name_Id) is
begin
- Get_Name_String (Name);
-
- for J in 1 .. Name_Len loop
- Add_Char (Name_Buffer (J));
- end loop;
+ Append (Unit_Name_Buffer, Name);
end Add_Name;
-------------------
@@ -220,8 +218,6 @@ package body Uname is
-------------------
procedure Add_Node_Name (Node : Node_Id) is
- Kind : constant Node_Kind := Nkind (Node);
-
begin
-- Just ignore an error node (someone else will give a message)
@@ -231,7 +227,7 @@ package body Uname is
-- Otherwise see what kind of node we have
else
- case Kind is
+ case Nkind (Node) is
when N_Defining_Identifier
| N_Defining_Operator_Symbol
| N_Identifier
@@ -364,8 +360,8 @@ package body Uname is
Node := Declaration_Node (Entity (Node));
end if;
- if Nkind (Node) = N_Package_Specification
- or else Nkind (Node) in N_Subprogram_Specification
+ if Nkind (Node) in N_Package_Specification
+ | N_Subprogram_Specification
then
Node := Parent (Node);
end if;
@@ -407,11 +403,7 @@ package body Uname is
raise Program_Error;
end case;
- Name_Buffer (1 .. Unit_Name_Length) :=
- Unit_Name_Buffer (1 .. Unit_Name_Length);
- Name_Len := Unit_Name_Length;
- return Name_Find;
-
+ return Name_Find (Unit_Name_Buffer);
end Get_Unit_Name;
--------------------------
@@ -488,11 +480,12 @@ package body Uname is
------------------
function Is_Body_Name (N : Unit_Name_Type) return Boolean is
+ Buffer : Bounded_String;
begin
- Get_Name_String (N);
- return Name_Len > 2
- and then Name_Buffer (Name_Len - 1) = '%'
- and then Name_Buffer (Name_Len) = 'b';
+ Append (Buffer, N);
+ return Buffer.Length > 2
+ and then Buffer.Chars (Buffer.Length - 1) = '%'
+ and then Buffer.Chars (Buffer.Length) = 'b';
end Is_Body_Name;
-------------------
@@ -500,17 +493,16 @@ package body Uname is
-------------------
function Is_Child_Name (N : Unit_Name_Type) return Boolean is
- J : Natural;
+ Buffer : Bounded_String;
begin
- Get_Name_String (N);
- J := Name_Len;
+ Append (Buffer, N);
- while Name_Buffer (J) /= '.' loop
- if J = 1 then
+ while Buffer.Chars (Buffer.Length) /= '.' loop
+ if Buffer.Length = 1 then
return False; -- not a child or subunit name
else
- J := J - 1;
+ Buffer.Length := Buffer.Length - 1;
end if;
end loop;
@@ -588,11 +580,12 @@ package body Uname is
------------------
function Is_Spec_Name (N : Unit_Name_Type) return Boolean is
+ Buffer : Bounded_String;
begin
- Get_Name_String (N);
- return Name_Len > 2
- and then Name_Buffer (Name_Len - 1) = '%'
- and then Name_Buffer (Name_Len) = 's';
+ Append (Buffer, N);
+ return Buffer.Length > 2
+ and then Buffer.Chars (Buffer.Length - 1) = '%'
+ and then Buffer.Chars (Buffer.Length) = 's';
end Is_Spec_Name;
-----------------------
@@ -600,12 +593,11 @@ package body Uname is
-----------------------
function Name_To_Unit_Name (N : Name_Id) return Unit_Name_Type is
+ Buffer : Bounded_String;
begin
- Get_Name_String (N);
- Name_Buffer (Name_Len + 1) := '%';
- Name_Buffer (Name_Len + 2) := 's';
- Name_Len := Name_Len + 2;
- return Name_Find;
+ Append (Buffer, N);
+ Append (Buffer, "%s");
+ return Name_Find (Buffer);
end Name_To_Unit_Name;
---------------
generated by cgit v1.1 at 2025-05-06 16:14:28 +0000