From e734cc8edd6f5543808c3c9047c94d9489c9725a Mon Sep 17 00:00:00 2001 From: Fabien Chouteau Date: Wed, 4 Aug 2021 12:44:34 +0200 Subject: [PATCH 1/9] Build profiles prototype --- src/alire/alire-crate_configuration.adb | 12 ++++- src/alire/alire-properties-configurations.adb | 46 ++++++++++++++++++- src/alire/alire-properties-configurations.ads | 2 + src/alr/alr-commands-init.adb | 22 +++++---- 4 files changed, 71 insertions(+), 11 deletions(-) diff --git a/src/alire/alire-crate_configuration.adb b/src/alire/alire-crate_configuration.adb index d62d48fda..388011bb9 100644 --- a/src/alire/alire-crate_configuration.adb +++ b/src/alire/alire-crate_configuration.adb @@ -312,8 +312,13 @@ package body Alire.Crate_Configuration is end if; if This.Map.Contains (Name) then - Raise_Checked_Error - ("Configuration variable '" & (+Name) & "' already defined"); + if Type_Name_Lower = "build_mode" then + Raise_Checked_Error + ("Configuration variable '" & (+Name) & "' is reserved"); + else + Raise_Checked_Error + ("Configuration variable '" & (+Name) & "' already defined"); + end if; end if; declare @@ -328,6 +333,9 @@ package body Alire.Crate_Configuration is Rel : constant Releases.Release := Root.Release (Crate); begin + -- Add built-in definition + Add_Definition (Alire.Properties.Configurations.Builtin_Build_Mode); + for Prop of Rel.On_Platform_Properties (Root.Environment, Config_Type_Definition'Tag) loop diff --git a/src/alire/alire-properties-configurations.adb b/src/alire/alire-properties-configurations.adb index ee5deffea..4914cd8c6 100644 --- a/src/alire/alire-properties-configurations.adb +++ b/src/alire/alire-properties-configurations.adb @@ -496,6 +496,28 @@ package body Alire.Properties.Configurations is use ASCII; Name : constant String := +This.Name; Indent : constant String := " "; + + function GNAT_Switches (Mode : String; Indent : String := "") + return String + is + begin + pragma Style_Checks ("M120"); + if Mode = "Release" then + return "(""-O3"", -- Optimize for performance" & LF & + Indent & """-gnatp"", -- Supress checks" & LF & + Indent & """-gnatw.X"", -- Disable warnings for No_Exception_Propagation" & LF & + Indent & """-gnatQ"" -- Don't quit. Generate ALI and tree files even if illegalities" & LF & + Indent & ")"; + elsif Mode = "Develop" then + return "(""-Og"", -- Optimize for debug" & LF & + Indent & """-g"", -- Debug info" & LF & + Indent & """-gnatw.X"", -- Disable warnings for No_Exception_Propagation" & LF & + Indent & """-gnatQ"" -- Don't quit. Generate ALI and tree files even if illegalities" & LF & + Indent & ")"; + else + return "()"; + end if; + end GNAT_Switches; begin case This.Kind is @@ -510,7 +532,12 @@ package body Alire.Properties.Configurations is return Indent & "type " & Name & "_Kind is (" & To_String (This.Values, Wrap_With_Quotes => True) & ");" & LF & Indent & Name & " : " & Name & "_Kind := """ & Value.As_String - & """;"; + & """;" + & (if Name = "Build_Mode" + then LF & Indent & "GNAT_Switches := " & + GNAT_Switches (Value.As_String, + Indent & " ") & ";" + else ""); when Real => @@ -887,4 +914,21 @@ package body Alire.Properties.Configurations is end return; end Config_Entry_From_TOML; + ------------------------ + -- Builtin_Build_Mode -- + ------------------------ + + function Builtin_Build_Mode return Config_Type_Definition is + + Ret : constant Config_Type_Definition := + (Kind => Enum, + Name => +"Build_Mode", + Default => TOML.Create_String ("Release"), + Values => TOML.Create_Array (Item_Kind => TOML.TOML_String)); + begin + Ret.Values.Append (TOML.Create_String ("Release")); + Ret.Values.Append (TOML.Create_String ("Develop")); + return Ret; + end Builtin_Build_Mode; + end Alire.Properties.Configurations; diff --git a/src/alire/alire-properties-configurations.ads b/src/alire/alire-properties-configurations.ads index 08c82026b..da568e189 100644 --- a/src/alire/alire-properties-configurations.ads +++ b/src/alire/alire-properties-configurations.ads @@ -94,6 +94,8 @@ package Alire.Properties.Configurations with Preelaborate is function Assignments_From_TOML (From : TOML_Adapters.Key_Queue) return Conditional.Properties; + function Builtin_Build_Mode return Config_Type_Definition; + private type Config_Entry is new Properties.Property with record diff --git a/src/alr/alr-commands-init.adb b/src/alr/alr-commands-init.adb index 63ade3516..19ebe1f85 100644 --- a/src/alr/alr-commands-init.adb +++ b/src/alr/alr-commands-init.adb @@ -8,6 +8,8 @@ with Alire.Lockfiles; with Alire.Paths; with Alire.Solutions; with Alire.Utils.User_Input.Query_Config; +with Alire.Properties.Configurations; +with Alr.Utils; with GNATCOLL.VFS; use GNATCOLL.VFS; @@ -113,6 +115,14 @@ package body Alr.Commands.Init is Put_Line ("abstract project " & Mixed_Name & "_Config is"); Put_Line (" Crate_Version := ""0.0.0"";"); Put_Line ("end " & Mixed_Name & "_Config;"); + + declare + use Alire.Properties.Configurations; + Build_Mode : constant Config_Type_Definition := Builtin_Build_Mode; + begin + Put_Line (To_GPR_Declaration (Build_Mode, Default (Build_Mode))); + end; + TIO.Put (File, "end " & Mixed_Name & "_Config;"); TIO.Close (File); -- Main project file @@ -144,6 +154,7 @@ package body Alr.Commands.Init is Put_Line (" for Main use (""" & Lower_Name & ".adb"");"); end if; Put_New_Line; +<<<<<<< HEAD Put_Line (" type Enabled_Kind is (""enabled"", ""disabled"");"); Put_Line (" Compile_Checks : Enabled_Kind := External (""" & Upper_Name & "_COMPILE_CHECKS"", ""disabled"");"); Put_Line (" Runtime_Checks : Enabled_Kind := External (""" & Upper_Name & "_RUNTIME_CHECKS"", ""disabled"");"); @@ -200,15 +211,10 @@ package body Alr.Commands.Init is Put_Line (" ""-Og""); -- No optimization"); Put_Line (" end case;"); Put_New_Line; +======= +>>>>>>> e8652207... Build profiles prototype Put_Line (" package Compiler is"); - Put_Line (" for Default_Switches (""Ada"") use"); - Put_Line (" Compile_Checks_Switches &"); - Put_Line (" Build_Switches &"); - Put_Line (" Runtime_Checks_Switches &"); - Put_Line (" Style_Checks_Switches &"); - Put_Line (" Contracts_Switches &"); - Put_Line (" (""-gnatw.X"", -- Disable warnings for No_Exception_Propagation"); - Put_Line (" ""-gnatQ""); -- Don't quit. Generate ALI and tree files even if illegalities"); + Put_Line (" for Default_Switches (""Ada"") use " & Mixed_Name & "_Config.GNAT_Switches;"); Put_Line (" end Compiler;"); Put_New_Line; Put_Line (" package Binder is"); From 80f5a706b6ff50bd473dfc1a238fff71f091d39b Mon Sep 17 00:00:00 2001 From: Fabien Chouteau Date: Mon, 22 Nov 2021 18:08:17 +0100 Subject: [PATCH 2/9] Build_profile in manifest --- src/alire/alire-crate_configuration.adb | 320 +++++++++++++----- src/alire/alire-crate_configuration.ads | 34 +- src/alire/alire-properties-build_profile.adb | 173 ++++++++++ src/alire/alire-properties-build_profile.ads | 51 +++ src/alire/alire-properties-build_switches.adb | 202 +++++++++++ src/alire/alire-properties-build_switches.ads | 33 ++ src/alire/alire-properties-configurations.adb | 52 +-- src/alire/alire-properties-configurations.ads | 4 +- src/alire/alire-properties-from_toml.ads | 29 +- src/alire/alire-toml_keys.ads | 2 + src/alire/alire-utils-gnat_switches.ads | 24 ++ src/alire/alire-utils-switches-knowledge.adb | 68 ++++ src/alire/alire-utils-switches-knowledge.ads | 22 ++ src/alire/alire-utils-switches.adb | 150 ++++++++ src/alire/alire-utils-switches.ads | 106 ++++++ src/alr/alr-commands-init.adb | 68 ---- 16 files changed, 1139 insertions(+), 199 deletions(-) create mode 100644 src/alire/alire-properties-build_profile.adb create mode 100644 src/alire/alire-properties-build_profile.ads create mode 100644 src/alire/alire-properties-build_switches.adb create mode 100644 src/alire/alire-properties-build_switches.ads create mode 100644 src/alire/alire-utils-gnat_switches.ads create mode 100644 src/alire/alire-utils-switches-knowledge.adb create mode 100644 src/alire/alire-utils-switches-knowledge.ads create mode 100644 src/alire/alire-utils-switches.adb create mode 100644 src/alire/alire-utils-switches.ads diff --git a/src/alire/alire-crate_configuration.adb b/src/alire/alire-crate_configuration.adb index 388011bb9..676eaf400 100644 --- a/src/alire/alire-crate_configuration.adb +++ b/src/alire/alire-crate_configuration.adb @@ -10,6 +10,9 @@ with Alire.Roots; with Alire.Origins; with Alire.Warnings; +with Alire.Properties.Build_Profile; +with Alire.Utils.Switches; use Alire.Utils.Switches; +with Alire.Utils.Switches.Knowledge; with Alire.Directories; with TOML; use TOML; @@ -22,6 +25,115 @@ package body Alire.Crate_Configuration is is (Type_Name = "crate_version"); -- Return True if Type_Name is reserved for Alire internal use + ---------------------------- + -- Make_Build_Profile_Map -- + ---------------------------- + + procedure Make_Build_Profile_Map (This : in out Global_Config; + Root : Alire.Roots.Root; + Solution : Solutions.Solution) + is + use Properties.Build_Profile; + + ----------------- + -- Set_Profile -- + ----------------- + + procedure Set_Profile (Crate : Crate_Name; P : Profile_Kind) is + begin + if This.Profile_Map.Contains (Crate) then + This.Profile_Map.Replace (Crate, P); + else + Raise_Checked_Error ("Unknow crate in build profile: '" & + String'(+Crate) & "'"); + end if; + end Set_Profile; + + begin + + -- Populate map with crates in the solution + for Rel of Solution.Releases.Including (Root.Release) loop + This.Profile_Map.Insert (Rel.Name, + (if Rel.Name = Root.Name + then Development + else Release)); + end loop; + + for Prop of Root.Release.On_Platform_Properties + (Root.Environment, + Properties.Build_Profile.Variable'Tag) + loop + declare + Prof : constant Properties.Build_Profile.Variable + := Properties.Build_Profile.Variable (Prop); + begin + + if Prof.Has_Wildcard then + + -- If wildcard is defined, apply it to all crates + declare + Wildcard_Profile : constant Profile_Kind + := Prof.Wildcard; + begin + for Cursor in This.Profile_Map.Iterate loop + This.Profile_Map.Replace_Element + (Cursor, Wildcard_Profile); + end loop; + end; + end if; + + declare + use Properties.Build_Profile.Profile_Selection_Maps; + Sel : constant Profile_Selection_Maps.Map + := Prof.Selection; + begin + for Cursor in Sel.Iterate loop + Set_Profile (Key (Cursor), Element (Cursor)); + end loop; + end; + end; + end loop; + + for Cursor in This.Profile_Map.Iterate loop + -- Set build_Mode value in configuration variables + This.Set_Value + (Profile_Maps.Key (Cursor), + (Name => +Builtin_Build_Profile.Name, + Value => TOML.Create_String (Profile_Maps.Element (Cursor)'Img))); + end loop; + + end Make_Build_Profile_Map; + + ---------------------- + -- Make_Swiches_Map -- + ---------------------- + + procedure Make_Swiches_Map (This : in out Global_Config; + Root : Alire.Roots.Root; + Solution : Solutions.Solution) + is + begin + for Rel of Solution.Releases.Including (Root.Release) loop + declare + Profile : constant Profile_Kind + := This.Profile_Map.Element (Rel.Name); + + List : Alire.Utils.Switches.Switch_List; + begin + case Profile is + when Release => + List := Get_List (Default_Release_Switches); + when Validation => + List := Get_List (Default_Validation_Switches); + when Development => + List := Get_List (Default_Development_Switches); + end case; + + This.Switches_Map.Insert (Rel.Name, List); + end; + end loop; + end Make_Swiches_Map; + ---------- -- Load -- ---------- @@ -30,6 +142,7 @@ package body Alire.Crate_Configuration is Root : in out Alire.Roots.Root) is Solution : constant Solutions.Solution := Root.Solution; + begin if not Solution.Is_Complete then @@ -42,6 +155,10 @@ package body Alire.Crate_Configuration is Crate => Rel.Name); end loop; + Make_Build_Profile_Map (This, Root, Solution); + + Make_Swiches_Map (This, Root, Solution); + for Rel of Solution.Releases.Including (Root.Release) loop This.Load_Settings (Root => Root, Crate => Rel.Name); @@ -181,6 +298,45 @@ package body Alire.Crate_Configuration is TIO.Close (File); end Generate_Ada_Config; + --------------------------- + -- Pretty_Print_Switches -- + --------------------------- + + procedure Pretty_Print_Switches (File : TIO.File_Type; + L : Switch_List; + Indent : Natural) + is + Indent_Str : constant String (1 .. Indent) := (others => ' '); + First : Boolean := True; + begin + + Alire.Utils.Switches.Knowledge.Populate; + + TIO.Put_Line (File, Indent_Str & "("); + for Sw of L loop + TIO.Put (File, Indent_Str & " "); + if not First then + TIO.Put (File, ","); + else + TIO.Put (File, " "); + First := False; + end if; + TIO.Put (File, """" & Sw & """"); + + declare + Info : constant String := Utils.Switches.Knowledge.Get_Info (Sw); + begin + if Info'Length /= 0 then + TIO.Put (File, " -- " & Info); + end if; + end; + + TIO.New_Line (File); + end loop; + + TIO.Put_Line (File, Indent_Str & ");"); + end Pretty_Print_Switches; + ------------------------- -- Generate_GPR_Config -- ------------------------- @@ -208,6 +364,13 @@ package body Alire.Crate_Configuration is TIO.Put_Line (File, " Crate_Version := """ & Version & """;"); + TIO.Put_Line (File, " Ada_Compiler_Switches := " & + "External_As_List (""ADAFLAGS"", "" "") &"); + + Pretty_Print_Switches (File, + This.Switches_Map.Element (Crate), + Indent => 10); + for C in This.Map.Iterate loop declare Elt : constant Config_Maps.Constant_Reference_Type := @@ -285,114 +448,119 @@ package body Alire.Crate_Configuration is TIO.Close (File); end Generate_C_Config; - ---------------------- - -- Load_Definitions -- - ---------------------- + -------------------- + -- Add_Definition -- + -------------------- - procedure Load_Definitions (This : in out Global_Config; - Root : in out Roots.Root; - Crate : Crate_Name) + procedure Add_Definition (This : in out Global_Config; + Crate : Crate_Name; + Type_Def : Config_Type_Definition) is + Type_Name_Lower : constant String := + Ada.Characters.Handling.To_Lower (Type_Def.Name); - -------------------- - -- Add_Definition -- - -------------------- + Name : constant Unbounded_String := +(+Crate & "." & Type_Name_Lower); + begin - procedure Add_Definition (Type_Def : Config_Type_Definition) is - Type_Name_Lower : constant String := - Ada.Characters.Handling.To_Lower (Type_Def.Name); + Trace.Always ("Add_Defintion: " & (+Name)); - Name : constant Unbounded_String := +(+Crate & "." & Type_Name_Lower); - begin + if Is_Reserved_Name (Type_Name_Lower) then + Raise_Checked_Error + ("Configuration variable name '" & (+Name) & + "' is reserved for Alire internal use"); + end if; - if Is_Reserved_Name (Type_Name_Lower) then - Raise_Checked_Error - ("Configuration variable name '" & (+Name) & - "' is reserved for Alire internal use"); - end if; + if This.Map.Contains (Name) then + Raise_Checked_Error + ("Configuration variable '" & (+Name) & "' already defined"); + end if; - if This.Map.Contains (Name) then - if Type_Name_Lower = "build_mode" then - Raise_Checked_Error - ("Configuration variable '" & (+Name) & "' is reserved"); - else - Raise_Checked_Error - ("Configuration variable '" & (+Name) & "' already defined"); - end if; - end if; + declare + Setting : Config_Setting; + begin + Setting.Type_Def.Replace_Element (Type_Def); + Setting.Value := TOML.No_TOML_Value; + This.Map.Insert (Name, Setting); + end; + end Add_Definition; - declare - Setting : Config_Setting; - begin - Setting.Type_Def.Replace_Element (Type_Def); - Setting.Value := TOML.No_TOML_Value; - This.Map.Insert (Name, Setting); - end; - end Add_Definition; + ---------------------- + -- Load_Definitions -- + ---------------------- + + procedure Load_Definitions (This : in out Global_Config; + Root : in out Roots.Root; + Crate : Crate_Name) + is Rel : constant Releases.Release := Root.Release (Crate); begin -- Add built-in definition - Add_Definition (Alire.Properties.Configurations.Builtin_Build_Mode); + This.Add_Definition (Crate, + Properties.Configurations.Builtin_Build_Profile); for Prop of Rel.On_Platform_Properties (Root.Environment, Config_Type_Definition'Tag) loop - Add_Definition (Config_Type_Definition (Prop)); + This.Add_Definition (Crate, Config_Type_Definition (Prop)); end loop; end Load_Definitions; - ------------------- - -- Load_Settings -- - ------------------- + --------------- + -- Set_Value -- + --------------- - procedure Load_Settings (This : in out Global_Config; - Root : in out Roots.Root; - Crate : Crate_Name) + procedure Set_Value (This : in out Global_Config; + Crate : Crate_Name; + Val : Assignment) is + Val_Name_Lower : constant String := + Ada.Characters.Handling.To_Lower (+Val.Name); + Crate_Str : constant String := +Crate; + Name : constant Unbounded_String := (+Crate_Str) & "." & Val_Name_Lower; + begin - Rel : constant Releases.Release := Root.Release (Crate); + -- TODO check if setting configuration of a dependency - --------------- - -- Set_Value -- - --------------- + if not This.Map.Contains (Name) then + Raise_Checked_Error + ("Unknown configuration variable '" & (+Name) & "'"); + end if; - procedure Set_Value (Crate : Unbounded_String; Val : Assignment) is - Val_Name_Lower : constant String := - Ada.Characters.Handling.To_Lower (+Val.Name); - Name : constant Unbounded_String := Crate & "." & Val_Name_Lower; + declare + Ref : constant Config_Maps.Reference_Type := + This.Map.Reference (Name); begin - -- TODO check if setting configuration of a dependency + if not Valid (Ref.Type_Def.Element, Val.Value) then + Raise_Checked_Error + ("Invalid value from '" & Crate_Str & + "'" & " for type " & Image (Ref.Type_Def.Element)); + end if; - if not This.Map.Contains (Name) then + if Ref.Value /= No_TOML_Value and then Ref.Value /= Val.Value then Raise_Checked_Error - ("Unknown configuration variable '" & (+Name) & "'"); + ("Conflicting value for configuration variable '" & + (+Name) & "' from '" & (+Ref.Set_By) & "' and '" + & (+Crate) & "'."); + else + Ref.Value := Val.Value; + Ref.Set_By := +(+Crate); end if; + end; + end Set_Value; - declare - Ref : constant Config_Maps.Reference_Type := - This.Map.Reference (Name); - begin + ------------------- + -- Load_Settings -- + ------------------- - if not Valid (Ref.Type_Def.Element, Val.Value) then - Raise_Checked_Error - ("Invalid value from '" & (+Crate) & - "'" & " for type " & Image (Ref.Type_Def.Element)); - end if; + procedure Load_Settings (This : in out Global_Config; + Root : in out Roots.Root; + Crate : Crate_Name) + is - if Ref.Value /= No_TOML_Value and then Ref.Value /= Val.Value then - Raise_Checked_Error - ("Conflicting value for configuration variable '" & - (+Name) & "' from '" & (+Ref.Set_By) & "' and '" - & (+Crate) & "'."); - else - Ref.Value := Val.Value; - Ref.Set_By := +(+Crate); - end if; - end; - end Set_Value; + Rel : constant Releases.Release := Root.Release (Crate); begin @@ -404,7 +572,7 @@ package body Alire.Crate_Configuration is Config_Value_Assignment (Prop); begin for Elt of List.List loop - Set_Value (List.Crate, Elt); + This.Set_Value (To_Name (+List.Crate), Elt); end loop; end; end loop; diff --git a/src/alire/alire-crate_configuration.ads b/src/alire/alire-crate_configuration.ads index 1e560129f..4e0a93919 100644 --- a/src/alire/alire-crate_configuration.ads +++ b/src/alire/alire-crate_configuration.ads @@ -7,6 +7,9 @@ private with Ada.Strings.Unbounded; private with Ada.Containers.Hashed_Maps; private with Ada.Strings.Unbounded.Hash; private with Ada.Containers.Indefinite_Holders; +private with Ada.Containers.Indefinite_Ordered_Maps; + +private with Alire.Utils.Switches; package Alire.Crate_Configuration is @@ -21,6 +24,8 @@ package Alire.Crate_Configuration is private use Alire.Properties.Configurations; + use type Alire.Utils.Switches.Profile_Kind; + use type Alire.Utils.Switches.Switch_List; package Config_Type_Definition_Holder is new Ada.Containers.Indefinite_Holders (Config_Type_Definition); @@ -37,18 +42,37 @@ private Hash => Ada.Strings.Unbounded.Hash, Equivalent_Keys => Ada.Strings.Unbounded."="); + package Profile_Maps + is new Ada.Containers.Indefinite_Ordered_Maps + (Crate_Name, Alire.Utils.Switches.Profile_Kind); + + package Switches_Maps + is new Ada.Containers.Indefinite_Ordered_Maps + (Crate_Name, Alire.Utils.Switches.Switch_List); + type Global_Config is tagged limited record Map : Config_Maps.Map; + + Profile_Map : Profile_Maps.Map; + Switches_Map : Switches_Maps.Map; end record; procedure Use_Default_Values (Conf : in out Global_Config); -- Use default value for unset variable, raise Checked_Error if a variable -- has no default value. + procedure Add_Definition (This : in out Global_Config; + Crate : Crate_Name; + Type_Def : Config_Type_Definition); + procedure Load_Definitions (This : in out Global_Config; Root : in out Roots.Root; Crate : Crate_Name); + procedure Set_Value (This : in out Global_Config; + Crate : Crate_Name; + Val : Assignment); + procedure Load_Settings (This : in out Global_Config; Root : in out Roots.Root; Crate : Crate_Name); @@ -58,11 +82,11 @@ private Filepath : Absolute_Path; Version : String); - procedure Generate_GPR_Config (This : Global_Config; - Crate : Crate_Name; - Filepath : Absolute_Path; - Withs : AAA.Strings.Set; - Version : String); + procedure Generate_GPR_Config (This : Global_Config; + Crate : Crate_Name; + Filepath : Absolute_Path; + Withs : AAA.Strings.Set; + Version : String); procedure Generate_C_Config (This : Global_Config; Crate : Crate_Name; diff --git a/src/alire/alire-properties-build_profile.adb b/src/alire/alire-properties-build_profile.adb new file mode 100644 index 000000000..e1bbb0bd0 --- /dev/null +++ b/src/alire/alire-properties-build_profile.adb @@ -0,0 +1,173 @@ +with Alire.TOML_Keys; + +with Alire.Utils.Switches; use Alire.Utils.Switches; + +package body Alire.Properties.Build_Profile is + + ----------- + -- Image -- + ----------- + + overriding + function Image (This : Variable) return String is + ("Build Profile: "); + + --------- + -- Key -- + --------- + + overriding + function Key (This : Variable) return String is + pragma Unreferenced (This); + begin + return TOML_Keys.Build_Profile; + end Key; + + --------------- + -- From_TOML -- + --------------- + + function From_TOML (From : TOML_Adapters.Key_Queue) + return Conditional.Properties + is + use type Conditional.Properties; + use TOML; + Env : TOML_Value; + + Var : Variable; + begin + if From.Unwrap.Kind /= TOML_Table then + From.Checked_Error + ("Build: table with assignments expected, but got: " + & From.Unwrap.Kind'Img); + end if; + + if From.Pop_Single_Table (Env, TOML_Table) /= TOML_Keys.Build_Profile + then + raise Program_Error; + -- Can't happen, unless the dispatch to us itself was erroneous + end if; + + Var.T := Env.Clone; + + -- Check that the data is valid + for Crate of Env.Keys loop + declare + Crate_Str : constant String := +Crate; + Profile : constant TOML_Value := Env.Get (Crate); + begin + + Trace.Always ("Build profiles: Crate: '" & Crate_Str & "'"); + + if Profile.Kind /= TOML_String then + From.Checked_Error ("Should be string"); + end if; + + declare + Profile_Str : constant String := Profile.As_String; + begin + + if Crate_Str = "*" then + + Trace.Always ("We have a wildcard!!!"); + + if Var.Wildcard_Found then + From.Checked_Error + ("Multiple definition of wildcard (""*"")" & + " build profile"); + else + Var.Wildcard_Found := True; + end if; + + elsif not Is_Valid_Name (Crate_Str) then + From.Checked_Error + ("Invalid crate name for build profile (" & + Error_In_Name (Crate_Str) & ")"); + else + + declare + Unused : Profile_Kind; + begin + Unused := Profile_Kind'Value (Profile_Str); + exception + when Constraint_Error => + From.Checked_Error + ("Invalid build profile name: '" & Profile_Str + & "' for '" & Crate_Str & "'"); + end; + end if; + end; + + Env.Unset (+Crate); + end; + end loop; + + return Props : Conditional.Properties do + Props := Props and Var; + end return; + end From_TOML; + + ------------- + -- To_TOML -- + ------------- + + overriding + function To_TOML (This : Variable) return TOML.TOML_Value is + begin + return This.T.Clone; + end To_TOML; + + ------------- + -- To_YAML -- + ------------- + + overriding + function To_YAML (This : Variable) return String + is ("Build profile: []"); + + --------------- + -- Selection -- + --------------- + + function Selection (This : Variable) return Profile_Selection_Maps.Map + is + begin + return Result : Profile_Selection_Maps.Map do + for Crate of This.T.Keys loop + Trace.Always ("Building selection map: " & (+Crate)); + if (+Crate) /= "*" then + declare + Val : constant TOML.TOML_Value := This.T.Get (Crate); + begin + Result.Insert (+(+Crate), + Profile_Kind'Value (Val.As_String)); + end; + end if; + end loop; + end return; + end Selection; + + ------------------ + -- Has_Wildcard -- + ------------------ + + function Has_Wildcard (This : Variable) return Boolean is + begin + return This.Wildcard_Found; + end Has_Wildcard; + + -------------- + -- Wildcard -- + -------------- + + function Wildcard (This : Variable) return Profile_Kind is + begin + for Crate of This.T.Keys loop + if (+Crate) = "*" then + return Profile_Kind'Value (This.T.Get (Crate).As_String); + end if; + end loop; + raise Program_Error; + end Wildcard; + +end Alire.Properties.Build_Profile; diff --git a/src/alire/alire-properties-build_profile.ads b/src/alire/alire-properties-build_profile.ads new file mode 100644 index 000000000..4fd5b21be --- /dev/null +++ b/src/alire/alire-properties-build_profile.ads @@ -0,0 +1,51 @@ +with Ada.Containers.Indefinite_Ordered_Maps; + +with Alire.Conditional; +with Alire.TOML_Adapters; +with Alire.Utils.Switches; + +private with TOML; + +package Alire.Properties.Build_Profile with Preelaborate is + + use type Utils.Switches.Profile_Kind; + + package Profile_Selection_Maps + is new Ada.Containers.Indefinite_Ordered_Maps + (Crate_Name, + Utils.Switches.Profile_Kind); + + type Variable is new Property with private; + + function Selection (This : Variable) return Profile_Selection_Maps.Map; + + function Has_Wildcard (This : Variable) return Boolean; + + function Wildcard (This : Variable) return Utils.Switches.Profile_Kind + with Pre => This.Has_Wildcard; + + -- Inherited operations + + overriding + function Image (This : Variable) return String; + + overriding + function Key (This : Variable) return String; + + function From_TOML (From : TOML_Adapters.Key_Queue) + return Conditional.Properties; + + overriding + function To_TOML (This : Variable) return TOML.TOML_Value; + + overriding + function To_YAML (This : Variable) return String; + +private + + type Variable is new Property with record + Wildcard_Found : Boolean := False; + T : TOML.TOML_Value; + end record; + +end Alire.Properties.Build_Profile; diff --git a/src/alire/alire-properties-build_switches.adb b/src/alire/alire-properties-build_switches.adb new file mode 100644 index 000000000..8dbc72a51 --- /dev/null +++ b/src/alire/alire-properties-build_switches.adb @@ -0,0 +1,202 @@ +with Alire.TOML_Keys; +with Alire.Utils.Switches; use Alire.Utils.Switches; + +package body Alire.Properties.Build_Switches is + + ----------- + -- Image -- + ----------- + + overriding + function Image (This : Variable) return String is + ("Build Switches: "); + + --------- + -- Key -- + --------- + + overriding + function Key (This : Variable) return String is + pragma Unreferenced (This); + begin + return TOML_Keys.Build_Profile; + end Key; + + -------------------- + -- Parse_Switches -- + -------------------- + + function Parse_Switches (From : TOML_Adapters.Key_Queue; + Cat : Switches_Categories; + V : TOML.TOML_Value) + return Switch_List + is + pragma Unreferenced (Cat); + Result : Switch_List; + begin + case V.Kind is + when TOML_String => + return Empty_List; + when TOML_Array => + for Index in 1 .. V.Length loop + Result.Append (V.Item (Index).As_String); + end loop; + when others => + From.Checked_Error + ("Invalid kind for build_switches category. " & + "String or Array of String expected"); + end case; + return Result; + end Parse_Switches; + + pragma Unreferenced (Parse_Switches); + + --------------- + -- From_TOML -- + --------------- + + function From_TOML (From : TOML_Adapters.Key_Queue) + return Conditional.Properties + is + use type Conditional.Properties; + -- use TOML; + -- Env : TOML_Value; + -- + -- Profiles_Names : constant AAA.Strings.Vector := + -- AAA.Strings.Empty_Vector + -- .Append ("*") + -- .Append ("crate") + -- .Append ("release") + -- .Append ("validation") + -- .Append ("dev"); + -- + -- Categories_Names : constant AAA.Strings.Vector := + -- AAA.Strings.Empty_Vector + -- .Append ("optimize") + -- .Append ("debug_info") + -- .Append ("runtime_checks") + -- .Append ("style_checks") + -- .Append ("contracts"); + + Var : Variable; + begin + if From.Unwrap.Kind /= TOML_Table then + From.Checked_Error + ("Build_switches: table with assignments expected, but got: " + & From.Unwrap.Kind'Img); + end if; + + return Props : Conditional.Properties do + Var.T := From.Unwrap; + Props := Props and Var; + end return; + + -- if From.Pop_Single_Table (Env, TOML_Table) /= TOML_Keys.Build_Switches + -- then + -- raise Program_Error; + -- -- Can't happen, unless the dispatch to us itself was erroneous + -- end if; + -- + -- return Props : Conditional.Properties do + -- for Profile of Env.Keys loop + -- declare + -- Var : Variable; -- The env. var. being parsed + -- Categories : constant TOML_Value := Env.Get (Profile); + -- + -- begin + -- + -- Trace.Always ("Build switches: Profile: '" & (+Profile) & "'"); + -- + -- if not Profiles_Names.Contains (+Profile) then + -- From.Checked_Error + -- ("Invalid build profile name: '" & (+Profile) & "'"); + -- end if; + -- + -- if Categories.Kind /= TOML_Table then + -- From.Checked_Error ("Should be table"); + -- end if; + -- + -- for Category of Categories.Keys loop + -- Trace.Always ("Category: '" & (+Category) & "'"); + -- + -- if not Categories_Names.Contains (+Category) then + -- From.Checked_Error + -- ("Invalid build category name: '" & (+Category) & "'"); + -- end if; + -- + -- declare + -- Cat : constant Switches_Categories + -- := Switches_Categories'Value (+Category); + -- + -- Value : constant TOML_Value := Categories.Get (Category); + -- + -- Switches : constant Switch_List := + -- Parse_Switches (From, Cat, Value); + -- begin + -- + -- if (+Profile) = "*" then + -- for P in Build_Profiles loop + -- Var.Switches (P) (Cat) := Switches; + -- Trace.Always + -- (P'Img & "." & Cat'Img & " := [" & + -- Var.Switches (P) (Cat).Flatten (", ") & "]"); + -- end loop; + -- else + -- declare + -- P : constant Build_Profiles := + -- Build_Profiles'Value (+Profile); + -- begin + -- Var.Switches (P) (Cat) := Switches; + -- Trace.Always + -- (P'Img & "." & Cat'Img & " := [" & + -- Var.Switches (P) (Cat).Flatten (", ") & "]"); + -- end; + -- end if; + -- end; + -- + -- end loop; + -- + -- -- Pop entry to avoid upper "unexpected key" errors + -- + -- Env.Unset (+Profile); + -- + -- -- Final assignment + -- + -- Props := Props and Var; + -- end; + -- end loop; + -- + -- end return; + end From_TOML; + + ------------- + -- To_TOML -- + ------------- + + overriding + function To_TOML (This : Variable) return TOML.TOML_Value is + -- use TOML; + -- -- Child : constant TOML_Value := Create_Table; + begin + return This.T; + -- return Result : constant TOML_Value := Create_Table do + -- + -- -- Create the VAR.action.Value nested tables + -- + -- -- Child.Set (AAA.Strings.To_Lower_Case (This.Action'Img), + -- -- Create_String (Value (This))); + -- + -- -- Result.Set (This.Name, Child); + -- null; + -- end return; + end To_TOML; + + ------------- + -- To_YAML -- + ------------- + + overriding + function To_YAML (This : Variable) return String is + ("Build switches: 'TODO'"); + +end Alire.Properties.Build_Switches; diff --git a/src/alire/alire-properties-build_switches.ads b/src/alire/alire-properties-build_switches.ads new file mode 100644 index 000000000..429cde181 --- /dev/null +++ b/src/alire/alire-properties-build_switches.ads @@ -0,0 +1,33 @@ +with Alire.Conditional; +with Alire.TOML_Adapters; + +private with TOML; + +package Alire.Properties.Build_Switches with Preelaborate is + + type Variable is new Property with private; + + -- Inherited operations + + overriding + function Image (This : Variable) return String; + + overriding + function Key (This : Variable) return String; + + function From_TOML (From : TOML_Adapters.Key_Queue) + return Conditional.Properties; + + overriding + function To_TOML (This : Variable) return TOML.TOML_Value; + + overriding + function To_YAML (This : Variable) return String; + +private + + type Variable is new Property with record + T : TOML.TOML_Value; + end record; + +end Alire.Properties.Build_Switches; diff --git a/src/alire/alire-properties-configurations.adb b/src/alire/alire-properties-configurations.adb index 4914cd8c6..1dfdb4606 100644 --- a/src/alire/alire-properties-configurations.adb +++ b/src/alire/alire-properties-configurations.adb @@ -2,6 +2,8 @@ with TOML; use TOML; with Alire.Utils.YAML; +with Alire.Utils.Switches; + with Ada.Characters.Handling; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; @@ -496,28 +498,6 @@ package body Alire.Properties.Configurations is use ASCII; Name : constant String := +This.Name; Indent : constant String := " "; - - function GNAT_Switches (Mode : String; Indent : String := "") - return String - is - begin - pragma Style_Checks ("M120"); - if Mode = "Release" then - return "(""-O3"", -- Optimize for performance" & LF & - Indent & """-gnatp"", -- Supress checks" & LF & - Indent & """-gnatw.X"", -- Disable warnings for No_Exception_Propagation" & LF & - Indent & """-gnatQ"" -- Don't quit. Generate ALI and tree files even if illegalities" & LF & - Indent & ")"; - elsif Mode = "Develop" then - return "(""-Og"", -- Optimize for debug" & LF & - Indent & """-g"", -- Debug info" & LF & - Indent & """-gnatw.X"", -- Disable warnings for No_Exception_Propagation" & LF & - Indent & """-gnatQ"" -- Don't quit. Generate ALI and tree files even if illegalities" & LF & - Indent & ")"; - else - return "()"; - end if; - end GNAT_Switches; begin case This.Kind is @@ -532,12 +512,7 @@ package body Alire.Properties.Configurations is return Indent & "type " & Name & "_Kind is (" & To_String (This.Values, Wrap_With_Quotes => True) & ");" & LF & Indent & Name & " : " & Name & "_Kind := """ & Value.As_String - & """;" - & (if Name = "Build_Mode" - then LF & Indent & "GNAT_Switches := " & - GNAT_Switches (Value.As_String, - Indent & " ") & ";" - else ""); + & """;"; when Real => @@ -914,21 +889,22 @@ package body Alire.Properties.Configurations is end return; end Config_Entry_From_TOML; - ------------------------ - -- Builtin_Build_Mode -- - ------------------------ + --------------------------- + -- Builtin_Build_Profile -- + --------------------------- - function Builtin_Build_Mode return Config_Type_Definition is + function Builtin_Build_Profile return Config_Type_Definition is Ret : constant Config_Type_Definition := (Kind => Enum, - Name => +"Build_Mode", - Default => TOML.Create_String ("Release"), - Values => TOML.Create_Array (Item_Kind => TOML.TOML_String)); + Name => +"Build_Profile", + Default => No_TOML_Value, + Values => TOML.Create_Array); begin - Ret.Values.Append (TOML.Create_String ("Release")); - Ret.Values.Append (TOML.Create_String ("Develop")); + for P in Alire.Utils.Switches.Profile_Kind loop + Ret.Values.Append (TOML.Create_String (P'Img)); + end loop; return Ret; - end Builtin_Build_Mode; + end Builtin_Build_Profile; end Alire.Properties.Configurations; diff --git a/src/alire/alire-properties-configurations.ads b/src/alire/alire-properties-configurations.ads index da568e189..9261c298d 100644 --- a/src/alire/alire-properties-configurations.ads +++ b/src/alire/alire-properties-configurations.ads @@ -94,7 +94,9 @@ package Alire.Properties.Configurations with Preelaborate is function Assignments_From_TOML (From : TOML_Adapters.Key_Queue) return Conditional.Properties; - function Builtin_Build_Mode return Config_Type_Definition; + -- Built-in types -- + + function Builtin_Build_Profile return Config_Type_Definition; private diff --git a/src/alire/alire-properties-from_toml.ads b/src/alire/alire-properties-from_toml.ads index 73ab39192..cd7319be4 100644 --- a/src/alire/alire-properties-from_toml.ads +++ b/src/alire/alire-properties-from_toml.ads @@ -4,6 +4,8 @@ with Alire.Crates; with Alire.Properties.Actions; with Alire.Properties.Configurations; with Alire.Properties.Environment; +with Alire.Properties.Build_Profile; +with Alire.Properties.Build_Switches; with Alire.Properties.Labeled; with Alire.Properties.Licenses; with Alire.Properties.Scenarios; @@ -19,6 +21,8 @@ package Alire.Properties.From_TOML is type Property_Keys is (Actions, Authors, Auto_GPR_With, + Build_Profile, + Build_Switches, Configuration, Description, Environment, @@ -104,20 +108,22 @@ package Alire.Properties.From_TOML is -- provide, shared by all external definitions found therein Release_Loaders : constant Loader_Array (Property_Keys) := - (Actions => Properties.Actions.From_TOML'Access, - Authors => Labeled.From_TOML'Access, - Auto_GPR_With => Bool.From_TOML'Access, - Description => Labeled.From_TOML'Access, - Configuration => + (Actions => Properties.Actions.From_TOML'Access, + Authors => Labeled.From_TOML'Access, + Auto_GPR_With => Bool.From_TOML'Access, + Build_Profile => Properties.Build_Profile.From_TOML'Access, + Build_Switches => Properties.Build_Switches.From_TOML'Access, + Description => Labeled.From_TOML'Access, + Configuration => Properties.Configurations.Config_Entry_From_TOML'Access, - Environment => + Environment => Properties.Environment.From_TOML'Access, - Executables => Labeled.From_TOML'Access, + Executables => Labeled.From_TOML'Access, GPR_Externals | GPR_Set_Externals - => Scenarios.From_TOML'Access, - Hint => null, - Licenses => Properties.Licenses.From_TOML'Access, + => Scenarios.From_TOML'Access, + Hint => null, + Licenses => Properties.Licenses.From_TOML'Access, Long_Description | Maintainers | Maintainers_Logins | @@ -126,7 +132,7 @@ package Alire.Properties.From_TOML is Project_Files | Tags | Version | - Website => Labeled.From_TOML'Access); + Website => Labeled.From_TOML'Access); -- This loader applies to a normal release manifest -- The following array determines which properties accept dynamic @@ -134,6 +140,7 @@ package Alire.Properties.From_TOML is Is_Dynamic : constant array (Property_Keys) of Boolean := (Actions | + Build_Profile | Configuration | Environment | Executables | diff --git a/src/alire/alire-toml_keys.ads b/src/alire/alire-toml_keys.ads index 92d90108f..23ad3714d 100644 --- a/src/alire/alire-toml_keys.ads +++ b/src/alire/alire-toml_keys.ads @@ -9,6 +9,8 @@ package Alire.TOML_Keys with Preelaborate is Author : constant String := "authors"; Auto_GPR_With : constant String := "auto-gpr-with"; Available : constant String := "available"; + Build_Profile : constant String := "build_profile"; + Build_Switches : constant String := "build_switches"; Case_Others : constant String := "..."; Compiler : constant String := "compiler"; Configuration : constant String := "configuration"; diff --git a/src/alire/alire-utils-gnat_switches.ads b/src/alire/alire-utils-gnat_switches.ads new file mode 100644 index 000000000..d87e33927 --- /dev/null +++ b/src/alire/alire-utils-gnat_switches.ads @@ -0,0 +1,24 @@ +with AAA.Strings; + +with Alire.Utils.Switches; use Alire.Utils.Switches; + +package Alire.Utils.GNAT_Switches +with Preelaborate +is + + pragma Style_Checks ("M120"); + + GNAT_Optimize_Performance : constant Switch := "-O3"; + GNAT_Optimize_Debug : constant Switch := "-Og"; + GNAT_Optimize_Size : constant Switch := "-Os"; + GNAT_Enable_Inlining : constant Switch := "-gnatn"; + GNAT_Asserts_And_Contracts : constant Switch := "-gnata"; + GNAT_Debug_Info : constant Switch := "-g"; + GNAT_Supress_Runtime_Check : constant Switch := "-gnatp"; + GNAT_Enable_Overflow_Check : constant Switch := "-gnato"; + GNAT_Disable_Warn_No_Exception_Propagation : constant Switch := "-gnatw.X"; + GNAT_Dont_Quit : constant Switch := "-gnatQ"; + GNAT_All_Warnings : constant Switch := "-gnatwa"; + GNAT_All_Validity_Checks : constant Switch := "-gnatVa"; + GNAT_Warnings_As_Errors : constant Switch := "-gnatwe"; +end Alire.Utils.GNAT_Switches; diff --git a/src/alire/alire-utils-switches-knowledge.adb b/src/alire/alire-utils-switches-knowledge.adb new file mode 100644 index 000000000..5f31fd7a5 --- /dev/null +++ b/src/alire/alire-utils-switches-knowledge.adb @@ -0,0 +1,68 @@ +with Alire.Utils.GNAT_Switches; use Alire.Utils.GNAT_Switches; + +package body Alire.Utils.Switches.Knowledge is + + Builtin_Done : Boolean := False; + + -------------- + -- Get_Info -- + -------------- + + function Get_Info (Sw : Switch) return String + is + begin + if DB.Contains (Sw) then + return DB.Element (Sw); + else + return ""; + end if; + end Get_Info; + + -------------- + -- Register -- + -------------- + + procedure Register (Sw : Switch; + Info : String) + is + begin + DB.Insert (Sw, Info); + end Register; + + -------------- + -- Populate -- + -------------- + + procedure Populate is + begin + if Builtin_Done then + return; + else + Builtin_Done := True; + end if; + + -- Register GNAT switches in the Switches knowledge database + + Register (GNAT_Optimize_Performance, "Optimize for performance"); + Register (GNAT_Optimize_Debug, "Optimize for debug"); + Register (GNAT_Optimize_Size, "Optimize for code size"); + Register (GNAT_Enable_Inlining, "Enable inlining"); + Register (GNAT_Asserts_And_Contracts, "Enable assertions and contracts"); + Register (GNAT_Debug_Info, "Generate debug info"); + Register (GNAT_Supress_Runtime_Check, "Supress run-time checks"); + Register (GNAT_Enable_Overflow_Check, + "Enable numeric overflow checking"); + Register (GNAT_Disable_Warn_No_Exception_Propagation, + "Disable warnings for No_Exception_Propagation"); + Register (GNAT_Dont_Quit, + "Don't quit. Generate ALI and tree files" & + " even if illegalities"); + Register (GNAT_All_Warnings, "Enable all warnings"); + Register (GNAT_All_Validity_Checks, "All validity checks"); + Register (GNAT_Warnings_As_Errors, "Warnings as errors"); + + Trace.Always ("GNAT switches registered"); + + end Populate; + +end Alire.Utils.Switches.Knowledge; diff --git a/src/alire/alire-utils-switches-knowledge.ads b/src/alire/alire-utils-switches-knowledge.ads new file mode 100644 index 000000000..d6d5f9eea --- /dev/null +++ b/src/alire/alire-utils-switches-knowledge.ads @@ -0,0 +1,22 @@ +private with Ada.Containers.Indefinite_Ordered_Maps; + +package Alire.Utils.Switches.Knowledge is + + function Get_Info (Sw : Switch) return String; + + procedure Register (Sw : Switch; + Info : String); + + procedure Populate; + -- Populate the switches knowledge database with built-in switches + +private + + package Switch_Info_Maps + is new Ada.Containers.Indefinite_Ordered_Maps + (Key_Type => Switch, + Element_Type => String); + + DB : Switch_Info_Maps.Map; + +end Alire.Utils.Switches.Knowledge; diff --git a/src/alire/alire-utils-switches.adb b/src/alire/alire-utils-switches.adb new file mode 100644 index 000000000..18e7aafca --- /dev/null +++ b/src/alire/alire-utils-switches.adb @@ -0,0 +1,150 @@ +with Ada.Strings.Unbounded; + +with Alire.Utils.GNAT_Switches; use Alire.Utils.GNAT_Switches; + +package body Alire.Utils.Switches is + + ------------ + -- Append -- + ------------ + + function Append (L : Switch_List; + S : Switch) return Switch_List + is + begin + return R : Switch_List := L do + R.Append (S); + end return; + end Append; + + ------------ + -- Append -- + ------------ + + function Append (L : Switch_List; + S : not null Switch_Access) return Switch_List + is + begin + return L.Append (S.all); + end Append; + + ------------ + -- Append -- + ------------ + + function Append (A, B : Switch_List) return Switch_List is + begin + return R : Switch_List := A.Copy do + for Elt of B loop + R.Append (Elt); + end loop; + end return; + end Append; + + ------------- + -- Flatten -- + ------------- + + function Flatten (L : Switch_List; + Separator : String := " ") + return String + is + use Ada.Strings.Unbounded; + First : Boolean := True; + Result : Unbounded_String; + begin + for Elt of L loop + if First then + Append (Result, Elt); + First := False; + else + Append (Result, Separator & Elt); + end if; + end loop; + return To_String (Result); + end Flatten; + + -------------- + -- Get_List -- + -------------- + + function Get_List (S : Optimization_Switches) return Switch_List + is (case S.Kind is + when Performance => Empty_List + .Append (GNAT_Optimize_Performance) + .Append (GNAT_Enable_Inlining), + when Size => Empty_List + .Append (GNAT_Optimize_Size), + when Debug => Empty_List + .Append (GNAT_Optimize_Debug), + when Custom => S.List); + + -------------- + -- Get_List -- + -------------- + + function Get_List (S : Debug_Info_Switches) return Switch_List + is (case S.Kind is + when No => Empty_List, + when Yes => Empty_List.Append (GNAT_Debug_Info), + when Custom => S.List); + + -------------- + -- Get_List -- + -------------- + + function Get_List (S : Contracts_Switches) return Switch_List + is (case S.Kind is + when No => Empty_List.Append (GNAT_Supress_Runtime_Check), + when Default => Empty_List, + when Everything => Empty_List.Append (GNAT_Enable_Overflow_Check), + when Custom => S.List); + + -------------- + -- Get_List -- + -------------- + + function Get_List (S : Style_Checks_Switches) return Switch_List + is (case S.Kind is + when No => Empty_List, + when Yes => Empty_List + .Append ("-gnaty3") + .Append ("-gnatya") + .Append ("-gnatyA") + .Append ("-gnatB") + .Append ("-gnatyb") + .Append ("-gnatyc") + .Append ("-gnatyD") + .Append ("-gnaty-d") + .Append ("-gnatye") + .Append ("-gnatyf") + .Append ("-gnatyh") + .Append ("-gnatyi") + .Append ("-gnatyI") + .Append ("-gnatyk") + .Append ("-gnatyl") + .Append ("-gnatym") + .Append ("-gnatyn") + .Append ("-gnatyO") + .Append ("-gnatyp") + .Append ("-gnatyr") + .Append ("-gnatyS") + .Append ("-gnatyt") + .Append ("-gnatyu") + .Append ("-gnatyx"), + when Custom => S.List); + + -------------- + -- Get_List -- + -------------- + + function Get_List (C : Switches_Configuration) return Switch_List is + begin + return Empty_List + .Append (Get_List (C.Optimization)) + .Append (Get_List (C.Debug_Info)) + .Append (Get_List (C.Contracts)) + .Append (Get_List (C.Style_Checks)); + end Get_List; + +end Alire.Utils.Switches; diff --git a/src/alire/alire-utils-switches.ads b/src/alire/alire-utils-switches.ads new file mode 100644 index 000000000..2b094ccc0 --- /dev/null +++ b/src/alire/alire-utils-switches.ads @@ -0,0 +1,106 @@ +with Ada.Containers.Indefinite_Doubly_Linked_Lists; + +package Alire.Utils.Switches + with Preelaborate +is + + subtype Switch is String; + type Switch_Access is access all Switch; + + package Switch_Lists + is new Ada.Containers.Indefinite_Doubly_Linked_Lists (Switch); + + type Switch_List is new Switch_Lists.List with null record; + Empty_List : constant Switch_List; + + function Append (L : Switch_List; + S : Switch) return Switch_List; + + function Append (L : Switch_List; + S : not null Switch_Access) return Switch_List; + + function Flatten (L : Switch_List; + Separator : String := " ") + return String; + + type Profile_Kind is (Release, Validation, Development); + type Switches_Categories is (Optimization, + Debug_Info, + Contracts, + Compile_Checks, + Runtime_Checks, + Style_Checks); + + type Optimization_Kind is (Performance, Size, Debug, Custom); + type Debug_Info_Kind is (No, Yes, Custom); + type Contracts_Kind is (No, Default, Everything, Custom); + type Style_Checks_Kind is (No, Yes, Custom); + + type Optimization_Switches (Kind : Optimization_Kind := Performance) + is record + case Kind is + when Custom => List : Switch_List; + when others => null; + end case; + end record; + + type Debug_Info_Switches (Kind : Debug_Info_Kind := No) + is record + case Kind is + when Custom => List : Switch_List; + when others => null; + end case; + end record; + + type Contracts_Switches (Kind : Contracts_Kind := No) + is record + case Kind is + when Custom => List : Switch_List; + when others => null; + end case; + end record; + + type Style_Checks_Switches (Kind : Style_Checks_Kind := No) + is record + case Kind is + when Custom => List : Switch_List; + when others => null; + end case; + end record; + + function Get_List (S : Optimization_Switches) return Switch_List; + function Get_List (S : Debug_Info_Switches) return Switch_List; + function Get_List (S : Contracts_Switches) return Switch_List; + function Get_List (S : Style_Checks_Switches) return Switch_List; + + type Switches_Configuration is record + Optimization : Optimization_Switches; + Debug_Info : Debug_Info_Switches; + Contracts : Contracts_Switches; + Style_Checks : Style_Checks_Switches; + end record; + + function Get_List (C : Switches_Configuration) return Switch_List; + + Default_Release_Switches : constant Switches_Configuration + := (Optimization => (Kind => Performance), + Debug_Info => (Kind => No), + Contracts => (Kind => Default), + Style_Checks => (Kind => No)); + + Default_Validation_Switches : constant Switches_Configuration + := (Optimization => (Kind => Performance), + Debug_Info => (Kind => Yes), + Contracts => (Kind => Everything), + Style_Checks => (Kind => Yes)); + + Default_Development_Switches : constant Switches_Configuration + := (Optimization => (Kind => Debug), + Debug_Info => (Kind => Yes), + Contracts => (Kind => Everything), + Style_Checks => (Kind => Yes)); + +private + Empty_List : constant Switch_List := + (Switch_Lists.Empty_List with null record); +end Alire.Utils.Switches; diff --git a/src/alr/alr-commands-init.adb b/src/alr/alr-commands-init.adb index 19ebe1f85..61af63679 100644 --- a/src/alr/alr-commands-init.adb +++ b/src/alr/alr-commands-init.adb @@ -8,8 +8,6 @@ with Alire.Lockfiles; with Alire.Paths; with Alire.Solutions; with Alire.Utils.User_Input.Query_Config; -with Alire.Properties.Configurations; -with Alr.Utils; with GNATCOLL.VFS; use GNATCOLL.VFS; @@ -114,14 +112,7 @@ package body Alr.Commands.Init is end if; Put_Line ("abstract project " & Mixed_Name & "_Config is"); Put_Line (" Crate_Version := ""0.0.0"";"); - Put_Line ("end " & Mixed_Name & "_Config;"); - declare - use Alire.Properties.Configurations; - Build_Mode : constant Config_Type_Definition := Builtin_Build_Mode; - begin - Put_Line (To_GPR_Declaration (Build_Mode, Default (Build_Mode))); - end; TIO.Put (File, "end " & Mixed_Name & "_Config;"); TIO.Close (File); @@ -154,65 +145,6 @@ package body Alr.Commands.Init is Put_Line (" for Main use (""" & Lower_Name & ".adb"");"); end if; Put_New_Line; -<<<<<<< HEAD - Put_Line (" type Enabled_Kind is (""enabled"", ""disabled"");"); - Put_Line (" Compile_Checks : Enabled_Kind := External (""" & Upper_Name & "_COMPILE_CHECKS"", ""disabled"");"); - Put_Line (" Runtime_Checks : Enabled_Kind := External (""" & Upper_Name & "_RUNTIME_CHECKS"", ""disabled"");"); - Put_Line (" Style_Checks : Enabled_Kind := External (""" & Upper_Name & "_STYLE_CHECKS"", ""disabled"");"); - Put_Line (" Contracts_Checks : Enabled_Kind := External (""" & Upper_Name & "_CONTRACTS"", ""disabled"");"); - Put_New_Line; - Put_Line (" type Build_Kind is (""debug"", ""optimize"");"); - Put_Line (" Build_Mode : Build_Kind := External (""" & Upper_Name & "_BUILD_MODE"", ""optimize"");"); - Put_New_Line; - Put_Line (" Compile_Checks_Switches := ();"); - Put_Line (" case Compile_Checks is"); - Put_Line (" when ""enabled"" =>"); - Put_Line (" Compile_Checks_Switches :="); - Put_Line (" (""-gnatwa"", -- All warnings"); - Put_Line (" ""-gnatVa"", -- All validity checks"); - Put_Line (" ""-gnatwe""); -- Warnings as errors"); - Put_Line (" when others => null;"); - Put_Line (" end case;"); - Put_New_Line; - Put_Line (" Runtime_Checks_Switches := ();"); - Put_Line (" case Runtime_Checks is"); - Put_Line (" when ""enabled"" => null;"); - Put_Line (" when others =>"); - Put_Line (" Runtime_Checks_Switches :="); - Put_Line (" (""-gnatp""); -- Suppress checks"); - Put_Line (" end case;"); - Put_New_Line; - Put_Line (" Style_Checks_Switches := ();"); - Put_Line (" case Style_Checks is"); - Put_Line (" when ""enabled"" =>"); - Put_Line (" Style_Checks_Switches :="); - Put_Line (" (""-gnatyg"", -- GNAT Style checks"); - Put_Line (" ""-gnaty-d"", -- Disable no DOS line terminators"); - Put_Line (" ""-gnatyM80"", -- Maximum line length"); - Put_Line (" ""-gnatyO""); -- Overriding subprograms explicitly marked as such"); - Put_Line (" when others => null;"); - Put_Line (" end case;"); - Put_New_Line; - Put_Line (" Contracts_Switches := ();"); - Put_Line (" case Contracts_Checks is"); - Put_Line (" when ""enabled"" =>"); - Put_Line (" Contracts_Switches :="); - Put_Line (" (""-gnata""); -- Enable assertions and contracts"); - Put_Line (" when others => null;"); - Put_Line (" end case;"); - Put_New_Line; - Put_Line (" Build_Switches := ();"); - Put_Line (" case Build_Mode is"); - Put_Line (" when ""optimize"" =>"); - Put_Line (" Build_Switches := (""-O3"", -- Optimization"); - Put_Line (" ""-gnatn""); -- Enable inlining"); - Put_Line (" when ""debug"" =>"); - Put_Line (" Build_Switches := (""-g"", -- Debug info"); - Put_Line (" ""-Og""); -- No optimization"); - Put_Line (" end case;"); - Put_New_Line; -======= ->>>>>>> e8652207... Build profiles prototype Put_Line (" package Compiler is"); Put_Line (" for Default_Switches (""Ada"") use " & Mixed_Name & "_Config.GNAT_Switches;"); Put_Line (" end Compiler;"); From 72ec39550ef46669690f5b4a9657153c76d88553 Mon Sep 17 00:00:00 2001 From: Fabien Chouteau Date: Tue, 23 Nov 2021 18:07:58 +0100 Subject: [PATCH 3/9] First version of build_switches support --- src/alire/alire-crate_configuration.adb | 36 ++- src/alire/alire-properties-build_profile.adb | 9 +- src/alire/alire-properties-build_switches.adb | 158 ++---------- src/alire/alire-properties-build_switches.ads | 4 + src/alire/alire-utils-switches-knowledge.adb | 37 ++- src/alire/alire-utils-switches-modifiers.adb | 238 ++++++++++++++++++ src/alire/alire-utils-switches-modifiers.ads | 48 ++++ src/alire/alire-utils-switches.adb | 40 ++- src/alire/alire-utils-switches.ads | 62 +++-- src/alr/alr-commands-init.adb | 4 +- 10 files changed, 455 insertions(+), 181 deletions(-) create mode 100644 src/alire/alire-utils-switches-modifiers.adb create mode 100644 src/alire/alire-utils-switches-modifiers.ads diff --git a/src/alire/alire-crate_configuration.adb b/src/alire/alire-crate_configuration.adb index 676eaf400..90b863b35 100644 --- a/src/alire/alire-crate_configuration.adb +++ b/src/alire/alire-crate_configuration.adb @@ -11,8 +11,10 @@ with Alire.Origins; with Alire.Warnings; with Alire.Properties.Build_Profile; +with Alire.Properties.Build_Switches; with Alire.Utils.Switches; use Alire.Utils.Switches; with Alire.Utils.Switches.Knowledge; +with Alire.Utils.Switches.Modifiers; with Alire.Directories; with TOML; use TOML; @@ -118,18 +120,40 @@ package body Alire.Crate_Configuration is Profile : constant Profile_Kind := This.Profile_Map.Element (Rel.Name); - List : Alire.Utils.Switches.Switch_List; + Config : Alire.Utils.Switches.Switches_Configuration + := (case Profile is + when Release => Default_Release_Switches, + when Validation => Default_Validation_Switches, + when Development => Default_Development_Switches); + + Modif : Alire.Utils.Switches.Modifiers.Profile_Modifier; begin + + -- Get switches modifier from the release + for Prop of Rel.On_Platform_Properties + (Root.Environment, + Properties.Build_Switches.Variable'Tag) + loop + declare + Prof : constant Properties.Build_Switches.Variable + := Properties.Build_Switches.Variable (Prop); + begin + Modif := Prof.Modifier; + end; + end loop; + + Alire.Utils.Switches.Modifiers.Apply (Config, Modif.Wildcard); + case Profile is when Release => - List := Get_List (Default_Release_Switches); + Modifiers.Apply (Config, Modif.Release); when Validation => - List := Get_List (Default_Validation_Switches); + Modifiers.Apply (Config, Modif.Validation); when Development => - List := Get_List (Default_Development_Switches); + Modifiers.Apply (Config, Modif.Development); end case; - This.Switches_Map.Insert (Rel.Name, List); + This.Switches_Map.Insert (Rel.Name, Get_List (Config)); end; end loop; end Make_Swiches_Map; @@ -462,8 +486,6 @@ package body Alire.Crate_Configuration is Name : constant Unbounded_String := +(+Crate & "." & Type_Name_Lower); begin - Trace.Always ("Add_Defintion: " & (+Name)); - if Is_Reserved_Name (Type_Name_Lower) then Raise_Checked_Error ("Configuration variable name '" & (+Name) & diff --git a/src/alire/alire-properties-build_profile.adb b/src/alire/alire-properties-build_profile.adb index e1bbb0bd0..9a9a5dde7 100644 --- a/src/alire/alire-properties-build_profile.adb +++ b/src/alire/alire-properties-build_profile.adb @@ -9,8 +9,8 @@ package body Alire.Properties.Build_Profile is ----------- overriding - function Image (This : Variable) return String is - ("Build Profile: "); + function Image (This : Variable) return String + is ("Build Profile: "); --------- -- Key -- @@ -57,8 +57,6 @@ package body Alire.Properties.Build_Profile is Profile : constant TOML_Value := Env.Get (Crate); begin - Trace.Always ("Build profiles: Crate: '" & Crate_Str & "'"); - if Profile.Kind /= TOML_String then From.Checked_Error ("Should be string"); end if; @@ -69,8 +67,6 @@ package body Alire.Properties.Build_Profile is if Crate_Str = "*" then - Trace.Always ("We have a wildcard!!!"); - if Var.Wildcard_Found then From.Checked_Error ("Multiple definition of wildcard (""*"")" & @@ -134,7 +130,6 @@ package body Alire.Properties.Build_Profile is begin return Result : Profile_Selection_Maps.Map do for Crate of This.T.Keys loop - Trace.Always ("Building selection map: " & (+Crate)); if (+Crate) /= "*" then declare Val : constant TOML.TOML_Value := This.T.Get (Crate); diff --git a/src/alire/alire-properties-build_switches.adb b/src/alire/alire-properties-build_switches.adb index 8dbc72a51..3f3628a42 100644 --- a/src/alire/alire-properties-build_switches.adb +++ b/src/alire/alire-properties-build_switches.adb @@ -3,6 +3,17 @@ with Alire.Utils.Switches; use Alire.Utils.Switches; package body Alire.Properties.Build_Switches is + -------------- + -- Modifier -- + -------------- + + function Modifier (This : Variable) + return Alire.Utils.Switches.Modifiers.Profile_Modifier + is + begin + return Alire.Utils.Switches.Modifiers.From_TOML (This.T); + end Modifier; + ----------- -- Image -- ----------- @@ -22,35 +33,6 @@ package body Alire.Properties.Build_Switches is return TOML_Keys.Build_Profile; end Key; - -------------------- - -- Parse_Switches -- - -------------------- - - function Parse_Switches (From : TOML_Adapters.Key_Queue; - Cat : Switches_Categories; - V : TOML.TOML_Value) - return Switch_List - is - pragma Unreferenced (Cat); - Result : Switch_List; - begin - case V.Kind is - when TOML_String => - return Empty_List; - when TOML_Array => - for Index in 1 .. V.Length loop - Result.Append (V.Item (Index).As_String); - end loop; - when others => - From.Checked_Error - ("Invalid kind for build_switches category. " & - "String or Array of String expected"); - end case; - return Result; - end Parse_Switches; - - pragma Unreferenced (Parse_Switches); - --------------- -- From_TOML -- --------------- @@ -59,24 +41,8 @@ package body Alire.Properties.Build_Switches is return Conditional.Properties is use type Conditional.Properties; - -- use TOML; - -- Env : TOML_Value; - -- - -- Profiles_Names : constant AAA.Strings.Vector := - -- AAA.Strings.Empty_Vector - -- .Append ("*") - -- .Append ("crate") - -- .Append ("release") - -- .Append ("validation") - -- .Append ("dev"); - -- - -- Categories_Names : constant AAA.Strings.Vector := - -- AAA.Strings.Empty_Vector - -- .Append ("optimize") - -- .Append ("debug_info") - -- .Append ("runtime_checks") - -- .Append ("style_checks") - -- .Append ("contracts"); + use TOML; + Env : TOML_Value; Var : Variable; begin @@ -86,87 +52,17 @@ package body Alire.Properties.Build_Switches is & From.Unwrap.Kind'Img); end if; + if From.Pop_Single_Table (Env, TOML_Table) /= TOML_Keys.Build_Switches + then + raise Program_Error; + -- Can't happen, unless the dispatch to us itself was erroneous + end if; + return Props : Conditional.Properties do - Var.T := From.Unwrap; + Var.T := Env.Clone; Props := Props and Var; end return; - -- if From.Pop_Single_Table (Env, TOML_Table) /= TOML_Keys.Build_Switches - -- then - -- raise Program_Error; - -- -- Can't happen, unless the dispatch to us itself was erroneous - -- end if; - -- - -- return Props : Conditional.Properties do - -- for Profile of Env.Keys loop - -- declare - -- Var : Variable; -- The env. var. being parsed - -- Categories : constant TOML_Value := Env.Get (Profile); - -- - -- begin - -- - -- Trace.Always ("Build switches: Profile: '" & (+Profile) & "'"); - -- - -- if not Profiles_Names.Contains (+Profile) then - -- From.Checked_Error - -- ("Invalid build profile name: '" & (+Profile) & "'"); - -- end if; - -- - -- if Categories.Kind /= TOML_Table then - -- From.Checked_Error ("Should be table"); - -- end if; - -- - -- for Category of Categories.Keys loop - -- Trace.Always ("Category: '" & (+Category) & "'"); - -- - -- if not Categories_Names.Contains (+Category) then - -- From.Checked_Error - -- ("Invalid build category name: '" & (+Category) & "'"); - -- end if; - -- - -- declare - -- Cat : constant Switches_Categories - -- := Switches_Categories'Value (+Category); - -- - -- Value : constant TOML_Value := Categories.Get (Category); - -- - -- Switches : constant Switch_List := - -- Parse_Switches (From, Cat, Value); - -- begin - -- - -- if (+Profile) = "*" then - -- for P in Build_Profiles loop - -- Var.Switches (P) (Cat) := Switches; - -- Trace.Always - -- (P'Img & "." & Cat'Img & " := [" & - -- Var.Switches (P) (Cat).Flatten (", ") & "]"); - -- end loop; - -- else - -- declare - -- P : constant Build_Profiles := - -- Build_Profiles'Value (+Profile); - -- begin - -- Var.Switches (P) (Cat) := Switches; - -- Trace.Always - -- (P'Img & "." & Cat'Img & " := [" & - -- Var.Switches (P) (Cat).Flatten (", ") & "]"); - -- end; - -- end if; - -- end; - -- - -- end loop; - -- - -- -- Pop entry to avoid upper "unexpected key" errors - -- - -- Env.Unset (+Profile); - -- - -- -- Final assignment - -- - -- Props := Props and Var; - -- end; - -- end loop; - -- - -- end return; end From_TOML; ------------- @@ -175,20 +71,8 @@ package body Alire.Properties.Build_Switches is overriding function To_TOML (This : Variable) return TOML.TOML_Value is - -- use TOML; - -- -- Child : constant TOML_Value := Create_Table; begin - return This.T; - -- return Result : constant TOML_Value := Create_Table do - -- - -- -- Create the VAR.action.Value nested tables - -- - -- -- Child.Set (AAA.Strings.To_Lower_Case (This.Action'Img), - -- -- Create_String (Value (This))); - -- - -- -- Result.Set (This.Name, Child); - -- null; - -- end return; + return This.T.Clone; end To_TOML; ------------- diff --git a/src/alire/alire-properties-build_switches.ads b/src/alire/alire-properties-build_switches.ads index 429cde181..f8108f7ee 100644 --- a/src/alire/alire-properties-build_switches.ads +++ b/src/alire/alire-properties-build_switches.ads @@ -1,5 +1,6 @@ with Alire.Conditional; with Alire.TOML_Adapters; +with Alire.Utils.Switches.Modifiers; private with TOML; @@ -7,6 +8,9 @@ package Alire.Properties.Build_Switches with Preelaborate is type Variable is new Property with private; + function Modifier (This : Variable) + return Alire.Utils.Switches.Modifiers.Profile_Modifier; + -- Inherited operations overriding diff --git a/src/alire/alire-utils-switches-knowledge.adb b/src/alire/alire-utils-switches-knowledge.adb index 5f31fd7a5..919b086d6 100644 --- a/src/alire/alire-utils-switches-knowledge.adb +++ b/src/alire/alire-utils-switches-knowledge.adb @@ -43,6 +43,8 @@ package body Alire.Utils.Switches.Knowledge is -- Register GNAT switches in the Switches knowledge database + pragma Style_Checks ("M200"); + Register (GNAT_Optimize_Performance, "Optimize for performance"); Register (GNAT_Optimize_Debug, "Optimize for debug"); Register (GNAT_Optimize_Size, "Optimize for code size"); @@ -50,18 +52,37 @@ package body Alire.Utils.Switches.Knowledge is Register (GNAT_Asserts_And_Contracts, "Enable assertions and contracts"); Register (GNAT_Debug_Info, "Generate debug info"); Register (GNAT_Supress_Runtime_Check, "Supress run-time checks"); - Register (GNAT_Enable_Overflow_Check, - "Enable numeric overflow checking"); - Register (GNAT_Disable_Warn_No_Exception_Propagation, - "Disable warnings for No_Exception_Propagation"); - Register (GNAT_Dont_Quit, - "Don't quit. Generate ALI and tree files" & - " even if illegalities"); + Register (GNAT_Enable_Overflow_Check, "Enable numeric overflow checking"); + Register (GNAT_Disable_Warn_No_Exception_Propagation, "Disable warnings for No_Exception_Propagation"); + Register (GNAT_Dont_Quit, "Don't quit. Generate ALI and tree files even if illegalities"); Register (GNAT_All_Warnings, "Enable all warnings"); Register (GNAT_All_Validity_Checks, "All validity checks"); Register (GNAT_Warnings_As_Errors, "Warnings as errors"); - Trace.Always ("GNAT switches registered"); + Register ("-gnaty3", "Specify indentation level of 3"); + Register ("-gnatya", "Check attribute casing"); + Register ("-gnatyA", "Use of array index numbers in array attributes"); + Register ("-gnatyB", "Check Boolean operators"); + Register ("-gnatyb", "Blanks not allowed at statement end"); + Register ("-gnatyc", "Check comments"); + Register ("-gnaty-d", "Disable check no DOS line terminators present"); + Register ("-gnatyD", "Check declared identifiers in mixed case"); + Register ("-gnatye", "Check end/exit labels"); + Register ("-gnatyf", "No form feeds or vertical tabs"); + Register ("-gnatyh", "No horizontal tabs"); + Register ("-gnatyi", "Check if-then layout"); + Register ("-gnatyI", "check mode IN keywords"); + Register ("-gnatyk", "Check keyword casing"); + Register ("-gnatyl", "Check layout"); + Register ("-gnatym", "Check maximum line length"); + Register ("-gnatyn", "Check casing of entities in Standard"); + Register ("-gnatyO", "Check that overriding subprograms are explicitly marked as such"); + Register ("-gnatyp", "Check pragma casing"); + Register ("-gnatyr", "Check identifier references casing"); + Register ("-gnatyS", "Check no statements after THEN/ELSE"); + Register ("-gnatyt", "Check token spacing"); + Register ("-gnatyu", "Check unnecessary blank lines"); + Register ("-gnatyx", "Check extra parentheses"); end Populate; diff --git a/src/alire/alire-utils-switches-modifiers.adb b/src/alire/alire-utils-switches-modifiers.adb new file mode 100644 index 000000000..d10dae3e6 --- /dev/null +++ b/src/alire/alire-utils-switches-modifiers.adb @@ -0,0 +1,238 @@ +with TOML; use TOML; + +package body Alire.Utils.Switches.Modifiers is + + --------------- + -- From_TOML -- + --------------- + + function From_TOML (Cat : Switches_Categories; + T : TOML.TOML_Value) + return Switches_Modifier + is + Result : Switches_Modifier (Cat); + List : Switch_List; + begin + + if T.Kind = TOML_Array then + + -- We have a custom list of switches + + for Index in 1 .. T.Length loop + List.Append (T.Item (Index).As_String); + end loop; + + case Cat is + when Optimization => + Result.Optimization := (Custom, List); + when Debug_Info => + Result.Debug_Info := (Custom, List); + when Contracts => + Result.Contracts := (Custom, List); + when Style_Checks => + Result.Style_Checks := (Custom, List); + when others => + raise Program_Error; -- TODO + end case; + + elsif T.Kind = TOML_String then + + begin + case Cat is + when Optimization => + declare + K : constant Optimization_Kind := + Optimization_Kind'Value (T.As_String); + begin + Result.Optimization := + (case K is + when Performance => (Kind => Performance), + when Size => (Kind => Size), + when Debug => (Kind => Debug), + when Custom => raise Constraint_Error); + end; + + when Debug_Info => + declare + K : constant Debug_Info_Kind := + Debug_Info_Kind'Value (T.As_String); + begin + Result.Debug_Info := + (case K is + when No => (Kind => No), + when Yes => (Kind => Yes), + when Custom => raise Constraint_Error); + end; + + when Runtime_Checks => + declare + K : constant Runtime_Checks_Kind := + Runtime_Checks_Kind'Value (T.As_String); + begin + Result.Runtime_Checks := + (case K is + when None => (Kind => None), + when Default => (Kind => Default), + when Overflow => (Kind => Overflow), + when Everything => (Kind => Everything), + when Custom => raise Constraint_Error); + end; + + when Compile_Checks => + declare + K : constant Compile_Checks_Kind := + Compile_Checks_Kind'Value (T.As_String); + begin + Result.Compile_Checks := + (case K is + when None => (Kind => None), + when Warnings => (Kind => Warnings), + when Errors => (Kind => Errors), + when Custom => raise Constraint_Error); + end; + + when Contracts => + declare + K : constant Contracts_Kind := + Contracts_Kind'Value (T.As_String); + begin + Result.Contracts := + (case K is + when No => (Kind => No), + when Yes => (Kind => Yes), + when Custom => raise Constraint_Error); + end; + + when Style_Checks => + declare + K : constant Style_Checks_Kind := + Style_Checks_Kind'Value (T.As_String); + begin + Result.Style_Checks := + (case K is + when No => (Kind => No), + when Yes => (Kind => Yes), + when Custom => raise Constraint_Error); + end; + + end case; + exception + when Constraint_Error => + Raise_Checked_Error + ("Invalid switch selector '" & T.As_String & + "' for catergory '" & Cat'Img & "'"); + end; + + else + raise Program_Error; + end if; + + return Result; + end From_TOML; + + --------------- + -- From_TOML -- + --------------- + + function From_TOML (T : TOML.TOML_Value) + return Switches_Modifier_Lists.List + is + List : Switches_Modifier_Lists.List; + begin + if T.Kind /= TOML_Table then + raise Program_Error; + end if; + + for Key of T.Keys loop + + declare + Cat : Switches_Categories; + begin + Cat := Switches_Categories'Value (+Key); + Trace.Always (+Key); + List.Append (From_TOML (Cat, T.Get (Key))); + end; + end loop; + + return List; + end From_TOML; + + ----------- + -- Apply -- + ----------- + + procedure Apply (Sw : in out Switches_Configuration; + M : Switches_Modifier) + is + begin + case M.Cat is + when Optimization => + Sw.Optimization := M.Optimization; + when Debug_Info => + Sw.Debug_Info := M.Debug_Info; + when Runtime_Checks => + Sw.Runtime_Checks := M.Runtime_Checks; + when Compile_Checks => + Sw.Compile_Checks := M.Compile_Checks; + when Contracts => + Sw.Contracts := M.Contracts; + when Style_Checks => + Sw.Style_Checks := M.Style_Checks; + end case; + end Apply; + + ----------- + -- Apply -- + ----------- + + procedure Apply (Sw : in out Switches_Configuration; + L : Switches_Modifier_Lists.List) + is + begin + for Elt of L loop + Apply (Sw, Elt); + end loop; + end Apply; + + --------------- + -- From_TOML -- + --------------- + + function From_TOML (T : TOML.TOML_Value) + return Profile_Modifier + is + Result : Profile_Modifier; + begin + if T.Kind /= TOML_Table then + raise Program_Error; + end if; + + for Key of T.Keys loop + if (+Key) = "*" then + Result.Wildcard := From_TOML (T.Get (Key)); + else + declare + Prof : Profile_Kind; + begin + Prof := Profile_Kind'Value (+Key); + + case Prof is + when Release => + Result.Release := From_TOML (T.Get (Key)); + when Validation => + Result.Validation := From_TOML (T.Get (Key)); + when Development => + Result.Development := From_TOML (T.Get (Key)); + end case; + + exception + when Constraint_Error => + Raise_Checked_Error + ("Invalid profile name: '" & (+Key) & "'"); + end; + end if; + end loop; + return Result; + end From_TOML; + +end Alire.Utils.Switches.Modifiers; diff --git a/src/alire/alire-utils-switches-modifiers.ads b/src/alire/alire-utils-switches-modifiers.ads new file mode 100644 index 000000000..15f1ab8c4 --- /dev/null +++ b/src/alire/alire-utils-switches-modifiers.ads @@ -0,0 +1,48 @@ +with Ada.Containers.Doubly_Linked_Lists; +with TOML; + +package Alire.Utils.Switches.Modifiers +with Preelaborate +is + + type Switches_Modifier (Cat : Switches_Categories := Optimization) + is record + case Cat is + when Optimization => + Optimization : Optimization_Switches; + when Debug_Info => + Debug_Info : Debug_Info_Switches; + when Runtime_Checks => + Runtime_Checks : Runtime_Checks_Switches; + when Compile_Checks => + Compile_Checks : Compile_Checks_Switches; + when Contracts => + Contracts : Contracts_Switches; + when Style_Checks => + Style_Checks : Style_Checks_Switches; + end case; + end record; + + package Switches_Modifier_Lists + is new Ada.Containers.Doubly_Linked_Lists (Switches_Modifier); + + function From_TOML (T : TOML.TOML_Value) + return Switches_Modifier_Lists.List; + + procedure Apply (Sw : in out Switches_Configuration; + M : Switches_Modifier); + + procedure Apply (Sw : in out Switches_Configuration; + L : Switches_Modifier_Lists.List); + + type Profile_Modifier is record + Wildcard : Switches_Modifier_Lists.List; + Release : Switches_Modifier_Lists.List; + Validation : Switches_Modifier_Lists.List; + Development : Switches_Modifier_Lists.List; + end record; + + function From_TOML (T : TOML.TOML_Value) + return Profile_Modifier; + +end Alire.Utils.Switches.Modifiers; diff --git a/src/alire/alire-utils-switches.adb b/src/alire/alire-utils-switches.adb index 18e7aafca..75cd56d24 100644 --- a/src/alire/alire-utils-switches.adb +++ b/src/alire/alire-utils-switches.adb @@ -74,7 +74,8 @@ package body Alire.Utils.Switches is .Append (GNAT_Optimize_Performance) .Append (GNAT_Enable_Inlining), when Size => Empty_List - .Append (GNAT_Optimize_Size), + .Append (GNAT_Optimize_Size) + .Append (GNAT_Enable_Inlining), when Debug => Empty_List .Append (GNAT_Optimize_Debug), when Custom => S.List); @@ -95,8 +96,21 @@ package body Alire.Utils.Switches is function Get_List (S : Contracts_Switches) return Switch_List is (case S.Kind is - when No => Empty_List.Append (GNAT_Supress_Runtime_Check), + when No => Empty_List, + when Yes => Empty_List.Append (GNAT_Asserts_And_Contracts), + when Custom => S.List); + + -------------- + -- Get_List -- + -------------- + + function Get_List (S : Runtime_Checks_Switches) return Switch_List + is (case S.Kind is + when None => Empty_List.Append (GNAT_Supress_Runtime_Check), when Default => Empty_List, + when Overflow => Empty_List + .Append (GNAT_Supress_Runtime_Check) + .Append (GNAT_Enable_Overflow_Check), when Everything => Empty_List.Append (GNAT_Enable_Overflow_Check), when Custom => S.List); @@ -104,6 +118,22 @@ package body Alire.Utils.Switches is -- Get_List -- -------------- + function Get_List (S : Compile_Checks_Switches) return Switch_List + is (case S.Kind is + when None => Empty_List, + when Warnings => Empty_List + .Append (GNAT_All_Warnings) + .Append (GNAT_All_Validity_Checks), + when Errors => Empty_List + .Append (GNAT_All_Warnings) + .Append (GNAT_All_Validity_Checks) + .Append (GNAT_Warnings_As_Errors), + when Custom => S.List); + + -------------- + -- Get_List -- + -------------- + function Get_List (S : Style_Checks_Switches) return Switch_List is (case S.Kind is when No => Empty_List, @@ -111,11 +141,11 @@ package body Alire.Utils.Switches is .Append ("-gnaty3") .Append ("-gnatya") .Append ("-gnatyA") - .Append ("-gnatB") + .Append ("-gnatyB") .Append ("-gnatyb") .Append ("-gnatyc") - .Append ("-gnatyD") .Append ("-gnaty-d") + .Append ("-gnatyD") .Append ("-gnatye") .Append ("-gnatyf") .Append ("-gnatyh") @@ -143,6 +173,8 @@ package body Alire.Utils.Switches is return Empty_List .Append (Get_List (C.Optimization)) .Append (Get_List (C.Debug_Info)) + .Append (Get_List (C.Runtime_Checks)) + .Append (Get_List (C.Compile_Checks)) .Append (Get_List (C.Contracts)) .Append (Get_List (C.Style_Checks)); end Get_List; diff --git a/src/alire/alire-utils-switches.ads b/src/alire/alire-utils-switches.ads index 2b094ccc0..4d58d573f 100644 --- a/src/alire/alire-utils-switches.ads +++ b/src/alire/alire-utils-switches.ads @@ -33,7 +33,9 @@ is type Optimization_Kind is (Performance, Size, Debug, Custom); type Debug_Info_Kind is (No, Yes, Custom); - type Contracts_Kind is (No, Default, Everything, Custom); + type Runtime_Checks_Kind is (None, Default, Overflow, Everything, Custom); + type Compile_Checks_Kind is (None, Warnings, Errors, Custom); + type Contracts_Kind is (No, Yes, Custom); type Style_Checks_Kind is (No, Yes, Custom); type Optimization_Switches (Kind : Optimization_Kind := Performance) @@ -52,6 +54,22 @@ is end case; end record; + type Runtime_Checks_Switches (Kind : Runtime_Checks_Kind := None) + is record + case Kind is + when Custom => List : Switch_List; + when others => null; + end case; + end record; + + type Compile_Checks_Switches (Kind : Compile_Checks_Kind := None) + is record + case Kind is + when Custom => List : Switch_List; + when others => null; + end case; + end record; + type Contracts_Switches (Kind : Contracts_Kind := No) is record case Kind is @@ -70,35 +88,45 @@ is function Get_List (S : Optimization_Switches) return Switch_List; function Get_List (S : Debug_Info_Switches) return Switch_List; + function Get_List (S : Runtime_Checks_Switches) return Switch_List; + function Get_List (S : Compile_Checks_Switches) return Switch_List; function Get_List (S : Contracts_Switches) return Switch_List; function Get_List (S : Style_Checks_Switches) return Switch_List; type Switches_Configuration is record - Optimization : Optimization_Switches; - Debug_Info : Debug_Info_Switches; - Contracts : Contracts_Switches; - Style_Checks : Style_Checks_Switches; + Optimization : Optimization_Switches; + Debug_Info : Debug_Info_Switches; + Runtime_Checks : Runtime_Checks_Switches; + Compile_Checks : Compile_Checks_Switches; + Contracts : Contracts_Switches; + Style_Checks : Style_Checks_Switches; end record; function Get_List (C : Switches_Configuration) return Switch_List; Default_Release_Switches : constant Switches_Configuration - := (Optimization => (Kind => Performance), - Debug_Info => (Kind => No), - Contracts => (Kind => Default), - Style_Checks => (Kind => No)); + := (Optimization => (Kind => Performance), + Debug_Info => (Kind => No), + Runtime_Checks => (Kind => Default), + Compile_Checks => (Kind => None), + Contracts => (Kind => No), + Style_Checks => (Kind => No)); Default_Validation_Switches : constant Switches_Configuration - := (Optimization => (Kind => Performance), - Debug_Info => (Kind => Yes), - Contracts => (Kind => Everything), - Style_Checks => (Kind => Yes)); + := (Optimization => (Kind => Performance), + Debug_Info => (Kind => Yes), + Runtime_Checks => (Kind => Everything), + Compile_Checks => (Kind => Errors), + Contracts => (Kind => Yes), + Style_Checks => (Kind => Yes)); Default_Development_Switches : constant Switches_Configuration - := (Optimization => (Kind => Debug), - Debug_Info => (Kind => Yes), - Contracts => (Kind => Everything), - Style_Checks => (Kind => Yes)); + := (Optimization => (Kind => Debug), + Debug_Info => (Kind => Yes), + Runtime_Checks => (Kind => Default), + Compile_Checks => (Kind => Warnings), + Contracts => (Kind => Yes), + Style_Checks => (Kind => Yes)); private Empty_List : constant Switch_List := diff --git a/src/alr/alr-commands-init.adb b/src/alr/alr-commands-init.adb index 61af63679..2eb3494d4 100644 --- a/src/alr/alr-commands-init.adb +++ b/src/alr/alr-commands-init.adb @@ -112,6 +112,8 @@ package body Alr.Commands.Init is end if; Put_Line ("abstract project " & Mixed_Name & "_Config is"); Put_Line (" Crate_Version := ""0.0.0"";"); + Put_Line (" Ada_Compiler_Switches := " & + "External_As_List (""ADAFLAGS"", "" "");"); TIO.Put (File, "end " & Mixed_Name & "_Config;"); TIO.Close (File); @@ -146,7 +148,7 @@ package body Alr.Commands.Init is end if; Put_New_Line; Put_Line (" package Compiler is"); - Put_Line (" for Default_Switches (""Ada"") use " & Mixed_Name & "_Config.GNAT_Switches;"); + Put_Line (" for Default_Switches (""Ada"") use " & Mixed_Name & "_Config.Ada_Compiler_Switches;"); Put_Line (" end Compiler;"); Put_New_Line; Put_Line (" package Binder is"); From e429f4fd2f5bd3754ebe97170b64d987f31a7055 Mon Sep 17 00:00:00 2001 From: Fabien Chouteau Date: Thu, 25 Nov 2021 17:24:00 +0100 Subject: [PATCH 4/9] Alire.Properties.Build_Switches: migrate code from Alire.Utils --- src/alire/alire-crate_configuration.adb | 158 ++++++----- src/alire/alire-properties-build_switches.adb | 261 +++++++++++++++++- src/alire/alire-properties-build_switches.ads | 42 ++- src/alire/alire-utils-switches-modifiers.adb | 238 ---------------- src/alire/alire-utils-switches-modifiers.ads | 48 ---- 5 files changed, 388 insertions(+), 359 deletions(-) delete mode 100644 src/alire/alire-utils-switches-modifiers.adb delete mode 100644 src/alire/alire-utils-switches-modifiers.ads diff --git a/src/alire/alire-crate_configuration.adb b/src/alire/alire-crate_configuration.adb index 90b863b35..eeaf3d00d 100644 --- a/src/alire/alire-crate_configuration.adb +++ b/src/alire/alire-crate_configuration.adb @@ -2,6 +2,7 @@ with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Directories; with Ada.Text_IO; with Ada.Characters.Handling; +with Ada.Containers.Indefinite_Vectors; with Alire_Early_Elaboration; with Alire.Solutions; @@ -14,7 +15,6 @@ with Alire.Properties.Build_Profile; with Alire.Properties.Build_Switches; with Alire.Utils.Switches; use Alire.Utils.Switches; with Alire.Utils.Switches.Knowledge; -with Alire.Utils.Switches.Modifiers; with Alire.Directories; with TOML; use TOML; @@ -23,6 +23,34 @@ package body Alire.Crate_Configuration is package TIO renames Ada.Text_IO; + package Crate_Name_Vect + is new Ada.Containers.Indefinite_Vectors (Natural, Crate_Name); + + ----------------------- + -- Make_Release_Vect -- + ----------------------- + + function Make_Release_Vect (Root : in out Alire.Roots.Root) + return Crate_Name_Vect.Vector + is + Result : Crate_Name_Vect.Vector; + + procedure Filter (This : in out Alire.Roots.Root; + Solution : Solutions.Solution; + State : Solutions.Dependency_State) + is + pragma Unreferenced (This, Solution); + begin + if State.Has_Release and then not State.Is_Provided then + Result.Append (State.Crate); + end if; + end Filter; + + begin + Root.Traverse (Filter'Access); + return Result; + end Make_Release_Vect; + function Is_Reserved_Name (Type_Name : String) return Boolean is (Type_Name = "crate_version"); -- Return True if Type_Name is reserved for Alire internal use @@ -31,9 +59,9 @@ package body Alire.Crate_Configuration is -- Make_Build_Profile_Map -- ---------------------------- - procedure Make_Build_Profile_Map (This : in out Global_Config; - Root : Alire.Roots.Root; - Solution : Solutions.Solution) + procedure Make_Build_Profile_Map (This : in out Global_Config; + Root : in out Alire.Roots.Root; + Rel_Vect : Crate_Name_Vect.Vector) is use Properties.Build_Profile; @@ -54,9 +82,9 @@ package body Alire.Crate_Configuration is begin -- Populate map with crates in the solution - for Rel of Solution.Releases.Including (Root.Release) loop - This.Profile_Map.Insert (Rel.Name, - (if Rel.Name = Root.Name + for Crate of Rel_Vect loop + This.Profile_Map.Insert (Crate, + (if Crate = Root.Name then Development else Release)); end loop; @@ -111,14 +139,16 @@ package body Alire.Crate_Configuration is ---------------------- procedure Make_Swiches_Map (This : in out Global_Config; - Root : Alire.Roots.Root; - Solution : Solutions.Solution) + Root : in out Alire.Roots.Root; + Rel_Vect : Crate_Name_Vect.Vector) is begin - for Rel of Solution.Releases.Including (Root.Release) loop + for Crate of Rel_Vect loop declare + Rel : constant Releases.Release := Root.Release (Crate); + Profile : constant Profile_Kind - := This.Profile_Map.Element (Rel.Name); + := This.Profile_Map.Element (Crate); Config : Alire.Utils.Switches.Switches_Configuration := (case Profile is @@ -126,7 +156,7 @@ package body Alire.Crate_Configuration is when Validation => Default_Validation_Switches, when Development => Default_Development_Switches); - Modif : Alire.Utils.Switches.Modifiers.Profile_Modifier; + Modif : Properties.Build_Switches.Profile_Modifier; begin -- Get switches modifier from the release @@ -142,15 +172,15 @@ package body Alire.Crate_Configuration is end; end loop; - Alire.Utils.Switches.Modifiers.Apply (Config, Modif.Wildcard); + Properties.Build_Switches.Apply (Config, Modif.Wildcard); case Profile is when Release => - Modifiers.Apply (Config, Modif.Release); + Properties.Build_Switches.Apply (Config, Modif.Release); when Validation => - Modifiers.Apply (Config, Modif.Validation); + Properties.Build_Switches.Apply (Config, Modif.Validation); when Development => - Modifiers.Apply (Config, Modif.Development); + Properties.Build_Switches.Apply (Config, Modif.Development); end case; This.Switches_Map.Insert (Rel.Name, Get_List (Config)); @@ -167,6 +197,7 @@ package body Alire.Crate_Configuration is is Solution : constant Solutions.Solution := Root.Solution; + Rel_Vect : constant Crate_Name_Vect.Vector := Make_Release_Vect (Root); begin if not Solution.Is_Complete then @@ -174,18 +205,16 @@ package body Alire.Crate_Configuration is & " because of missing dependencies"); end if; - for Rel of Solution.Releases.Including (Root.Release) loop - This.Load_Definitions (Root => Root, - Crate => Rel.Name); + for Crate of Rel_Vect loop + This.Load_Definitions (Root, Crate); end loop; - Make_Build_Profile_Map (This, Root, Solution); + Make_Build_Profile_Map (This, Root, Rel_Vect); - Make_Swiches_Map (This, Root, Solution); + Make_Swiches_Map (This, Root, Rel_Vect); - for Rel of Solution.Releases.Including (Root.Release) loop - This.Load_Settings (Root => Root, - Crate => Rel.Name); + for Create of Rel_Vect loop + This.Load_Settings (Root, Create); end loop; Use_Default_Values (This); @@ -225,51 +254,54 @@ package body Alire.Crate_Configuration is & " because of missing dependencies"); end if; - for Rel of Solution.Releases.Including (Root.Release) loop - - -- We don't create config files for external releases, since they are - -- not sources built by Alire. - if Rel.Origin.Kind /= Alire.Origins.External then - - declare - Ent : constant Config_Entry := Get_Config_Entry (Rel); - - Conf_Dir : constant Absolute_Path := - Root.Release_Base (Rel.Name) / Ent.Output_Dir; - - Version_Str : constant String := Rel.Version.Image; - begin + for Crate of Make_Release_Vect (Root) loop + declare + Rel : constant Releases.Release := Root.Release (Crate); + begin + -- We don't create config files for external releases, since they + -- are not sources built by Alire. + if Rel.Origin.Kind /= Alire.Origins.External then - if not Ent.Disabled then - Ada.Directories.Create_Path (Conf_Dir); + declare + Ent : constant Config_Entry := Get_Config_Entry (Rel); - if Ent.Generate_Ada then - This.Generate_Ada_Config - (Rel.Name, - Conf_Dir / (+Rel.Name & "_config.ads"), - Version_Str); - end if; + Conf_Dir : constant Absolute_Path := + Root.Release_Base (Rel.Name) / Ent.Output_Dir; - if Ent.Generate_GPR then - This.Generate_GPR_Config - (Rel.Name, - Conf_Dir / (+Rel.Name & "_config.gpr"), - (if Ent.Auto_GPR_With - then Root.Direct_Withs (Rel) - else AAA.Strings.Empty_Set), - Version_Str); - end if; + Version_Str : constant String := Rel.Version.Image; + begin - if Ent.Generate_C then - This.Generate_C_Config - (Rel.Name, - Conf_Dir / (+Rel.Name & "_config.h"), - Version_Str); + if not Ent.Disabled then + Ada.Directories.Create_Path (Conf_Dir); + + if Ent.Generate_Ada then + This.Generate_Ada_Config + (Rel.Name, + Conf_Dir / (+Rel.Name & "_config.ads"), + Version_Str); + end if; + + if Ent.Generate_GPR then + This.Generate_GPR_Config + (Rel.Name, + Conf_Dir / (+Rel.Name & "_config.gpr"), + (if Ent.Auto_GPR_With + then Root.Direct_Withs (Rel) + else AAA.Strings.Empty_Set), + Version_Str); + end if; + + if Ent.Generate_C then + This.Generate_C_Config + (Rel.Name, + Conf_Dir / (+Rel.Name & "_config.h"), + Version_Str); + end if; end if; - end if; - end; + end; - end if; + end if; + end; end loop; end Generate_Config_Files; diff --git a/src/alire/alire-properties-build_switches.adb b/src/alire/alire-properties-build_switches.adb index 3f3628a42..e6ec37aa1 100644 --- a/src/alire/alire-properties-build_switches.adb +++ b/src/alire/alire-properties-build_switches.adb @@ -1,5 +1,5 @@ with Alire.TOML_Keys; -with Alire.Utils.Switches; use Alire.Utils.Switches; +with TOML; use TOML; package body Alire.Properties.Build_Switches is @@ -8,10 +8,10 @@ package body Alire.Properties.Build_Switches is -------------- function Modifier (This : Variable) - return Alire.Utils.Switches.Modifiers.Profile_Modifier + return Profile_Modifier is begin - return Alire.Utils.Switches.Modifiers.From_TOML (This.T); + return This.Modif; end Modifier; ----------- @@ -37,18 +37,265 @@ package body Alire.Properties.Build_Switches is -- From_TOML -- --------------- + function From_TOML (From : TOML_Adapters.Key_Queue; + Cat : Switches_Categories; + T : TOML.TOML_Value) + return Switches_Modifier + is + Result : Switches_Modifier (Cat); + List : Switch_List; + begin + + if T.Kind = TOML_Array then + + if (for some Index in 1 .. T.Length + => T.Item (Index).Kind /= TOML_String) + then + From.Checked_Error + ("At least one element on the switch list is not a string"); + end if; + -- We have a custom list of switches + + for Index in 1 .. T.Length loop + List.Append (T.Item (Index).As_String); + end loop; + + case Cat is + when Optimization => + Result.Optimization := (Custom, List); + when Debug_Info => + Result.Debug_Info := (Custom, List); + when Compile_Checks => + Result.Compile_Checks := (Custom, List); + when Runtime_Checks => + Result.Runtime_Checks := (Custom, List); + when Contracts => + Result.Contracts := (Custom, List); + when Style_Checks => + Result.Style_Checks := (Custom, List); + end case; + + elsif T.Kind = TOML_String then + + begin + case Cat is + when Optimization => + declare + K : constant Optimization_Kind := + Optimization_Kind'Value (T.As_String); + begin + Result.Optimization := + (case K is + when Performance => (Kind => Performance), + when Size => (Kind => Size), + when Debug => (Kind => Debug), + when Custom => raise Constraint_Error); + end; + + when Debug_Info => + declare + K : constant Debug_Info_Kind := + Debug_Info_Kind'Value (T.As_String); + begin + Result.Debug_Info := + (case K is + when No => (Kind => No), + when Yes => (Kind => Yes), + when Custom => raise Constraint_Error); + end; + + when Runtime_Checks => + declare + K : constant Runtime_Checks_Kind := + Runtime_Checks_Kind'Value (T.As_String); + begin + Result.Runtime_Checks := + (case K is + when None => (Kind => None), + when Default => (Kind => Default), + when Overflow => (Kind => Overflow), + when Everything => (Kind => Everything), + when Custom => raise Constraint_Error); + end; + + when Compile_Checks => + declare + K : constant Compile_Checks_Kind := + Compile_Checks_Kind'Value (T.As_String); + begin + Result.Compile_Checks := + (case K is + when None => (Kind => None), + when Warnings => (Kind => Warnings), + when Errors => (Kind => Errors), + when Custom => raise Constraint_Error); + end; + + when Contracts => + declare + K : constant Contracts_Kind := + Contracts_Kind'Value (T.As_String); + begin + Result.Contracts := + (case K is + when No => (Kind => No), + when Yes => (Kind => Yes), + when Custom => raise Constraint_Error); + end; + + when Style_Checks => + declare + K : constant Style_Checks_Kind := + Style_Checks_Kind'Value (T.As_String); + begin + Result.Style_Checks := + (case K is + when No => (Kind => No), + when Yes => (Kind => Yes), + when Custom => raise Constraint_Error); + end; + + end case; + exception + when Constraint_Error => + From.Checked_Error + ("Invalid switch selector '" & T.As_String & + "' for catergory '" & Cat'Img & "'"); + end; + + else + From.Checked_Error + ("String or array of string expected"); + end if; + + return Result; + end From_TOML; + + --------------- + -- From_TOML -- + --------------- + + function From_TOML (From : TOML_Adapters.Key_Queue; + T : TOML.TOML_Value) + return Switches_Modifier_Lists.List + is + List : Switches_Modifier_Lists.List; + begin + if T.Kind /= TOML_Table then + raise Program_Error; + end if; + + for Key of T.Keys loop + + declare + Cat : Switches_Categories; + begin + Cat := Switches_Categories'Value (+Key); + List.Append (From_TOML (From, Cat, T.Get (Key))); + exception + when Constraint_Error => + From.Checked_Error + ("Invalid switch category: '" & (+Key) & "'"); + end; + end loop; + + return List; + end From_TOML; + + ----------- + -- Apply -- + ----------- + + procedure Apply (Sw : in out Switches_Configuration; + M : Switches_Modifier) + is + begin + case M.Cat is + when Optimization => + Sw.Optimization := M.Optimization; + when Debug_Info => + Sw.Debug_Info := M.Debug_Info; + when Runtime_Checks => + Sw.Runtime_Checks := M.Runtime_Checks; + when Compile_Checks => + Sw.Compile_Checks := M.Compile_Checks; + when Contracts => + Sw.Contracts := M.Contracts; + when Style_Checks => + Sw.Style_Checks := M.Style_Checks; + end case; + end Apply; + + ----------- + -- Apply -- + ----------- + + procedure Apply (Sw : in out Switches_Configuration; + L : Switches_Modifier_Lists.List) + is + begin + for Elt of L loop + Apply (Sw, Elt); + end loop; + end Apply; + + --------------- + -- From_TOML -- + --------------- + + function From_TOML (From : TOML_Adapters.Key_Queue; + T : TOML.TOML_Value) + return Profile_Modifier + is + Result : Profile_Modifier; + begin + if T.Kind /= TOML_Table then + raise Program_Error; + end if; + + for Key of T.Keys loop + if (+Key) = "*" then + Result.Wildcard := From_TOML (From, T.Get (Key)); + else + declare + Prof : Profile_Kind; + begin + Prof := Profile_Kind'Value (+Key); + + case Prof is + when Release => + Result.Release := From_TOML (From, T.Get (Key)); + when Validation => + Result.Validation := From_TOML (From, T.Get (Key)); + when Development => + Result.Development := From_TOML (From, T.Get (Key)); + end case; + + exception + when Constraint_Error => + From.Checked_Error + ("Invalid profile name: '" & (+Key) & "'"); + end; + end if; + end loop; + return Result; + end From_TOML; + + --------------- + -- From_TOML -- + --------------- + function From_TOML (From : TOML_Adapters.Key_Queue) return Conditional.Properties is use type Conditional.Properties; - use TOML; Env : TOML_Value; Var : Variable; begin if From.Unwrap.Kind /= TOML_Table then From.Checked_Error - ("Build_switches: table with assignments expected, but got: " + ("Build_Switches: table expected, but got: " & From.Unwrap.Kind'Img); end if; @@ -59,7 +306,7 @@ package body Alire.Properties.Build_Switches is end if; return Props : Conditional.Properties do - Var.T := Env.Clone; + Var.Modif := From_TOML (From, Env); Props := Props and Var; end return; @@ -72,7 +319,7 @@ package body Alire.Properties.Build_Switches is overriding function To_TOML (This : Variable) return TOML.TOML_Value is begin - return This.T.Clone; + return No_TOML_Value; end To_TOML; ------------- diff --git a/src/alire/alire-properties-build_switches.ads b/src/alire/alire-properties-build_switches.ads index f8108f7ee..c80e0b4a1 100644 --- a/src/alire/alire-properties-build_switches.ads +++ b/src/alire/alire-properties-build_switches.ads @@ -1,15 +1,51 @@ +with Ada.Containers.Doubly_Linked_Lists; + with Alire.Conditional; with Alire.TOML_Adapters; -with Alire.Utils.Switches.Modifiers; +with Alire.Utils.Switches; use Alire.Utils.Switches; private with TOML; package Alire.Properties.Build_Switches with Preelaborate is + type Switches_Modifier (Cat : Switches_Categories := Optimization) + is record + case Cat is + when Optimization => + Optimization : Optimization_Switches; + when Debug_Info => + Debug_Info : Debug_Info_Switches; + when Runtime_Checks => + Runtime_Checks : Runtime_Checks_Switches; + when Compile_Checks => + Compile_Checks : Compile_Checks_Switches; + when Contracts => + Contracts : Contracts_Switches; + when Style_Checks => + Style_Checks : Style_Checks_Switches; + end case; + end record; + + package Switches_Modifier_Lists + is new Ada.Containers.Doubly_Linked_Lists (Switches_Modifier); + + procedure Apply (Sw : in out Switches_Configuration; + M : Switches_Modifier); + + procedure Apply (Sw : in out Switches_Configuration; + L : Switches_Modifier_Lists.List); + + type Profile_Modifier is record + Wildcard : Switches_Modifier_Lists.List; + Release : Switches_Modifier_Lists.List; + Validation : Switches_Modifier_Lists.List; + Development : Switches_Modifier_Lists.List; + end record; + type Variable is new Property with private; function Modifier (This : Variable) - return Alire.Utils.Switches.Modifiers.Profile_Modifier; + return Profile_Modifier; -- Inherited operations @@ -31,7 +67,7 @@ package Alire.Properties.Build_Switches with Preelaborate is private type Variable is new Property with record - T : TOML.TOML_Value; + Modif : Profile_Modifier; end record; end Alire.Properties.Build_Switches; diff --git a/src/alire/alire-utils-switches-modifiers.adb b/src/alire/alire-utils-switches-modifiers.adb deleted file mode 100644 index d10dae3e6..000000000 --- a/src/alire/alire-utils-switches-modifiers.adb +++ /dev/null @@ -1,238 +0,0 @@ -with TOML; use TOML; - -package body Alire.Utils.Switches.Modifiers is - - --------------- - -- From_TOML -- - --------------- - - function From_TOML (Cat : Switches_Categories; - T : TOML.TOML_Value) - return Switches_Modifier - is - Result : Switches_Modifier (Cat); - List : Switch_List; - begin - - if T.Kind = TOML_Array then - - -- We have a custom list of switches - - for Index in 1 .. T.Length loop - List.Append (T.Item (Index).As_String); - end loop; - - case Cat is - when Optimization => - Result.Optimization := (Custom, List); - when Debug_Info => - Result.Debug_Info := (Custom, List); - when Contracts => - Result.Contracts := (Custom, List); - when Style_Checks => - Result.Style_Checks := (Custom, List); - when others => - raise Program_Error; -- TODO - end case; - - elsif T.Kind = TOML_String then - - begin - case Cat is - when Optimization => - declare - K : constant Optimization_Kind := - Optimization_Kind'Value (T.As_String); - begin - Result.Optimization := - (case K is - when Performance => (Kind => Performance), - when Size => (Kind => Size), - when Debug => (Kind => Debug), - when Custom => raise Constraint_Error); - end; - - when Debug_Info => - declare - K : constant Debug_Info_Kind := - Debug_Info_Kind'Value (T.As_String); - begin - Result.Debug_Info := - (case K is - when No => (Kind => No), - when Yes => (Kind => Yes), - when Custom => raise Constraint_Error); - end; - - when Runtime_Checks => - declare - K : constant Runtime_Checks_Kind := - Runtime_Checks_Kind'Value (T.As_String); - begin - Result.Runtime_Checks := - (case K is - when None => (Kind => None), - when Default => (Kind => Default), - when Overflow => (Kind => Overflow), - when Everything => (Kind => Everything), - when Custom => raise Constraint_Error); - end; - - when Compile_Checks => - declare - K : constant Compile_Checks_Kind := - Compile_Checks_Kind'Value (T.As_String); - begin - Result.Compile_Checks := - (case K is - when None => (Kind => None), - when Warnings => (Kind => Warnings), - when Errors => (Kind => Errors), - when Custom => raise Constraint_Error); - end; - - when Contracts => - declare - K : constant Contracts_Kind := - Contracts_Kind'Value (T.As_String); - begin - Result.Contracts := - (case K is - when No => (Kind => No), - when Yes => (Kind => Yes), - when Custom => raise Constraint_Error); - end; - - when Style_Checks => - declare - K : constant Style_Checks_Kind := - Style_Checks_Kind'Value (T.As_String); - begin - Result.Style_Checks := - (case K is - when No => (Kind => No), - when Yes => (Kind => Yes), - when Custom => raise Constraint_Error); - end; - - end case; - exception - when Constraint_Error => - Raise_Checked_Error - ("Invalid switch selector '" & T.As_String & - "' for catergory '" & Cat'Img & "'"); - end; - - else - raise Program_Error; - end if; - - return Result; - end From_TOML; - - --------------- - -- From_TOML -- - --------------- - - function From_TOML (T : TOML.TOML_Value) - return Switches_Modifier_Lists.List - is - List : Switches_Modifier_Lists.List; - begin - if T.Kind /= TOML_Table then - raise Program_Error; - end if; - - for Key of T.Keys loop - - declare - Cat : Switches_Categories; - begin - Cat := Switches_Categories'Value (+Key); - Trace.Always (+Key); - List.Append (From_TOML (Cat, T.Get (Key))); - end; - end loop; - - return List; - end From_TOML; - - ----------- - -- Apply -- - ----------- - - procedure Apply (Sw : in out Switches_Configuration; - M : Switches_Modifier) - is - begin - case M.Cat is - when Optimization => - Sw.Optimization := M.Optimization; - when Debug_Info => - Sw.Debug_Info := M.Debug_Info; - when Runtime_Checks => - Sw.Runtime_Checks := M.Runtime_Checks; - when Compile_Checks => - Sw.Compile_Checks := M.Compile_Checks; - when Contracts => - Sw.Contracts := M.Contracts; - when Style_Checks => - Sw.Style_Checks := M.Style_Checks; - end case; - end Apply; - - ----------- - -- Apply -- - ----------- - - procedure Apply (Sw : in out Switches_Configuration; - L : Switches_Modifier_Lists.List) - is - begin - for Elt of L loop - Apply (Sw, Elt); - end loop; - end Apply; - - --------------- - -- From_TOML -- - --------------- - - function From_TOML (T : TOML.TOML_Value) - return Profile_Modifier - is - Result : Profile_Modifier; - begin - if T.Kind /= TOML_Table then - raise Program_Error; - end if; - - for Key of T.Keys loop - if (+Key) = "*" then - Result.Wildcard := From_TOML (T.Get (Key)); - else - declare - Prof : Profile_Kind; - begin - Prof := Profile_Kind'Value (+Key); - - case Prof is - when Release => - Result.Release := From_TOML (T.Get (Key)); - when Validation => - Result.Validation := From_TOML (T.Get (Key)); - when Development => - Result.Development := From_TOML (T.Get (Key)); - end case; - - exception - when Constraint_Error => - Raise_Checked_Error - ("Invalid profile name: '" & (+Key) & "'"); - end; - end if; - end loop; - return Result; - end From_TOML; - -end Alire.Utils.Switches.Modifiers; diff --git a/src/alire/alire-utils-switches-modifiers.ads b/src/alire/alire-utils-switches-modifiers.ads deleted file mode 100644 index 15f1ab8c4..000000000 --- a/src/alire/alire-utils-switches-modifiers.ads +++ /dev/null @@ -1,48 +0,0 @@ -with Ada.Containers.Doubly_Linked_Lists; -with TOML; - -package Alire.Utils.Switches.Modifiers -with Preelaborate -is - - type Switches_Modifier (Cat : Switches_Categories := Optimization) - is record - case Cat is - when Optimization => - Optimization : Optimization_Switches; - when Debug_Info => - Debug_Info : Debug_Info_Switches; - when Runtime_Checks => - Runtime_Checks : Runtime_Checks_Switches; - when Compile_Checks => - Compile_Checks : Compile_Checks_Switches; - when Contracts => - Contracts : Contracts_Switches; - when Style_Checks => - Style_Checks : Style_Checks_Switches; - end case; - end record; - - package Switches_Modifier_Lists - is new Ada.Containers.Doubly_Linked_Lists (Switches_Modifier); - - function From_TOML (T : TOML.TOML_Value) - return Switches_Modifier_Lists.List; - - procedure Apply (Sw : in out Switches_Configuration; - M : Switches_Modifier); - - procedure Apply (Sw : in out Switches_Configuration; - L : Switches_Modifier_Lists.List); - - type Profile_Modifier is record - Wildcard : Switches_Modifier_Lists.List; - Release : Switches_Modifier_Lists.List; - Validation : Switches_Modifier_Lists.List; - Development : Switches_Modifier_Lists.List; - end record; - - function From_TOML (T : TOML.TOML_Value) - return Profile_Modifier; - -end Alire.Utils.Switches.Modifiers; From 8ea7ab668312693642c34a99ba95e96ee2a6266f Mon Sep 17 00:00:00 2001 From: Fabien Chouteau Date: Thu, 25 Nov 2021 17:26:00 +0100 Subject: [PATCH 5/9] Alr.Commands.Init: don't generate lockfile and config files These files are difficult to write "by hand" as the features evolve. They will be generated as soon as the users builds/update/with the crate. --- src/alr/alr-commands-init.adb | 41 ++++++------------- testsuite/drivers/alr.py | 12 ++++-- testsuite/tests/misc/bad-lockfile/test.py | 6 +-- .../tests/publish/missing-manifest/test.py | 2 - .../publish/remote-origin-nonstd/test.py | 2 - testsuite/tests/publish/remote-origin/test.py | 2 - testsuite/tests/with/changes-info/test.py | 3 +- .../tests/workflows/init-options/test.py | 16 +------- 8 files changed, 26 insertions(+), 58 deletions(-) diff --git a/src/alr/alr-commands-init.adb b/src/alr/alr-commands-init.adb index 2eb3494d4..d529e6464 100644 --- a/src/alr/alr-commands-init.adb +++ b/src/alr/alr-commands-init.adb @@ -4,9 +4,6 @@ with Ada.Directories; with Ada.Text_IO; with Alire.Config; -with Alire.Lockfiles; -with Alire.Paths; -with Alire.Solutions; with Alire.Utils.User_Input.Query_Config; with GNATCOLL.VFS; use GNATCOLL.VFS; @@ -40,7 +37,6 @@ package body Alr.Commands.Init is then Get_Current_Dir else Create (+Name, Normalize => True)); Src_Directory : constant Virtual_File := Directory / "src"; - Config_Directory : constant Virtual_File := Directory / "config"; File : TIO.File_Type; @@ -98,25 +94,22 @@ package body Alr.Commands.Init is procedure Generate_Project_File is Filename : constant String := +Full_Name (Directory / (+Lower_Name & ".gpr")); - - Config_Filename : constant String := - +Full_Name (Config_Directory / (+Lower_Name & "_config.gpr")); begin -- Use more than 80 colums for more readable strings pragma Style_Checks ("M200"); - -- Config project file - if not Create (Config_Filename) then - Trace.Warning ("Cannot create '" & Config_Filename & "'"); - return; - end if; - Put_Line ("abstract project " & Mixed_Name & "_Config is"); - Put_Line (" Crate_Version := ""0.0.0"";"); - Put_Line (" Ada_Compiler_Switches := " & - "External_As_List (""ADAFLAGS"", "" "");"); - - TIO.Put (File, "end " & Mixed_Name & "_Config;"); - TIO.Close (File); + -- -- Config project file + -- if not Create (Config_Filename) then + -- Trace.Warning ("Cannot create '" & Config_Filename & "'"); + -- return; + -- end if; + -- Put_Line ("abstract project " & Mixed_Name & "_Config is"); + -- Put_Line (" Crate_Version := ""0.0.0"";"); + -- Put_Line (" Ada_Compiler_Switches := " & + -- "External_As_List (""ADAFLAGS"", "" "");"); + -- + -- TIO.Put (File, "end " & Mixed_Name & "_Config;"); + -- TIO.Close (File); -- Main project file if not Create (Filename) then @@ -312,12 +305,7 @@ package body Alr.Commands.Init is -- Crate dir Directory.Make_Dir; - -- Empty alire dir - Virtual_File'(Directory / (+Alire.Paths.Working_Folder_Inside_Root)) - .Make_Dir; - if not Cmd.No_Skel then - Config_Directory.Make_Dir; Generate_Project_File; Src_Directory.Make_Dir; if For_Library then @@ -330,11 +318,6 @@ package body Alr.Commands.Init is Generate_Manifest; - Alire.Lockfiles.Write - ((Solution => Alire.Solutions.Empty_Valid_Solution), - Alire.Lockfiles.File_Name - (String (Filesystem_String'(Directory.Full_Name)))); - Alire.Put_Success (TTY.Emph (Lower_Name) & " initialized successfully."); end Generate; diff --git a/testsuite/drivers/alr.py b/testsuite/drivers/alr.py index 1a67459c5..c7b33c1c3 100644 --- a/testsuite/drivers/alr.py +++ b/testsuite/drivers/alr.py @@ -194,7 +194,7 @@ def index_version(): return index_branch().split('-')[1] -def init_local_crate(name="xxx", binary=True, enter=True): +def init_local_crate(name="xxx", binary=True, enter=True, update=True): """ Initialize a local crate and enter its folder for further testing. @@ -205,6 +205,12 @@ def init_local_crate(name="xxx", binary=True, enter=True): :param bool enter: Enter the created crate directory """ run_alr("init", name, "--bin" if binary else "--lib") + + if update: + os.chdir(name) + run_alr("update") + os.chdir("..") + if enter: os.chdir(name) @@ -217,7 +223,7 @@ def alr_manifest(): return "alire.toml" -def alr_touch_manifest(path="."): +def alr_touch_manifest(): """ Make the lockfile older than the manifest, to ensure editions to the manifest are detected. @@ -380,7 +386,7 @@ def alr_with(dep="", path="", url="", commit="", branch="", update=False) # Make the lockfile "older" (otherwise timestamp is identical) - os.utime(alr_lockfile(), (0, 0)) + alr_touch_manifest(); if update: return run_alr("with", force=force) diff --git a/testsuite/tests/misc/bad-lockfile/test.py b/testsuite/tests/misc/bad-lockfile/test.py index 95b5accbd..64a38f286 100644 --- a/testsuite/tests/misc/bad-lockfile/test.py +++ b/testsuite/tests/misc/bad-lockfile/test.py @@ -2,17 +2,15 @@ A test that a bad lockfile is recovered from (losing pins) """ -from drivers.alr import run_alr, alr_lockfile +from drivers.alr import run_alr, alr_lockfile, init_local_crate import os import re # Create a new crate -run_alr('init', '--bin', 'xxx') +init_local_crate(name='xxx') # And muck its lockfile -os.chdir('xxx') - BADLINE = "SHOULND'T BE HERE" with open(alr_lockfile(), "a") as myfile: diff --git a/testsuite/tests/publish/missing-manifest/test.py b/testsuite/tests/publish/missing-manifest/test.py index 3131e35bb..635ffa184 100644 --- a/testsuite/tests/publish/missing-manifest/test.py +++ b/testsuite/tests/publish/missing-manifest/test.py @@ -15,8 +15,6 @@ # Prepare a repo and a zipball to be used as "remote", without a manifest run_alr("init", "--bin", "xxx") -# Remove the alire cache -rmtree(os.path.join("xxx", "alire")) # Remove the manifest os.remove(os.path.join("xxx", "alire.toml")) diff --git a/testsuite/tests/publish/remote-origin-nonstd/test.py b/testsuite/tests/publish/remote-origin-nonstd/test.py index 2dbed0c6d..a04dcae18 100644 --- a/testsuite/tests/publish/remote-origin-nonstd/test.py +++ b/testsuite/tests/publish/remote-origin-nonstd/test.py @@ -27,8 +27,6 @@ def verify_manifest(): # Prepare a repo and a zipball to be used as "remote" targets for publishing run_alr("init", "--bin", "xxx") -# Remove the alire cache -rmtree(os.path.join("xxx", "alire")) # Rename the manifest location os.rename(os.path.join("xxx", "alire.toml"), os.path.join("xxx", "xxx.toml")) diff --git a/testsuite/tests/publish/remote-origin/test.py b/testsuite/tests/publish/remote-origin/test.py index eaeb8de89..54afaa79e 100644 --- a/testsuite/tests/publish/remote-origin/test.py +++ b/testsuite/tests/publish/remote-origin/test.py @@ -27,8 +27,6 @@ def verify_manifest(): # Prepare a repo and a zipball to be used as "remote" targets for publishing run_alr("init", "--bin", "xxx") -# Remove the alire cache -rmtree(os.path.join("xxx", "alire")) # Create the zip zip_dir("xxx", "xxx.zip") diff --git a/testsuite/tests/with/changes-info/test.py b/testsuite/tests/with/changes-info/test.py index 84e9cf51e..d43f13082 100644 --- a/testsuite/tests/with/changes-info/test.py +++ b/testsuite/tests/with/changes-info/test.py @@ -16,7 +16,8 @@ ############################################################################### # Add a regular solvable dependency p = run_alr('with', 'libhello', quiet=False) -assert_match(re.escape("""Requested changes: +assert_match(".*" + + re.escape("""Requested changes: + libhello ^2.0.0 (add) diff --git a/testsuite/tests/workflows/init-options/test.py b/testsuite/tests/workflows/init-options/test.py index ef80315d4..478647215 100644 --- a/testsuite/tests/workflows/init-options/test.py +++ b/testsuite/tests/workflows/init-options/test.py @@ -18,11 +18,7 @@ # Plain init run_alr('init', '--bin', 'xxx') compare(contents('xxx'), ['xxx/.gitignore', - 'xxx/alire', 'xxx/alire.toml', - 'xxx/alire/alire.lock', - 'xxx/config', - 'xxx/config/xxx_config.gpr', 'xxx/src', 'xxx/src/xxx.adb', 'xxx/xxx.gpr']) @@ -32,19 +28,13 @@ run_alr('init', '--bin', 'aaa') compare(contents('aaa'), ['aaa/.gitignore', 'aaa/aaa.gpr', - 'aaa/alire', 'aaa/alire.toml', - 'aaa/alire/alire.lock', - 'aaa/config', - 'aaa/config/aaa_config.gpr', 'aaa/src', 'aaa/src/aaa.adb']) # Init without skeleton run_alr('init', '--bin', '--no-skel', 'yyy') -compare(contents('yyy'), ['yyy/alire', - 'yyy/alire.toml', - 'yyy/alire/alire.lock' +compare(contents('yyy'), ['yyy/alire.toml', ]) # Init with existing crate @@ -71,11 +61,7 @@ os.chdir('zzz') run_alr('init', '--bin', '--in-place', 'zzz') compare(contents('.'), ['./.gitignore', - './alire', './alire.toml', - './alire/alire.lock', - './config', - './config/zzz_config.gpr', './src', './src/zzz.adb', './zzz.gpr']) From d7039f766ef37424a1fef208fb82cc6d94a67a1c Mon Sep 17 00:00:00 2001 From: Fabien Chouteau Date: Thu, 9 Dec 2021 18:17:17 +0100 Subject: [PATCH 6/9] testsuite: add tests for the build profile system --- .../build_profile/custom_profiles/test.py | 62 +++++++++++++++++++ .../build_profile/custom_profiles/test.yaml | 1 + .../build_profile/custom_switches/test.py | 58 +++++++++++++++++ .../build_profile/custom_switches/test.yaml | 1 + testsuite/tests/build_profile/default/test.py | 53 ++++++++++++++++ .../tests/build_profile/default/test.yaml | 1 + 6 files changed, 176 insertions(+) create mode 100644 testsuite/tests/build_profile/custom_profiles/test.py create mode 100644 testsuite/tests/build_profile/custom_profiles/test.yaml create mode 100644 testsuite/tests/build_profile/custom_switches/test.py create mode 100644 testsuite/tests/build_profile/custom_switches/test.yaml create mode 100644 testsuite/tests/build_profile/default/test.py create mode 100644 testsuite/tests/build_profile/default/test.yaml diff --git a/testsuite/tests/build_profile/custom_profiles/test.py b/testsuite/tests/build_profile/custom_profiles/test.py new file mode 100644 index 000000000..8e4439914 --- /dev/null +++ b/testsuite/tests/build_profile/custom_profiles/test.py @@ -0,0 +1,62 @@ +""" +Check customization of profiles +""" + +from drivers.alr import run_alr, init_local_crate, alr_with, alr_manifest +from drivers.helpers import content_of +from drivers.asserts import assert_match + +init_local_crate('lib_1', binary=False, enter=False) +init_local_crate('lib_2', binary=False, enter=False) +init_local_crate('bin_1', binary=True, enter=True) +alr_with('lib_1', path='../lib_1') +alr_with('lib_2', path='../lib_2') +run_alr('update') + + +def check_config(path, profile, expected_switches=[]): + conf = content_of(path) + assert_match('.*Build_Profile : Build_Profile_Kind := "%s"' % profile, + conf) + + for sw in expected_switches: + assert_match('.*"%s"' % sw,conf) + + +lib1_config = '../lib_1/config/lib_1_config.gpr' +lib2_config = '../lib_2/config/lib_2_config.gpr' +bin_config = 'config/bin_1_config.gpr' + +# Check default profiles for root and dependency +check_config(lib1_config, 'RELEASE', ['-O3', '-gnatn']) +check_config(lib2_config, 'RELEASE', ['-O3', '-gnatn']) +check_config(bin_config, 'DEVELOPMENT', ['-Og', '-g', '-gnatwa', '-gnata', '-gnaty3']) + +# Create custom Release profile for lib_1 +with open('../lib_1/alire.toml', "a") as manifest: + manifest.write('[build_switches]\n') + manifest.write('release.optimization = "size"\n') + manifest.write('release.contracts = "yes"\n') + + +# Create custom wildcard profile for lib_2 +with open('../lib_2/alire.toml', "a") as manifest: + manifest.write('[build_switches]\n') + manifest.write('"*".optimization = "debug"\n') + manifest.write('"*".contracts = "no"\n') + + +# Check if we can change the profile of a dependency +with open(alr_manifest(), "a") as manifest: + manifest.write('[build_profile]\n') + manifest.write('lib_2 = "validation"\n') + +run_alr('update') +check_config(lib1_config, 'RELEASE', ['-Os', '-gnata']) +check_config(lib2_config, 'VALIDATION', ['-Og']) +check_config(bin_config, 'DEVELOPMENT', ['-gnata']) + +# Check that the project builds +run_alr('build') + +print('SUCCESS') diff --git a/testsuite/tests/build_profile/custom_profiles/test.yaml b/testsuite/tests/build_profile/custom_profiles/test.yaml new file mode 100644 index 000000000..32c747b3f --- /dev/null +++ b/testsuite/tests/build_profile/custom_profiles/test.yaml @@ -0,0 +1 @@ +driver: python-script diff --git a/testsuite/tests/build_profile/custom_switches/test.py b/testsuite/tests/build_profile/custom_switches/test.py new file mode 100644 index 000000000..1c56a077c --- /dev/null +++ b/testsuite/tests/build_profile/custom_switches/test.py @@ -0,0 +1,58 @@ +""" +Check that crates can define custom switches +""" + +from drivers.alr import run_alr, init_local_crate, alr_with, alr_manifest +from drivers.helpers import content_of +from drivers.asserts import assert_match + +init_local_crate('lib_1', binary=False, enter=False) +init_local_crate('lib_2', binary=False, enter=False) +init_local_crate('bin_1', binary=True, enter=True) +alr_with('lib_1', path='../lib_1') +alr_with('lib_2', path='../lib_2') +run_alr('update') + + +def check_config(path, profile, expected_switches=[]): + conf = content_of(path) + assert_match('.*Build_Profile : Build_Profile_Kind := "%s"' % profile, + conf) + + for sw in expected_switches: + assert_match('.*"%s"' % sw,conf) + + +lib1_config = "../lib_1/config/lib_1_config.gpr" +lib2_config = "../lib_2/config/lib_2_config.gpr" +bin_config = "config/bin_1_config.gpr" + +# Check if we can change the profile of a dependency +manifests = [alr_manifest(), '../lib_1/alire.toml', '../lib_2/alire.toml'] + +for path in manifests: + with open(path, "a") as manifest: + manifest.write('[build_switches]\n') + manifest.write('"*".optimization = ["-opt-switch", "-opt-switch2"]\n') + manifest.write('"*".debug_info = ["-debug-info-switch"]\n') + manifest.write('"*".runtime_checks = ["-runtime-checks-switch"]\n') + manifest.write('"*".compile_checks = ["-compile-checks-switch"]\n') + manifest.write('"*".contracts = ["-contracts-switch"]\n') + manifest.write('"*".style_checks = ["-style-switch", "-style-switch2"]\n') + +run_alr('update') + +expected_switches = ['-opt-switch', + '-opt-switch2', + '-debug-info-switch', + '-runtime-checks-switch', + '-compile-checks-switch', + '-contracts-switch', + '-style-switch', + '-style-switch2'] + +check_config(lib1_config, 'RELEASE', expected_switches) +check_config(lib2_config, 'RELEASE', expected_switches) +check_config(bin_config, 'DEVELOPMENT', expected_switches) + +print('SUCCESS') diff --git a/testsuite/tests/build_profile/custom_switches/test.yaml b/testsuite/tests/build_profile/custom_switches/test.yaml new file mode 100644 index 000000000..32c747b3f --- /dev/null +++ b/testsuite/tests/build_profile/custom_switches/test.yaml @@ -0,0 +1 @@ +driver: python-script diff --git a/testsuite/tests/build_profile/default/test.py b/testsuite/tests/build_profile/default/test.py new file mode 100644 index 000000000..01eb69efb --- /dev/null +++ b/testsuite/tests/build_profile/default/test.py @@ -0,0 +1,53 @@ +""" +Check switches for default profiles +""" + +from drivers.alr import run_alr, init_local_crate, alr_with, alr_manifest +from drivers.helpers import content_of +from drivers.asserts import assert_match + +init_local_crate('lib_1', binary=False, enter=False) +init_local_crate('lib_2', binary=False, enter=False) +init_local_crate('bin_1', binary=True, enter=True) +alr_with('lib_1', path='../lib_1') +alr_with('lib_2', path='../lib_2') +run_alr('update') + + +def check_config(path, profile, expected_switches=[]): + conf = content_of(path) + assert_match('.*Build_Profile : Build_Profile_Kind := "%s"' % profile, + conf) + + for sw in expected_switches: + assert_match('.*"%s"' % sw,conf) + + +lib1_config = "../lib_1/config/lib_1_config.gpr" +lib2_config = "../lib_2/config/lib_2_config.gpr" +bin_config = "config/bin_1_config.gpr" + +# Check default profiles for root and dependency +check_config(lib1_config, 'RELEASE', ['-O3', '-gnatn']) +check_config(lib2_config, 'RELEASE', ['-O3', '-gnatn']) +check_config(bin_config, 'DEVELOPMENT', ['-Og', '-g', '-gnatwa', '-gnata', '-gnaty3']) + +# Check if we can change the profile of a dependency +with open(alr_manifest(), "a") as manifest: + manifest.write('[build_profile]\n') + manifest.write('lib_1 = "development"\n') +run_alr('update') +check_config(lib1_config, 'DEVELOPMENT', ['-Og']) + +# Check wildcard profile setting +with open(alr_manifest(), "a") as manifest: + manifest.write('"*" = "validation"\n') +run_alr('update') +check_config(lib1_config, 'DEVELOPMENT', ['-Og']) +check_config(lib2_config, 'VALIDATION', ['-gnatwe']) +check_config(bin_config, 'VALIDATION', ['-gnatwe']) + +# Check that the project builds +run_alr('build') + +print('SUCCESS') diff --git a/testsuite/tests/build_profile/default/test.yaml b/testsuite/tests/build_profile/default/test.yaml new file mode 100644 index 000000000..32c747b3f --- /dev/null +++ b/testsuite/tests/build_profile/default/test.yaml @@ -0,0 +1 @@ +driver: python-script From 261ac387ef97b19b5ef2c63098b7d25f2c00d89b Mon Sep 17 00:00:00 2001 From: Fabien Chouteau Date: Thu, 9 Dec 2021 18:25:27 +0100 Subject: [PATCH 7/9] Alr.Commands.Init: change object dir based on build profile --- src/alr/alr-commands-init.adb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/alr/alr-commands-init.adb b/src/alr/alr-commands-init.adb index d529e6464..2e227da8e 100644 --- a/src/alr/alr-commands-init.adb +++ b/src/alr/alr-commands-init.adb @@ -125,7 +125,7 @@ package body Alr.Commands.Init is Put_New_Line; end if; Put_Line (" for Source_Dirs use (""src"");"); - Put_Line (" for Object_Dir use ""obj"";"); + Put_Line (" for Object_Dir use ""obj/"" & " & Mixed_Name & "_Config.Build_Profile;"); Put_Line (" for Create_Missing_Dirs use ""True"";"); if For_Library then Put_Line (" for Library_Dir use ""lib"";"); From c432494f26faf1259419627b170f2b7bac275a7d Mon Sep 17 00:00:00 2001 From: Fabien Chouteau Date: Mon, 13 Dec 2021 16:29:16 +0100 Subject: [PATCH 8/9] Rename build profile TOML keys --- src/alire/alire-properties-build_switches.adb | 1 + src/alire/alire-toml_keys.ads | 4 ++-- testsuite/tests/build_profile/custom_profiles/test.py | 6 +++--- testsuite/tests/build_profile/custom_switches/test.py | 2 +- testsuite/tests/build_profile/default/test.py | 2 +- 5 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/alire/alire-properties-build_switches.adb b/src/alire/alire-properties-build_switches.adb index e6ec37aa1..e320f518f 100644 --- a/src/alire/alire-properties-build_switches.adb +++ b/src/alire/alire-properties-build_switches.adb @@ -318,6 +318,7 @@ package body Alire.Properties.Build_Switches is overriding function To_TOML (This : Variable) return TOML.TOML_Value is + pragma Unreferenced (This); begin return No_TOML_Value; end To_TOML; diff --git a/src/alire/alire-toml_keys.ads b/src/alire/alire-toml_keys.ads index 23ad3714d..78c671ed1 100644 --- a/src/alire/alire-toml_keys.ads +++ b/src/alire/alire-toml_keys.ads @@ -9,8 +9,8 @@ package Alire.TOML_Keys with Preelaborate is Author : constant String := "authors"; Auto_GPR_With : constant String := "auto-gpr-with"; Available : constant String := "available"; - Build_Profile : constant String := "build_profile"; - Build_Switches : constant String := "build_switches"; + Build_Profile : constant String := "build-profile"; + Build_Switches : constant String := "build-switches"; Case_Others : constant String := "..."; Compiler : constant String := "compiler"; Configuration : constant String := "configuration"; diff --git a/testsuite/tests/build_profile/custom_profiles/test.py b/testsuite/tests/build_profile/custom_profiles/test.py index 8e4439914..b890db70b 100644 --- a/testsuite/tests/build_profile/custom_profiles/test.py +++ b/testsuite/tests/build_profile/custom_profiles/test.py @@ -34,21 +34,21 @@ def check_config(path, profile, expected_switches=[]): # Create custom Release profile for lib_1 with open('../lib_1/alire.toml', "a") as manifest: - manifest.write('[build_switches]\n') + manifest.write('[build-switches]\n') manifest.write('release.optimization = "size"\n') manifest.write('release.contracts = "yes"\n') # Create custom wildcard profile for lib_2 with open('../lib_2/alire.toml', "a") as manifest: - manifest.write('[build_switches]\n') + manifest.write('[build-switches]\n') manifest.write('"*".optimization = "debug"\n') manifest.write('"*".contracts = "no"\n') # Check if we can change the profile of a dependency with open(alr_manifest(), "a") as manifest: - manifest.write('[build_profile]\n') + manifest.write('[build-profile]\n') manifest.write('lib_2 = "validation"\n') run_alr('update') diff --git a/testsuite/tests/build_profile/custom_switches/test.py b/testsuite/tests/build_profile/custom_switches/test.py index 1c56a077c..433641dce 100644 --- a/testsuite/tests/build_profile/custom_switches/test.py +++ b/testsuite/tests/build_profile/custom_switches/test.py @@ -32,7 +32,7 @@ def check_config(path, profile, expected_switches=[]): for path in manifests: with open(path, "a") as manifest: - manifest.write('[build_switches]\n') + manifest.write('[build-switches]\n') manifest.write('"*".optimization = ["-opt-switch", "-opt-switch2"]\n') manifest.write('"*".debug_info = ["-debug-info-switch"]\n') manifest.write('"*".runtime_checks = ["-runtime-checks-switch"]\n') diff --git a/testsuite/tests/build_profile/default/test.py b/testsuite/tests/build_profile/default/test.py index 01eb69efb..d316705af 100644 --- a/testsuite/tests/build_profile/default/test.py +++ b/testsuite/tests/build_profile/default/test.py @@ -34,7 +34,7 @@ def check_config(path, profile, expected_switches=[]): # Check if we can change the profile of a dependency with open(alr_manifest(), "a") as manifest: - manifest.write('[build_profile]\n') + manifest.write('[build-profile]\n') manifest.write('lib_1 = "development"\n') run_alr('update') check_config(lib1_config, 'DEVELOPMENT', ['-Og']) From b6d21bd585211de6625fe18fe6903fd98115e9f7 Mon Sep 17 00:00:00 2001 From: Fabien Chouteau Date: Mon, 13 Dec 2021 17:11:39 +0100 Subject: [PATCH 9/9] Alire.Utils.Switches: remove style switch not available in GNAT 9 --- src/alire/alire-utils-switches.adb | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/alire/alire-utils-switches.adb b/src/alire/alire-utils-switches.adb index 75cd56d24..1815744bd 100644 --- a/src/alire/alire-utils-switches.adb +++ b/src/alire/alire-utils-switches.adb @@ -145,7 +145,8 @@ package body Alire.Utils.Switches is .Append ("-gnatyb") .Append ("-gnatyc") .Append ("-gnaty-d") - .Append ("-gnatyD") + -- -gnatyD is not available in GNAT 9 + -- .Append ("-gnatyD") .Append ("-gnatye") .Append ("-gnatyf") .Append ("-gnatyh")