diff options
author | Hristian Kirtchev <kirtchev@adacore.com> | 2019-07-03 08:16:29 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-03 08:16:29 +0000 |
commit | 76b4158b8fee22fd85d98e760cf4d12d7ae50051 (patch) | |
tree | 40ad2a358112f68898f4d5ef18d7e1cb961308f4 /gcc/ada/binde.adb | |
parent | 336878fc11b75f8ac962efd9150151b74685f7fb (diff) | |
download | gcc-76b4158b8fee22fd85d98e760cf4d12d7ae50051.zip gcc-76b4158b8fee22fd85d98e760cf4d12d7ae50051.tar.gz gcc-76b4158b8fee22fd85d98e760cf4d12d7ae50051.tar.bz2 |
[Ada] Forced elaboration order in Elaboration order v4.0
This patch refactors the forced elaboration order functionality,
reintegrates it in Binde, and impelements it in Bindo.
------------
-- Source --
------------
-- server.ads
package Server is
end Server;
-- client.ads
with Server;
package Client is
end Client;
-- main.adb
with Client;
procedure Main is begin null; end Main;
-- duplicate_1.txt
server (spec)
client (spec)
server (spec)
-- error_unit_1.txt
no such unit
client (spec)
-- error_unit_2.txt
no such unit
client (spec)
-- error_unit_3.txt
no such unit -- comment
client (spec)
-- error_unit_4.txt
no such unit -- comment
client (spec)
-- error_unit_5.txt
no such unit (body)
client (spec)
-- error_unit_6.txt
no such unit (body)
client (spec)
-- error_unit_7.txt
no such unit (body) -- comment
client (spec)
-- error_unit_8.txt
no such unit (body)-- comment
client (spec)
-- error_unit_9.txt
no such unit-- comment
client (spec)
-- no_unit_1.txt
-- no_unit_2.txt
-- no_unit_3.txt
-- comment
-- no_unit_4.txt
-- no_unit_5.txt
-- no_unit_6.txt
-- comment
-- no_unit_7.txt
-- no_unit_8.txt
-- comment
-- comment
-- ok_unit_1.txt
server (spec)
client (spec)
-- ok_unit_2.txt
server (spec)
client (spec)
-- ok_unit_3.txt
server (spec)
client (spec)
-- ok_unit_4.txt
server (spec) -- comment
client (spec)
-- ok_unit_5.txt
server (spec)
client (spec)
-- ok_unit_6.txt
server (spec)
client (spec) -- comment
-- ok_unit_7.txt
server (spec)
client (spec) -- comment
-- ok_unit_8.txt
-- comment
-- comment
server (spec)
-- comment
-- comment
client (spec) -- comment
-- ok_unit_9.txt
server (spec)-- comment
client (spec)
----------------------------
-- Compilation and output --
----------------------------
$ gnatmake -q main.adb
$ gnatbind -fno_unit_1.txt main.ali
$ gnatbind -fno_unit_2.txt main.ali
$ gnatbind -fno_unit_3.txt main.ali
$ gnatbind -fno_unit_4.txt main.ali
$ gnatbind -fno_unit_5.txt main.ali
$ gnatbind -fno_unit_6.txt main.ali
$ gnatbind -fno_unit_7.txt main.ali
$ gnatbind -fno_unit_8.txt main.ali
$ gnatbind -ferror_unit_1.txt main.ali
$ gnatbind -ferror_unit_2.txt main.ali
$ gnatbind -ferror_unit_3.txt main.ali
$ gnatbind -ferror_unit_4.txt main.ali
$ gnatbind -ferror_unit_5.txt main.ali
$ gnatbind -ferror_unit_6.txt main.ali
$ gnatbind -ferror_unit_7.txt main.ali
$ gnatbind -ferror_unit_8.txt main.ali
$ gnatbind -ferror_unit_9.txt main.ali
$ gnatbind -fduplicate_1.txt main.ali
$ gnatbind -fok_unit_1.txt main.ali
$ gnatbind -fok_unit_2.txt main.ali
$ gnatbind -fok_unit_3.txt main.ali
$ gnatbind -fok_unit_4.txt main.ali
$ gnatbind -fok_unit_5.txt main.ali
$ gnatbind -fok_unit_6.txt main.ali
$ gnatbind -fok_unit_7.txt main.ali
$ gnatbind -fok_unit_8.txt main.ali
$ gnatbind -fok_unit_9.txt main.ali
"no such unit": not present; ignored
"no such unit": not present; ignored
"no such unit": not present; ignored
"no such unit": not present; ignored
"no such unit%b": not present; ignored
"no such unit%b": not present; ignored
"no such unit%b": not present; ignored
"no such unit%b": not present; ignored
"no such unit": not present; ignored
server (spec) <-- client (spec)
error: duplicate_1.txt:3: duplicate unit name "server (spec)" from line 1
server (spec) <-- client (spec)
server (spec) <-- client (spec)
server (spec) <-- client (spec)
server (spec) <-- client (spec)
server (spec) <-- client (spec)
server (spec) <-- client (spec)
server (spec) <-- client (spec)
server (spec) <-- client (spec)
server (spec) <-- client (spec)
2019-07-03 Hristian Kirtchev <kirtchev@adacore.com>
gcc/ada/
* binde.adb: Remove with clause for System.OS_Lib.
(Force_Elab_Order): Refactor the majority of the code in Butil.
Use the new forced units iterator to obtain unit names.
* bindo-builders.adb: Add with and use clauses for Binderr,
Butil, Opt, Output, Types, GNAT, and GNAT.Dynamic_HTables. Add
a hash table which maps units to line number in the forced
elaboration order file.
(Add_Unit): New routine.
(Build_Library_Graph): Create forced edges between pairs of
units listed in the forced elaboration order file.
(Create_Forced_Edge, Create_Forced_Edges, Destroy_Line_Number,
Duplicate_Unit_Error, Hash_Unit, Internal_Unit_Info,
Is_Duplicate_Unit, Missing_Unit_Info): New routines.
* bindo-graphs.adb (Is_Internal_Unit, Is_Predefined_Unit):
Refactor some of the behavior to Bindo-Units.
* bindo-graphs.ads: Enable the enumeration literal for forced
edges.
* bindo-units.adb, bindo-units.ads (Is_Internal_Unit,
Is_Predefined_Unit): New routines.
* butil.adb: Add with and use clauses for Opt, GNAT, and
System.OS_Lib. Add with clause for Unchecked_Deallocation.
(Has_Next, Iterate_Forced_Units, Next, Parse_Next_Unit_Name,
Read_Forced_Elab_Order_File): New routines.
* butil.ads: Add with and use clauses for Types. Add new
iterator over the units listed in the forced elaboration order
file.
(Has_Next, Iterate_Forced_Units, Next): New routine.
* namet.adb, namet.ads (Present): New routine.
From-SVN: r272987
Diffstat (limited to 'gcc/ada/binde.adb')
-rw-r--r-- | gcc/ada/binde.adb | 292 |
1 files changed, 63 insertions, 229 deletions
diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb index d060fd8..5caee49 100644 --- a/gcc/ada/binde.adb +++ b/gcc/ada/binde.adb @@ -35,7 +35,6 @@ with Types; use Types; with System.Case_Util; use System.Case_Util; with System.HTable; -with System.OS_Lib; package body Binde is use Unit_Id_Tables; @@ -115,7 +114,7 @@ package body Binde is -- elaborated before After is elaborated. Forced, - -- Before and After come from a pair of lines in the forced elaboration + -- Before and After come from a pair of lines in the forced-elaboration- -- order file. Elab, @@ -382,7 +381,7 @@ package body Binde is -- "$ must be elaborated before $ ..." where ... is the reason. procedure Force_Elab_Order; - -- Gather dependencies from the forced elaboration order file (-f switch) + -- Gather dependencies from the forced-elaboration-order file (-f switch) procedure Gather_Dependencies; -- Compute dependencies, building the Succ and UNR tables @@ -1795,30 +1794,13 @@ package body Binde is ---------------------- procedure Force_Elab_Order is - use System.OS_Lib; - -- There is a lot of fiddly string manipulation below, because we don't - -- want to depend on misc utility packages like Ada.Characters.Handling. - - function Get_Line return String; - -- Read the next line from the file content read by Read_File. Strip - -- all leading and trailing blanks. Convert "(spec)" or "(body)" to - -- "%s"/"%b". Remove comments (Ada style; "--" to end of line). - - function Read_File (Name : String) return String_Ptr; - -- Read the entire contents of the named file - subtype Header_Num is Unit_Name_Type'Base range 0 .. 2**16 - 1; - type Line_Number is new Nat; - No_Line_Number : constant Line_Number := 0; - Cur_Line_Number : Line_Number := 0; - -- Current line number in the Force_Elab_Order_File. - -- Incremented by Get_Line. Used in error messages. function Hash (N : Unit_Name_Type) return Header_Num; package Name_Map is new System.HTable.Simple_HTable (Header_Num => Header_Num, - Element => Line_Number, + Element => Logical_Line_Number, No_Element => No_Line_Number, Key => Unit_Name_Type, Hash => Hash, @@ -1839,234 +1821,86 @@ package body Binde is return (N - Unit_Name_Type'First) mod (Header_Num'Last + 1); end Hash; - --------------- - -- Read_File -- - --------------- - - function Read_File (Name : String) return String_Ptr is - - -- All of the following calls should succeed, because we checked the - -- file in Switch.B, but we double check and raise Program_Error on - -- failure, just in case. - - F : constant File_Descriptor := Open_Read (Name, Binary); - - begin - if F = Invalid_FD then - raise Program_Error; - end if; - - declare - Len : constant Natural := Natural (File_Length (F)); - Result : constant String_Ptr := new String (1 .. Len); - Len_Read : constant Natural := - Read (F, Result (1)'Address, Len); - - Status : Boolean; - - begin - if Len_Read /= Len then - raise Program_Error; - end if; - - Close (F, Status); - - if not Status then - raise Program_Error; - end if; - - return Result; - end; - end Read_File; - - Cur : Positive := 1; - S : String_Ptr := Read_File (Force_Elab_Order_File.all); - - -------------- - -- Get_Line -- - -------------- - - function Get_Line return String is - First : Positive := Cur; - Last : Natural; - - begin - Cur_Line_Number := Cur_Line_Number + 1; - - -- Skip to end of line - - while Cur <= S'Last - and then S (Cur) /= ASCII.LF - and then S (Cur) /= ASCII.CR - loop - Cur := Cur + 1; - end loop; - - -- Strip leading blanks - - while First <= S'Last and then S (First) = ' ' loop - First := First + 1; - end loop; - - -- Strip trailing blanks and comment + -- Local variables - Last := Cur - 1; + Cur_Line_Number : Logical_Line_Number; + Error : Boolean := False; + Iter : Forced_Units_Iterator; + Prev_Unit : Unit_Id := No_Unit_Id; + Uname : Unit_Name_Type; - for J in First .. Last - 1 loop - if S (J .. J + 1) = "--" then - Last := J - 1; - exit; - end if; - end loop; - - while Last >= First and then S (Last) = ' ' loop - Last := Last - 1; - end loop; + -- Start of processing for Force_Elab_Order - -- Convert "(spec)" or "(body)" to "%s"/"%b", strip trailing blanks - -- again. + begin + Iter := Iterate_Forced_Units; + while Has_Next (Iter) loop + Next (Iter, Uname, Cur_Line_Number); declare - Body_String : constant String := "(body)"; - BL : constant Positive := Body_String'Length; - Spec_String : constant String := "(spec)"; - SL : constant Positive := Spec_String'Length; - - Line : String renames S (First .. Last); - - Is_Body : Boolean := False; - Is_Spec : Boolean := False; - + Dup : constant Logical_Line_Number := Name_Map.Get (Uname); begin - if Line'Length >= SL - and then Line (Last - SL + 1 .. Last) = Spec_String - then - Is_Spec := True; - Last := Last - SL; - elsif Line'Length >= BL - and then Line (Last - BL + 1 .. Last) = Body_String - then - Is_Body := True; - Last := Last - BL; - end if; - - while Last >= First and then S (Last) = ' ' loop - Last := Last - 1; - end loop; + if Dup = No_Line_Number then + Name_Map.Set (Uname, Cur_Line_Number); - -- Skip past LF or CR/LF + -- We don't need to give the "not present" message in the case + -- of "duplicate unit", because we would have already given the + -- "not present" message on the first occurrence. - if Cur <= S'Last and then S (Cur) = ASCII.CR then - Cur := Cur + 1; - end if; - - if Cur <= S'Last and then S (Cur) = ASCII.LF then - Cur := Cur + 1; - end if; + if Get_Name_Table_Int (Uname) = 0 + or else Unit_Id (Get_Name_Table_Int (Uname)) = No_Unit_Id + then + Error := True; + if Doing_New then + Write_Line + ("""" & Get_Name_String (Uname) + & """: not present; ignored"); + end if; + end if; - if Is_Spec then - return Line (First .. Last) & "%s"; - elsif Is_Body then - return Line (First .. Last) & "%b"; else - return Line; + Error := True; + if Doing_New then + Error_Msg_Nat_1 := Nat (Cur_Line_Number); + Error_Msg_Unit_1 := Uname; + Error_Msg_Nat_2 := Nat (Dup); + Error_Msg + (Force_Elab_Order_File.all + & ":#: duplicate unit name $ from line #"); + end if; end if; end; - end Get_Line; - -- Local variables - - Empty_Name : constant Unit_Name_Type := Name_Find (""); - Prev_Unit : Unit_Id := No_Unit_Id; - - -- Start of processing for Force_Elab_Order - - begin - -- Loop through the file content, and build a dependency link for each - -- pair of lines. Ignore lines that should be ignored. - - while Cur <= S'Last loop - declare - Uname : constant Unit_Name_Type := Name_Find (Get_Line); - Error : Boolean := False; - - begin - if Uname = Empty_Name then - null; -- silently skip blank lines - else - declare - Dup : constant Line_Number := Name_Map.Get (Uname); - begin - if Dup = No_Line_Number then - Name_Map.Set (Uname, Cur_Line_Number); - - -- We don't need to give the "not present" message in - -- the case of "duplicate unit", because we would have - -- already given the "not present" message on the - -- first occurrence. - - if Get_Name_Table_Int (Uname) = 0 - or else Unit_Id (Get_Name_Table_Int (Uname)) = - No_Unit_Id - then - Error := True; - if Doing_New then - Write_Line - ("""" & Get_Name_String (Uname) - & """: not present; ignored"); - end if; - end if; + if not Error then + declare + Cur_Unit : constant Unit_Id := Unit_Id_Of (Uname); + begin + if Is_Internal_File_Name (Units.Table (Cur_Unit).Sfile) then + if Doing_New then + Write_Line + ("""" & Get_Name_String (Uname) + & """: predefined unit ignored"); + end if; - else - Error := True; + else + if Prev_Unit /= No_Unit_Id then if Doing_New then - Error_Msg_Nat_1 := Nat (Cur_Line_Number); - Error_Msg_Unit_1 := Uname; - Error_Msg_Nat_2 := Nat (Dup); - Error_Msg - (Force_Elab_Order_File.all - & ":#: duplicate unit name $ from line #"); + Write_Unit_Name (Units.Table (Prev_Unit).Uname); + Write_Str (" <-- "); + Write_Unit_Name (Units.Table (Cur_Unit).Uname); + Write_Eol; end if; - end if; - end; - - if not Error then - declare - Cur_Unit : constant Unit_Id := Unit_Id_Of (Uname); - begin - if Is_Internal_File_Name - (Units.Table (Cur_Unit).Sfile) - then - if Doing_New then - Write_Line - ("""" & Get_Name_String (Uname) - & """: predefined unit ignored"); - end if; - else - if Prev_Unit /= No_Unit_Id then - if Doing_New then - Write_Unit_Name (Units.Table (Prev_Unit).Uname); - Write_Str (" <-- "); - Write_Unit_Name (Units.Table (Cur_Unit).Uname); - Write_Eol; - end if; - - Build_Link - (Before => Prev_Unit, - After => Cur_Unit, - R => Forced); - end if; + Build_Link + (Before => Prev_Unit, + After => Cur_Unit, + R => Forced); + end if; - Prev_Unit := Cur_Unit; - end if; - end; + Prev_Unit := Cur_Unit; end if; - end if; - end; + end; + end if; end loop; - - Free (S); end Force_Elab_Order; ------------------------- |