From b35b093cb488ff510b29b94e21bcb5271ef9d7b4 Mon Sep 17 00:00:00 2001 From: Fabien Chouteau Date: Tue, 25 Apr 2023 13:19:02 +0200 Subject: [PATCH] Alr init fixes (#1372) * Alr.Commands.Init: improve error message on tag input validation * Alr.Commands.Init: fix string escape for generated manifest * Alr.Commands.Init: add LLVM-exception options and change default --- src/alire/alire-utils.adb | 39 +++++++++++++++++++++++++++++------ src/alire/alire-utils.ads | 5 +++++ src/alire/alire.adb | 4 ++-- src/alire/alire.ads | 1 + src/alr/alr-commands-init.adb | 19 +++++++++++------ 5 files changed, 54 insertions(+), 14 deletions(-) diff --git a/src/alire/alire-utils.adb b/src/alire/alire-utils.adb index dc855fe6..9de24c5e 100644 --- a/src/alire/alire-utils.adb +++ b/src/alire/alire-utils.adb @@ -6,6 +6,8 @@ with Ada.Strings.Maps; with GNAT.OS_Lib; with GNAT.Regpat; +with Alire.Utils.TTY; + package body Alire.Utils is --------------------------- @@ -183,16 +185,41 @@ package body Alire.Utils is and then User (User'Last) /= '-' and then not AAA.Strings.Contains (User, "--")); + ------------------ + -- Error_In_Tag -- + ------------------ + + function Error_In_Tag (Tag : String) return String + is + Err : UString; + use type UString; + begin + if Tag'Length < 1 then + Err := +"Tag too short (Min " & Min_Tag_Length'Img & ")."; + elsif Tag'Length > Max_Tag_Length then + Err := +"Tag too long (Max " & Max_Tag_Length'Img & ")."; + elsif Tag (Tag'First) = '-' or else Tag (Tag'Last) = '-' then + Err := +"Tags must not begin/end with an hyphen."; + elsif AAA.Strings.Contains (Tag, "--") then + Err := +"Tags cannot have two consecutive hyphens."; + elsif (for some C of Tag => C not in Tag_Character) then + Err := +"Tags must be lowercase ASCII alphanumerical" & + " with optional hyphens."; + end if; + + if Err /= "" then + return "Invalid Tag '" & Utils.TTY.Name (Tag) & "': " & (+Err); + else + return ""; + end if; + end Error_In_Tag; + ------------------ -- Is_Valid_Tag -- ------------------ - function Is_Valid_Tag (Tag : String) return Boolean is - ((for all C of Tag => C in '0' .. '9' | 'a' .. 'z' | '-') - and then Tag'Length in 1 .. Max_Tag_Length - and then Tag (Tag'First) /= '-' - and then Tag (Tag'Last) /= '-' - and then not AAA.Strings.Contains (Tag, "--")); + function Is_Valid_Tag (Tag : String) return Boolean + is (Error_In_Tag (Tag) = ""); -------------------- -- Image_One_Line -- diff --git a/src/alire/alire-utils.ads b/src/alire/alire-utils.ads index 8bc016b3..cbbdaa0b 100644 --- a/src/alire/alire-utils.ads +++ b/src/alire/alire-utils.ads @@ -38,6 +38,11 @@ package Alire.Utils with Preelaborate is -- Check username is valid according to -- https://github.com/shinnn/github-username-regex + subtype Tag_Character is Character + with Static_Predicate => Tag_Character in + 'a' .. 'z' | '0' .. '9' | '-'; + + function Error_In_Tag (Tag : String) return String; function Is_Valid_Tag (Tag : String) return Boolean; function Quote (S : String) return String; diff --git a/src/alire/alire.adb b/src/alire/alire.adb index fa5a05d0..0ea6abb2 100644 --- a/src/alire/alire.adb +++ b/src/alire/alire.adb @@ -165,9 +165,9 @@ package body Alire is use type UString; begin if S'Length < Min_Name_Length then - Err := +"Identifier too short."; + Err := +"Identifier too short (Min " & Min_Name_Length'Img & ")."; elsif S'Length > Max_Name_Length then - Err := +"Identifier too long."; + Err := +"Identifier too long (Max " & Max_Tag_Length'Img & ")."; elsif S (S'First) = '_' then Err := +"Identifiers must not begin with an underscore."; elsif (for some C of S => C not in Crate_Character) then diff --git a/src/alire/alire.ads b/src/alire/alire.ads index 4d09bef6..8deb8a90 100644 --- a/src/alire/alire.ads +++ b/src/alire/alire.ads @@ -41,6 +41,7 @@ package Alire with Preelaborate is Max_Description_Length : constant := 72; -- Git line recommendation (although it's 50 for subject line) + Min_Tag_Length : constant := 1; Max_Tag_Length : constant := 15; -- Maximum length of a single element of the tags field diff --git a/src/alr/alr-commands-init.adb b/src/alr/alr-commands-init.adb index f6d93ea3..e0105901 100644 --- a/src/alr/alr-commands-init.adb +++ b/src/alr/alr-commands-init.adb @@ -84,7 +84,7 @@ package body Alr.Commands.Init is '"'); end Escape; - function Q (S : String) return String is ("""" & S & """"); + function Q (S : String) return String is ("""" & Escape (S) & """"); -- Quote string function Q (S : Unbounded_String) return String @@ -262,7 +262,7 @@ package body Alr.Commands.Init is -- require encoding, as emails and logins cannot contain strange -- characters. Login : constant String := To_String (Info.GitHub_Login); - Username : constant String := Escape (To_String (Info.Username)); + Username : constant String := To_String (Info.Username); Email : constant String := To_String (Info.Email); Filename : constant String := +Full_Name (Directory / (+Alire.Roots.Crate_File_Name)); @@ -427,8 +427,9 @@ package body Alr.Commands.Init is License_Vect : constant AAA.Strings.Vector := AAA.Strings.Empty_Vector - .Append ("MIT OR Apache-2.0") + .Append ("MIT OR Apache-2.0 WITH LLVM-exception") .Append ("MIT") + .Append ("Apache-2.0 WITH LLVM-exception") .Append ("Apache-2.0") .Append ("BSD-3-Clause") .Append ("LGPL-3.0-or-later") @@ -521,9 +522,15 @@ package body Alr.Commands.Init is Tags_Ok : Boolean := True; begin for Elt of Vect loop - if Elt /= "" and then not Alire.Utils.Is_Valid_Tag (Elt) then - Ada.Text_IO.Put_Line ("Invalid tag: '" & Elt & "'"); - Tags_Ok := False; + if Elt /= "" then + declare + Tag_Error : constant String := Alire.Utils.Error_In_Tag (Elt); + begin + if Tag_Error /= "" then + Ada.Text_IO.Put_Line (Tag_Error); + Tags_Ok := False; + end if; + end; end if; end loop; -- 2.39.5