From 1513c94dd70b28ccf742a87225c72624ff67ef5a Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Wed, 4 Sep 2024 10:53:16 +0200 Subject: [PATCH 1/4] Headers --- src/aaa-table_io.adb | 23 +++++++++++++++++++++++ src/aaa-table_io.ads | 11 ++++++++++- 2 files changed, 33 insertions(+), 1 deletion(-) diff --git a/src/aaa-table_io.adb b/src/aaa-table_io.adb index 6acf707..1360f2f 100644 --- a/src/aaa-table_io.adb +++ b/src/aaa-table_io.adb @@ -53,6 +53,29 @@ package body AAA.Table_IO is return Reference'(Table => T'Access); end Append; + ------------ + -- Header -- + ------------ + + procedure Header (T : in out Table; Cell : String) is + begin + T.Headers.Append (UTF.Wide_Wide_Strings.Decode (Cell)); + T.Append (Cell); + end Header; + + ------------ + -- Header -- + ------------ + + function Header (T : aliased in out Table; + Cell : String) + return Reference + is + begin + T.Header (Cell); + return Reference'(Table => T'Access); + end Header; + ------------- -- New_Row -- ------------- diff --git a/src/aaa-table_io.ads b/src/aaa-table_io.ads index fe31f7e..c9eb176 100644 --- a/src/aaa-table_io.ads +++ b/src/aaa-table_io.ads @@ -16,13 +16,21 @@ package AAA.Table_IO with Preelaborate is type Table is tagged private; - type Reference (Table : access Table_IO.Table) is limited null record + type Reference (Table : access Table_IO.Table'Class) is limited null record with Implicit_Dereference => Table; procedure Append (T : in out Table; Cell : String); function Append (T : aliased in out Table; Cell : String) return Reference; + procedure Header (T : in out Table; Cell : String); + -- Headers are printed as given, but are keep internally for the structured + -- output as field names. There should be as many headers as columns. + + function Header (T : aliased in out Table; + Cell : String) + return Reference; + procedure New_Row (T : in out Table); type Alignments is array (Positive range <>) of Ada.Strings.Alignment; @@ -48,6 +56,7 @@ private type Table is tagged record Next_Column : Positive := 1; + Headers : Row; Rows : Row_Vectors.Vector; Max_Widths : Natural_Vectors.Vector; end record; From ddfeffe2d6c8f9d19161df7b31d16d37bef4ba71 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Sun, 8 Sep 2024 20:32:20 +0200 Subject: [PATCH 2/4] Printing --- alire.toml | 4 ++- config/aaa_config.ads | 2 +- config/aaa_config.gpr | 10 +++--- config/aaa_config.h | 2 +- src/aaa-table_io.adb | 71 +++++++++++++++++++++++++++++++++++++++++++ src/aaa-table_io.ads | 8 ++++- 6 files changed, 87 insertions(+), 10 deletions(-) diff --git a/alire.toml b/alire.toml index 45a821c..0a56cf3 100644 --- a/alire.toml +++ b/alire.toml @@ -22,7 +22,9 @@ tags = ["miscellanea", "utility"] website = "https://github.com/mosteo/aaa" [[depends-on]] -umwi = "~0.1.0" +ansiada = "^1.1.0" +lml = "~0.1.0" +umwi = "~0.1.0" # [[pins]] # umwi = { url="https://github.com/mosteo/umwi", branch="main" } diff --git a/config/aaa_config.ads b/config/aaa_config.ads index 401243a..7839a11 100644 --- a/config/aaa_config.ads +++ b/config/aaa_config.ads @@ -15,6 +15,6 @@ package Aaa_Config is Alire_Host_Distro : constant String := "ubuntu"; type Build_Profile_Kind is (release, validation, development); - Build_Profile : constant Build_Profile_Kind := validation; + Build_Profile : constant Build_Profile_Kind := development; end Aaa_Config; diff --git a/config/aaa_config.gpr b/config/aaa_config.gpr index 4829245..285c3d4 100644 --- a/config/aaa_config.gpr +++ b/config/aaa_config.gpr @@ -1,4 +1,6 @@ -- Configuration for aaa generated by Alire +with "ansiada.gpr"; +with "lml.gpr"; with "umwi.gpr"; abstract project Aaa_Config is Crate_Version := "0.3.0-dev"; @@ -12,17 +14,13 @@ abstract project Aaa_Config is Ada_Compiler_Switches := External_As_List ("ADAFLAGS", " "); Ada_Compiler_Switches := Ada_Compiler_Switches & ( - "-O3" -- Optimize for performance - ,"-gnatn" -- Enable inlining + "-Og" -- Optimize for debug ,"-ffunction-sections" -- Separate ELF section for each function ,"-fdata-sections" -- Separate ELF section for each variable ,"-g" -- Generate debug info - ,"-gnato" -- Enable numeric overflow checking ,"-gnatwa" -- Enable all warnings ,"-gnatw.X" -- Disable warnings for No_Exception_Propagation ,"-gnatVa" -- All validity checks - ,"-gnatwe" -- Warnings as errors - ,"-gnata" -- Enable assertions and contracts ,"-gnaty3" -- Specify indentation level of 3 ,"-gnatya" -- Check attribute casing ,"-gnatyA" -- Use of array index numbers in array attributes @@ -50,6 +48,6 @@ abstract project Aaa_Config is ); type Build_Profile_Kind is ("release", "validation", "development"); - Build_Profile : Build_Profile_Kind := "validation"; + Build_Profile : Build_Profile_Kind := "development"; end Aaa_Config; diff --git a/config/aaa_config.h b/config/aaa_config.h index bf1815c..f67ab97 100644 --- a/config/aaa_config.h +++ b/config/aaa_config.h @@ -15,6 +15,6 @@ #define BUILD_PROFILE_VALIDATION 2 #define BUILD_PROFILE_DEVELOPMENT 3 -#define BUILD_PROFILE 2 +#define BUILD_PROFILE 3 #endif diff --git a/src/aaa-table_io.adb b/src/aaa-table_io.adb index 1360f2f..d06ba5e 100644 --- a/src/aaa-table_io.adb +++ b/src/aaa-table_io.adb @@ -4,8 +4,12 @@ with Ada.Containers; with Ada.Strings.UTF_Encoding.Wide_Wide_Strings; with Ada.Strings.Wide_Wide_Unbounded; +with AnsiAda; + with GNAT.IO; +with LML.Output.Factory; + with Umwi; package body AAA.Table_IO is @@ -59,6 +63,10 @@ package body AAA.Table_IO is procedure Header (T : in out Table; Cell : String) is begin + if T.Rows.Length > 1 then + raise Program_Error with "Headers must be added before any data rows"; + end if; + T.Headers.Append (UTF.Wide_Wide_Strings.Decode (Cell)); T.Append (Cell); end Header; @@ -192,4 +200,67 @@ package body AAA.Table_IO is end loop; end Print; + ----------- + -- Print -- + ----------- + + procedure Print (T : Table; + Format : LML.Formats; + Put_Line : access procedure (Line : String) := null) + is + Builder : LML.Output.Builder'Class := LML.Output.Factory.Get (Format); + begin + + -- Ada_TOML requires an anonymous top-level table, and as a consequence + -- the nested array must have a name. We could alternatively use a + -- map with indexes as keys, but as those would have to be strings in + -- the TOML case at least, we would lose the original ordering unless + -- padding were added, which would in turn difficult data extraction. + + if Format in LML.TOML then + Builder.Begin_Map; + Builder.Insert ("data"); + end if; + + Builder.Begin_Vec; + + for Row in 2 .. Natural (T.Rows.Length) loop + + -- Skip last empty line, which is naturally filtered out in the + -- non-structured alternative. Here we are creating the empty + -- record too soon (in between loops). + + if Row < Natural (T.Rows.Length) + or else Natural (T.Rows (Row).Length) > 0 + then + + Builder.Begin_Map; + + for Col in 1 .. Integer (T.Rows (Row).Length) loop + if Col > Integer (T.Headers.Length) then + raise Constraint_Error with + "Missing header for column" & Col'Image; + end if; + + Builder.Insert + (LML.Decode (AnsiAda.Scrub (LML.Encode (T.Headers (Col))))); + Builder.Append + (LML.Decode (AnsiAda.Scrub (LML.Encode (T.Rows (Row) (Col))))) + ; + end loop; + + Builder.End_Map; + + end if; + end loop; + + Builder.End_Vec; + + if Format in LML.TOML then + Builder.End_Map; + end if; + + Put_Line (LML.Encode (Builder.To_Text)); + end Print; + end AAA.Table_IO; diff --git a/src/aaa-table_io.ads b/src/aaa-table_io.ads index c9eb176..00821b2 100644 --- a/src/aaa-table_io.ads +++ b/src/aaa-table_io.ads @@ -3,7 +3,9 @@ with Ada.Containers.Vectors; with Ada.Strings; -package AAA.Table_IO with Preelaborate is +with LML; + +package AAA.Table_IO is -- A type to format tables according to the max length of fields. The table -- is ANSI-aware, so it will work properly for text with embedded ANSI @@ -42,6 +44,10 @@ package AAA.Table_IO with Preelaborate is -- Will print the table using GNAT.IO, unless Put_Line is supplied -- FIXME: Align is currently ignored + procedure Print (T : Table; + Format : LML.Formats; + Put_Line : access procedure (Line : String) := null); + private package Natural_Vectors is new Ada.Containers.Vectors (Positive, Natural); From 04450085232edda086d7376a6dcaf17ab6b45aa9 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Thu, 13 Feb 2025 22:37:31 +0100 Subject: [PATCH 3/4] Improvements to Table_IO --- src/aaa-table_io.adb | 35 ++++++++++++++++++++++++++++++++--- src/aaa-table_io.ads | 5 +++++ 2 files changed, 37 insertions(+), 3 deletions(-) diff --git a/src/aaa-table_io.adb b/src/aaa-table_io.adb index d06ba5e..3cbc74c 100644 --- a/src/aaa-table_io.adb +++ b/src/aaa-table_io.adb @@ -1,4 +1,5 @@ with AAA.ANSI; +with AAA.Strings; with Ada.Containers; with Ada.Strings.UTF_Encoding.Wide_Wide_Strings; @@ -26,6 +27,12 @@ package body AAA.Table_IO is procedure Append (T : in out Table; Cell : String) is begin + if T.Section = Headers and then not T.Is_Header then + raise Constraint_Error with + "Adding data before completing headers (missing New_Row?)"; + end if; + T.Is_Header := False; + declare Cell : constant Wide_Wide_String := UTF.Wide_Wide_Strings.Decode (Append.Cell); @@ -67,6 +74,9 @@ package body AAA.Table_IO is raise Program_Error with "Headers must be added before any data rows"; end if; + T.Section := Headers; + T.Is_Header := True; + T.Headers.Append (UTF.Wide_Wide_Strings.Decode (Cell)); T.Append (Cell); end Header; @@ -90,6 +100,10 @@ package body AAA.Table_IO is procedure New_Row (T : in out Table) is begin + if not T.Rows.Is_Empty then + T.Section := Data; + end if; + T.Next_Column := 1; T.Rows.Append (String_Vectors.Empty_Vector); end New_Row; @@ -166,6 +180,11 @@ package body AAA.Table_IO is Wide_Separator : constant Wide_Wide_String := UTF.Wide_Wide_Strings.Decode (Separator); begin + if T.Section = Headers then + raise Constraint_Error + with "Headers section not yet complete (missing New_Row?)"; + end if; + for Row of T.Rows loop declare Line : Unbounded_Wide_Wide_String; @@ -208,9 +227,15 @@ package body AAA.Table_IO is Format : LML.Formats; Put_Line : access procedure (Line : String) := null) is + use AAA.Strings; Builder : LML.Output.Builder'Class := LML.Output.Factory.Get (Format); begin + if T.Section = Headers then + raise Constraint_Error + with "Headers section not yet complete (missing New_Row?)"; + end if; + -- Ada_TOML requires an anonymous top-level table, and as a consequence -- the nested array must have a name. We could alternatively use a -- map with indexes as keys, but as those would have to be strings in @@ -243,10 +268,14 @@ package body AAA.Table_IO is end if; Builder.Insert - (LML.Decode (AnsiAda.Scrub (LML.Encode (T.Headers (Col))))); + (LML.Decode + (Trim (AnsiAda.Scrub (LML.Encode (T.Headers (Col)))))); Builder.Append - (LML.Decode (AnsiAda.Scrub (LML.Encode (T.Rows (Row) (Col))))) - ; + (LML.Scalars.New_Text + (LML.Decode + (Trim + (AnsiAda.Scrub + (LML.Encode (T.Rows (Row) (Col))))))); end loop; Builder.End_Map; diff --git a/src/aaa-table_io.ads b/src/aaa-table_io.ads index 00821b2..e7eb2c0 100644 --- a/src/aaa-table_io.ads +++ b/src/aaa-table_io.ads @@ -60,11 +60,16 @@ private package Row_Vectors is new Ada.Containers.Vectors (Positive, Row); + type Sections is (Nothing, Headers, Data); + type Table is tagged record Next_Column : Positive := 1; Headers : Row; Rows : Row_Vectors.Vector; Max_Widths : Natural_Vectors.Vector; + Section : Sections := Nothing; + Is_Header : Boolean := False; + -- Internal state to discriminate in Append when a header is being added end record; end AAA.Table_IO; From 73d99ae1ff2f5210dc41c2ea7afebe600f9e9916 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Fri, 21 Feb 2025 20:57:35 +0100 Subject: [PATCH 4/4] Detect exe availability prior to spawn --- src/aaa-filesystem.adb | 12 ++++++------ src/aaa-processes.adb | 26 +++++++++++++++++++++----- 2 files changed, 27 insertions(+), 11 deletions(-) diff --git a/src/aaa-filesystem.adb b/src/aaa-filesystem.adb index 257ff55..b08eec5 100644 --- a/src/aaa-filesystem.adb +++ b/src/aaa-filesystem.adb @@ -1,4 +1,5 @@ with AAA.Debug; +with AAA.Processes; with AAA.Strings; with Ada.Numerics.Discrete_Random; @@ -51,19 +52,18 @@ package body AAA.Filesystem is procedure Ensure_Deletable (Path : String) is use Ada.Directories; use GNAT; - OK : Boolean := False; - Args : OS_Lib.Argument_List_Access; + Args : Strings.Vector; + Result : Processes.Result; begin if Exists (Path) and then Kind (Path) = Directory and then OS_Lib.Directory_Separator = '\' then - Args := OS_Lib.Argument_String_To_List ("-R /D /S " & Path & "\*"); + Args := Strings.Split ("-R /D /S", ' ').Append (Path & "\*"); - OS_Lib.Spawn ("attrib", Args.all, OK); - OS_Lib.Free (Args); + Result := Processes.Run (Strings.To_Vector ("attrib").Append (Args)); - if not OK then + if Result.Exit_Code /= 0 then raise Program_Error with "failed to change attributes of " & Path; end if; end if; diff --git a/src/aaa-processes.adb b/src/aaa-processes.adb index 50505f6..dd011ef 100644 --- a/src/aaa-processes.adb +++ b/src/aaa-processes.adb @@ -79,11 +79,27 @@ package body AAA.Processes is -- & Command & " " & Arguments.Flatten -- & " > " & Name.all); - Spawn (Program_Name => Command, - Args => Arg_List, - Output_File_Descriptor => File, - Return_Code => Exit_Code, - Err_To_Out => Err_To_Out); + declare + Full_Path_Ptr : GNAT.OS_Lib.String_Access + := GNAT.OS_Lib.Locate_Exec_On_Path (Command); + Full_Path : constant String := + (if Full_Path_Ptr /= null + then Full_Path_Ptr.all + else ""); + begin + if Full_Path = "" then + raise Constraint_Error with + "Executable not found: " & Command; + else + GNAT.OS_Lib.Free (Full_Path_Ptr); + end if; + + Spawn (Program_Name => Full_Path, + Args => Arg_List, + Output_File_Descriptor => File, + Return_Code => Exit_Code, + Err_To_Out => Err_To_Out); + end; Close (File); -- Can't raise Read_Output;