diff options
author | Ronan Desplanques <desplanques@adacore.com> | 2024-11-12 16:09:13 +0100 |
---|---|---|
committer | Marc Poulhiès <dkm@gcc.gnu.org> | 2024-11-26 10:49:34 +0100 |
commit | bd0b9886f17d9dc13de8f533f1239016d1198ea8 (patch) | |
tree | ee6f455d8c0ddf4d2aca0ca60cf2492425afe214 /gcc | |
parent | 222da6bd24838c700ef72648da2956bade588b47 (diff) | |
download | gcc-bd0b9886f17d9dc13de8f533f1239016d1198ea8.zip gcc-bd0b9886f17d9dc13de8f533f1239016d1198ea8.tar.gz gcc-bd0b9886f17d9dc13de8f533f1239016d1198ea8.tar.bz2 |
ada: Change specifications of Uname subprograms
The old specifications were ambiguous as to whether they expected
actuals to have %s/%b suffixes. The new specifications also increases
modularity across the board.
gcc/ada/ChangeLog:
* uname.ads (Is_Internal_Unit_Name, Is_Predefined_Unit_Name): Change
specifications to take a Unit_Name_Type as input.
(Encoded_Library_Unit_Name): New subprogram.
(Is_Predefined_Unit_Name): New overloaded subprogram.
(Get_External_Unit_Name_String): Make use of new
Encoded_Library_Unit_Name subprogram.
* uname.adb (Is_Internal_Unit_Name, Is_Predefined_Unit_Name): Adapt
bodies to specification changes.
* fname-uf.adb (Get_File_Name): Adapt to Uname interface changes.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/fname-uf.adb | 2 | ||||
-rw-r--r-- | gcc/ada/uname.adb | 67 | ||||
-rw-r--r-- | gcc/ada/uname.ads | 8 |
3 files changed, 52 insertions, 25 deletions
diff --git a/gcc/ada/fname-uf.adb b/gcc/ada/fname-uf.adb index 4afb3b0..3f65957 100644 --- a/gcc/ada/fname-uf.adb +++ b/gcc/ada/fname-uf.adb @@ -324,7 +324,7 @@ package body Fname.UF is declare Is_Predef : constant Boolean := Is_Predefined_Unit_Name - (+Unit_Buf, Renamings_Included => True); + (Uname, Renamings_Included => True); Buf : Bounded_String; begin diff --git a/gcc/ada/uname.adb b/gcc/ada/uname.adb index 5a7dac5..598b554 100644 --- a/gcc/ada/uname.adb +++ b/gcc/ada/uname.adb @@ -42,6 +42,15 @@ package body Uname is -- True if Prefix is at the beginning of X. For example, -- Has_Prefix("a-filename.ads", Prefix => "a-") is True. + function Encoded_Library_Unit_Name (N : Unit_Name_Type) return String; + -- Returns the name of the library unit N as a string without a %s or %b + -- suffix. + + function Is_Predefined_Unit_Name + (Name : String; Renamings_Included : Boolean := True) return Boolean; + -- Same as Fname.Is_Predefined_File_Name, except it works with the name of + -- the unit, rather than the file name. + ------------------- -- Get_Body_Name -- ------------------- @@ -55,6 +64,16 @@ package body Uname is return Name_Find (Buffer); end Get_Body_Name; + ------------------------------- + -- Encoded_Library_Unit_Name -- + ------------------------------- + + function Encoded_Library_Unit_Name (N : Unit_Name_Type) return String is + S : constant String := Get_Name_String (N); + begin + return S (S'First .. S'Last - 2); + end Encoded_Library_Unit_Name; + ----------------------------------- -- Get_External_Unit_Name_String -- ----------------------------------- @@ -64,10 +83,8 @@ package body Uname is Newlen : Natural; begin - -- Get unit name and eliminate trailing %s or %b - - Get_Name_String (N); - Name_Len := Name_Len - 2; + Name_Len := 0; + Add_Str_To_Name_Buffer (Encoded_Library_Unit_Name (N)); -- Find number of components @@ -489,21 +506,22 @@ package body Uname is --------------------------- function Is_Internal_Unit_Name - (Name : String; - Renamings_Included : Boolean := True) return Boolean + (Name : Unit_Name_Type; Renamings_Included : Boolean := True) + return Boolean is Gnat : constant String := "gnat"; + Lib_Unit_Name : constant String := Encoded_Library_Unit_Name (Name); begin - if Name = Gnat then + if Lib_Unit_Name = Gnat then return True; end if; - if Has_Prefix (Name, Prefix => Gnat & ".") then + if Has_Prefix (Lib_Unit_Name, Prefix => Gnat & ".") then return True; end if; - return Is_Predefined_Unit_Name (Name, Renamings_Included); + return Is_Predefined_Unit_Name (Lib_Unit_Name, Renamings_Included); end Is_Internal_Unit_Name; ----------------------------- @@ -511,13 +529,20 @@ package body Uname is ----------------------------- function Is_Predefined_Unit_Name - (Name : String; - Renamings_Included : Boolean := True) return Boolean + (Name : Unit_Name_Type; Renamings_Included : Boolean := True) + return Boolean is + begin + return + Is_Predefined_Unit_Name + (Encoded_Library_Unit_Name (Name), Renamings_Included); + end Is_Predefined_Unit_Name; + + function Is_Predefined_Unit_Name + (Name : String; Renamings_Included : Boolean := True) return Boolean is Ada : constant String := "ada"; Interfaces : constant String := "interfaces"; System : constant String := "system"; - begin if Name in Ada | Interfaces | System then return True; @@ -536,14 +561,16 @@ package body Uname is -- The following are the predefined renamings - return Name in "calendar" - | "machine_code" - | "unchecked_conversion" - | "unchecked_deallocation" - | "direct_io" - | "io_exceptions" - | "sequential_io" - | "text_io"; + return + Name in + "calendar" + | "machine_code" + | "unchecked_conversion" + | "unchecked_deallocation" + | "direct_io" + | "io_exceptions" + | "sequential_io" + | "text_io"; end Is_Predefined_Unit_Name; ------------------ diff --git a/gcc/ada/uname.ads b/gcc/ada/uname.ads index 57ff8a6..394472e 100644 --- a/gcc/ada/uname.ads +++ b/gcc/ada/uname.ads @@ -126,14 +126,14 @@ package Uname is -- body or a spec). function Is_Internal_Unit_Name - (Name : String; - Renamings_Included : Boolean := True) return Boolean; + (Name : Unit_Name_Type; Renamings_Included : Boolean := True) + return Boolean; -- Same as Fname.Is_Internal_File_Name, except it works with the name of -- the unit, rather than the file name. function Is_Predefined_Unit_Name - (Name : String; - Renamings_Included : Boolean := True) return Boolean; + (Name : Unit_Name_Type; Renamings_Included : Boolean := True) + return Boolean; -- Same as Fname.Is_Predefined_File_Name, except it works with the name of -- the unit, rather than the file name. |