diff --git a/deps/simple_logging/src/simple_logging.adb b/deps/simple_logging/src/simple_logging.adb index f2785ebe..a1e66535 100644 --- a/deps/simple_logging/src/simple_logging.adb +++ b/deps/simple_logging/src/simple_logging.adb @@ -4,11 +4,12 @@ package body Simple_Logging is function Prefix (Level : Levels) return String is (case Level is - when Error => "ERROR: ", + when Always => "", + when Error => "ERROR: ", when WARNING => "Warning: ", - when Info => "", - when Detail => "-> ", - when Debug => "-->> "); + when Info => "", + when Detail => "-> ", + when Debug => "-->> "); --------- -- Log -- diff --git a/deps/simple_logging/src/simple_logging.ads b/deps/simple_logging/src/simple_logging.ads index fa28e094..e7f9a42a 100644 --- a/deps/simple_logging/src/simple_logging.ads +++ b/deps/simple_logging/src/simple_logging.ads @@ -1,6 +1,7 @@ package Simple_Logging with Preelaborate is - type Levels is (Error, + type Levels is (Always, + Error, Warning, Info, Detail, diff --git a/src/alire-os_lib.adb b/src/alire-os_lib.adb index 46a75ca5..6d927406 100644 --- a/src/alire-os_lib.adb +++ b/src/alire-os_lib.adb @@ -1,5 +1,8 @@ +with GNAT.Expect; with GNAT.OS_Lib; +with System; + package body Alire.OS_Lib is use GNAT.OS_Lib; @@ -20,17 +23,99 @@ package body Alire.OS_Lib is end if; end Locate_In_Path; + ------------------------- + -- Spawn_With_Progress -- + ------------------------- + + function Spawn_With_Progress (Command : String; + Arguments : String; + Percent_Only : Boolean) return Integer + is + use GNAT.Expect; + + procedure Filter + (Descriptor : Process_Descriptor'Class; + Str : String; + User_Data : System.Address) + is + pragma Unreferenced (Descriptor, User_Data); + begin + Log ("X: " & Str, Always); + end Filter; + + Pid : Process_Descriptor; + + Trash : Expect_Match; + begin + Log ("A: " & Command & " " & Arguments, Always); + Non_Blocking_Spawn + (Pid, + Command, + Argument_String_To_List (Arguments).all, + Err_To_Out => True); + Log ("B", Always); + Add_Filter (Pid, Filter'Unrestricted_Access); -- No fear, clearly in scope + Log ("C", Always); + + loop + begin + Expect (Pid, Trash, ""); + Log ("D", Always); + exception + when Process_Died => + exit; + end; + end loop; + Log ("D2", Always); + + return Code : Integer do + Close (Pid, Code); + Log ("E", Always); + end return; + exception + when Process_Died => + Log ("THE END", Always); + raise; + end Spawn_With_Progress; + ----------- -- Spawn -- ----------- -- FIXME: memory leaks - function Spawn (Command : String; - Arguments : String := "") return Integer is + function Spawn (Command : String; + Arguments : String := ""; + Understands_Verbose : Boolean := False) return Integer + is + Extra : constant String := (if Understands_Verbose then "-v " else ""); + File : File_Descriptor; + Name : String_Access; + Ok : Boolean; begin Log ("Spawning: " & Command & " " & Arguments, Debug); - return - (Spawn (Locate_In_Path (Command), - Argument_String_To_List (Arguments).all)); + + case Simple_Logging.Level is + when Always | Error | Warning => + Create_Temp_Output_File (File, Name); + return Code : Integer do + Spawn + (Locate_In_Path (Command), + Argument_String_To_List (Arguments).all, + File, + Code, + Err_To_Out => False); + Delete_File (Name.all, Ok); + if not Ok then + Log ("Failed to delete tmp file: " & Name.all, Warning); + end if; + Free (Name); + end return; + when Info | Detail => + return Spawn_With_Progress (Command, Arguments, Percent_Only => Simple_Logging.Level = Info); + when Debug => + return + (Spawn (Locate_In_Path (Command), + Argument_String_To_List (Extra & Arguments).all)); + end case; end Spawn; ----------- @@ -38,9 +123,10 @@ package body Alire.OS_Lib is ----------- procedure Spawn (Command : String; - Arguments : String := "") + Arguments : String := ""; + Understands_Verbose : Boolean := False) is - Code : constant Integer := Spawn (Command, Arguments); + Code : constant Integer := Spawn (Command, Arguments, Understands_Verbose); begin if Code /= 0 then raise Program_Error with "Exit code:" & Code'Image; diff --git a/src/alire-os_lib.ads b/src/alire-os_lib.ads index 8127f1f4..db9b3c58 100644 --- a/src/alire-os_lib.ads +++ b/src/alire-os_lib.ads @@ -4,10 +4,13 @@ with Ada.Finalization; package Alire.OS_Lib is function Spawn (Command : String; - Arguments : String := "") return Integer; + Arguments : String := ""; + Understands_Verbose : Boolean := False) return Integer; + -- If understands, an extra -v will be passed on Debug log levels procedure Spawn (Command : String; - Arguments : String:= ""); + Arguments : String := ""; + Understands_Verbose : Boolean := False); -- Raises PROGRAM_ERROR if exit code /= 0 type Folder_Guard (<>) is limited private;