Merge pull request #33 from pmderodat/master

Add support for SVN repositories and source archives, add releases for Ini_Files and GNATCOLL core
This commit is contained in:
Alejandro R Mosteo
2018-10-17 16:35:10 +02:00
committed by GitHub
7 changed files with 251 additions and 65 deletions
+35 -24
View File
@@ -1,3 +1,5 @@
with Ada.Directories;
package Alire.Index.GNATCOLL is
function Project is new Catalogued_Project
@@ -9,32 +11,41 @@ package Alire.Index.GNATCOLL is
Repo_Alire : constant URL := "https://github.com/alire-project/gnatcoll-core.git";
-- For slim picks
Base : constant Release :=
Project.Unreleased
(Properties =>
Author ("AdaCore") and
Maintainer ("alejandro@mosteo.com") and
License (GPL_3_0) and
Base : constant Release := Project.Unreleased
(Properties =>
Author ("AdaCore")
and Maintainer ("alejandro@mosteo.com")
and License (GPL_3_0)
and GPR_Scenario ("GNATCOLL_ATOMICS",
"intrinsic" or "mutex")
and GPR_Scenario ("GNATCOLL_OS",
"windows" or "unix" or "osx")
and GPR_Scenario ("BUILD",
"DEBUG" or "PROD")
and GPR_Scenario ("LIBRARY_TYPE",
"relocatable" or "static" or "static-pic"),
Private_Properties =>
GPR_External ("BUILD", "PROD") and
GPR_External ("LIBRARY_TYPE", "static-pic") and
Case_Operating_System_Is
((GNU_Linux => GPR_External ("GNATCOLL_OS", "unix"),
OSX => GPR_External ("GNATCOLL_OS", "osx"),
Windows => GPR_External ("GNATCOLL_OS", "windows"),
OS_Unknown => GPR_External ("GNATCOLL_OS", "ERROR"))));
Project_File ("gnatcoll.gpr") and
GPR_Scenario ("GNATCOLL_ATOMICS",
"intrinsic" or "mutex") and
GPR_Scenario ("GNATCOLL_OS",
"windows" or "unix" or "osx") and
GPR_Scenario ("BUILD",
"DEBUG" or "PROD") and
GPR_Scenario ("LIBRARY_TYPE",
"relocatable" or "static" or "static-pic"),
package Regular is
Private_Properties =>
GPR_External ("BUILD", "PROD") and
GPR_External ("LIBRARY_TYPE", "static-pic") and
Case_Operating_System_Is
((GNU_Linux => GPR_External ("GNATCOLL_OS", "unix"),
OSX => GPR_External ("GNATCOLL_OS", "osx"),
Windows => GPR_External ("GNATCOLL_OS", "windows"),
OS_Unknown => GPR_External ("GNATCOLL_OS", "ERROR")))
);
package V_2018 is new Project_Release
(Base
.Renaming (GNATCOLL.Project)
.Replacing (Source_Archive
("http://mirrors.cdn.adacore.com/art/5b0819dfc7a447df26c27a99",
"gnatcoll-core-gpl-2018-20180524-src.tar.gz"))
.Extending
(Properties => Project_File (Ada.Directories.Compose
("gnatcoll-core-gpl-2018-src", "gnatcoll.gpr"))));
end Regular;
package Slim is
+18
View File
@@ -0,0 +1,18 @@
package Alire.Index.Ini_Files is
function Project is new Catalogued_Project
("A standalone, portable Ada package for configuration files");
Base : constant Release := Project.Unreleased
(Version => V ("08"),
Properties => Project_File ("ini_files_gnat.gpr")
and Author ("Gautier de Montmollin & Rolf Ebert")
and Website ("https://sourceforge.net/p/ini-files/")
and License (MIT));
package V_8 is new Project_Release
(Base
.Renaming (Project)
.Replacing (SVN ("https://svn.code.sf.net/p/ini-files/code/", "28")));
end Alire.Index.Ini_Files;
+1 -1
View File
@@ -3,7 +3,7 @@ with Alire.Index.Zlib_Ada;
package Alire.Index.PNG_IO is
function Project is new Catalogued_Project
("ZLib for Ada thick binding");
("Ada95 coder/decoder for Portable Network Graphics");
Repo : constant URL := "https://github.com/alire-project/png_io.git";
+4
View File
@@ -163,6 +163,7 @@ package Alire.Index is
function Git (URL : Alire.URL; Commit : Origins.Git_Commit) return Origins.Origin renames Origins.New_Git;
function Hg (URL : Alire.URL; Commit : Origins.Hg_Commit) return Origins.Origin renames Origins.New_Hg;
function SVN (URL : Alire.URL; Commit : String) return Origins.Origin renames Origins.New_SVN;
function Packaged_As (S : String) return Origins.Package_Names renames Origins.Packaged_As;
@@ -170,6 +171,9 @@ package Alire.Index is
function Native (Distros : Origins.Native_Packages) return Origins.Origin renames Origins.New_Native;
function Source_Archive (URL : Alire.URL; Name : String := "") return Origins.Origin
renames Origins.New_Source_Archive;
------------------
-- Dependencies --
------------------
+94
View File
@@ -0,0 +1,94 @@
package body Alire.Origins is
function Ends_With (S : String; Suffix : String) return Boolean is
(S'Length >= Suffix'Length
and then S (S'Last - Suffix'Length + 1 .. S'Last) = Suffix);
-- Return whether the S string ends with the given Suffix sub-string
function URL_Basename (URL : Alire.URL) return String;
-- Try to get a basename for the given URL. Return an empty string on
-- failure.
function Archive_Format (Name : String) return Source_Archive_Format;
-- Guess the format of a source archive from its file name
------------------
-- URL_Basename --
------------------
function URL_Basename (URL : Alire.URL) return String is
Separator : Positive;
-- Index of the first URL separator we can find ('#' or '?') in URL
Last_Slash : Natural;
-- Index of the last slash character in URL before the first URL
-- separator.
begin
Last_Slash := 0;
Separator := URL'Last + 1;
for I in URL'Range loop
case URL (I) is
when '?' | '#' =>
Separator := I;
exit;
when '/' =>
Last_Slash := I;
when others =>
null;
end case;
end loop;
return URL (Last_Slash + 1 .. Separator);
end URL_Basename;
--------------------
-- Archive_Format --
--------------------
function Archive_Format (Name : String) return Source_Archive_Format is
begin
if Ends_With (Name, ".zip") then
return Zip_Archive;
elsif Ends_With (Name, ".tar")
or else Ends_With (Name, ".tar.gz")
or else Ends_With (Name, ".tgz")
or else Ends_With (Name, ".tar.bz2")
or else Ends_With (Name, ".tbz2")
or else Ends_With (Name, ".tar.xz")
then
return Tarball;
else
return Unknown;
end if;
end Archive_Format;
------------------------
-- New_Source_Archive --
------------------------
function New_Source_Archive
(URL : Alire.URL; Name : String := "") return Origin
is
Archive_Name : constant String :=
(if Name'Length = 0 then URL_Basename (URL) else Name);
Format : Source_Archive_Format;
begin
if Archive_Name'Length = 0 then
raise Unknown_Source_Archive_Name_Error with
"Unable to determine archive name: please specify one";
end if;
Format := Archive_Format (Archive_Name);
if Format not in Known_Source_Archive_Format then
raise Unknown_Source_Archive_Format_Error with
"Unable to determine archive format from file extension";
end if;
return (Data => (Source_Archive, +URL, +Archive_Name, Format));
end New_Source_Archive;
end Alire.Origins;
+91 -35
View File
@@ -27,12 +27,22 @@ package Alire.Origins with Preelaborate is
type Native_Packages is array (Platforms.Distributions) of Package_Names;
-- The name of a package in every distro for a given version
type Kinds is (Filesystem, -- Not really an origin, but a working copy of a project
Git, -- Remote git repo
Hg, -- Remote hg repo
Native -- Native platform package
type Kinds is (Filesystem, -- Not really an origin, but a working copy of a project
Git, -- Remote git repo
Hg, -- Remote hg repo
SVN, -- Remote svn repo
Source_Archive, -- Remote source archive
Native -- Native platform package
);
subtype VCS_Kinds is Kinds range Git .. SVN;
type Source_Archive_Format is (Unknown, Tarball, Zip_Archive);
subtype Known_Source_Archive_Format is
Source_Archive_Format range Tarball .. Source_Archive_Format'Last;
Unknown_Source_Archive_Format_Error : exception;
type Origin is new Interfaces.Codifiable with private;
function Kind (This : Origin) return Kinds;
@@ -41,11 +51,18 @@ package Alire.Origins with Preelaborate is
-- member data --
-------------------
function Commit (This : Origin) return String with Pre => This.Kind in Git | Hg;
function URL (This : Origin) return Alire.URL with Pre => This.Kind in Git | Hg;
function Commit (This : Origin) return String with Pre => This.Kind in VCS_Kinds;
function URL (This : Origin) return Alire.URL with Pre => This.Kind in VCS_Kinds;
function Path (This : Origin) return String with Pre => This.Kind = Filesystem;
function Archive_URL (This : Origin) return Alire.URL
with Pre => This.Kind = Source_Archive;
function Archive_Name (This : Origin) return String
with Pre => This.Kind = Source_Archive;
function Archive_Format (This : Origin) return Known_Source_Archive_Format
with Pre => This.Kind = Source_Archive;
function Is_Native (This : Origin) return Boolean is (This.Kind = Native);
function Package_Name (This : Origin;
Distribution : Platforms.Distributions)
@@ -69,6 +86,22 @@ package Alire.Origins with Preelaborate is
Commit : Hg_Commit)
return Origin;
function New_SVN (URL : Alire.URL; Commit : String) return Origin;
Unknown_Source_Archive_Name_Error : exception;
function New_Source_Archive
(URL : Alire.URL; Name : String := "") return Origin;
-- Create a reference to a source archive to be downloaded and extracted.
-- URL is the address of the archive to download. Name is the name of the file to download.
--
-- This raises an Unknown_Source_Archive_Format_Error exception when we
-- either cannot deduce the archive format from its filename or when the
-- archive format is unknown.
--
-- If Name is omitted, it is tentatively inferred from URL. If it cannot be
-- inferred, this raises a Unknown_Source_Archive_Name_Error exception.
function New_Native (Packages : Native_Packages) return Origin;
function Image (This : Origin) return String;
@@ -90,63 +123,86 @@ private
function Unavailable return Package_Names is (Name => Null_Unbounded_String);
function Packaged_As (Name : String) return Package_Names is (Name => +Name);
type Origin is new Interfaces.Codifiable with record
Kind : Kinds;
type Origin_Data (Kind : Kinds := Kinds'First) is record
case Kind is
when Filesystem =>
Path : Unbounded_String;
Commit : Unbounded_String;
URL : Unbounded_String;
when VCS_Kinds =>
Repo_URL : Unbounded_String;
Commit : Unbounded_String;
Packages : Native_Packages;
when Source_Archive =>
Archive_URL : Unbounded_String;
Archive_Name : Unbounded_String;
Archive_Format : Known_Source_Archive_Format;
Path : Unbounded_String;
when Native =>
Packages : Native_Packages;
end case;
end record;
type Origin is new Interfaces.Codifiable with record
Data : Origin_Data;
end record;
function New_Filesystem (Path : String) return Origin is
(Filesystem,
Path => +Path,
others => <>);
(Data => (Filesystem, Path => +Path));
function New_Git (URL : Alire.URL;
Commit : Git_Commit)
return Origin is
(Git,
URL => +URL,
Commit => +Commit,
others => <>);
(Data => (Git, +URL, +Commit));
function New_Hg (URL : Alire.URL;
Commit : Hg_Commit)
return Origin is
(Hg,
URL => +URL,
Commit => +Commit,
others => <>);
(Data => (Hg, +URL, +Commit));
function New_SVN (URL : Alire.URL; Commit : String) return Origin is
(Data => (SVN, +URL, +Commit));
function New_Native (Packages : Native_Packages) return Origin is
(Native,
Packages => Packages,
others => <>);
(Data => (Native, Packages));
function Kind (This : Origin) return Kinds is (This.Kind);
function Kind (This : Origin) return Kinds is (This.Data.Kind);
function URL (This : Origin) return Alire.URL is (Alire.URL (+This.URL));
function Commit (This : Origin) return String is (+This.Commit);
function URL (This : Origin) return Alire.URL is
(Alire.URL (+This.Data.Repo_URL));
function Commit (This : Origin) return String is
(+This.Data.Commit);
function Path (This : Origin) return String is (+This.Path);
function Path (This : Origin) return String is (+This.Data.Path);
function Archive_URL (This : Origin) return Alire.URL is
(+This.Data.Archive_URL);
function Archive_Name (This : Origin) return String is
(+This.Data.Archive_Name);
function Archive_Format (This : Origin) return Known_Source_Archive_Format
is (This.Data.Archive_Format);
function Package_Name (This : Origin;
Distribution : Platforms.Distributions)
return String is (+This.Packages (Distribution).Name);
return String is
(+This.Data.Packages (Distribution).Name);
function All_Native_Names (This : Origin) return Native_Packages is (This.Packages);
function All_Native_Names (This : Origin) return Native_Packages is
(This.Data.Packages);
function S (Str : Unbounded_String) return String is (To_String (Str));
function Image (This : Origin) return String is
(case This.Kind is
when Git | Hg => "commit " & S (This.Commit) & " from " & S (This.URL),
when Native => "native package from platform software manager",
when Filesystem => "path " & S (This.Path));
when VCS_Kinds =>
"commit " & S (This.Data.Commit)
& " from " & S (This.Data.Repo_URL),
when Source_Archive =>
"source archive " & S (This.Data.Archive_Name)
& " at " & S (This.Data.Archive_URL),
when Native =>
"native package from platform software manager",
when Filesystem =>
"path " & S (This.Data.Path));
overriding function To_Code (This : Origin) return Utils.String_Vector is
(if This.Kind = Filesystem
+8 -5
View File
@@ -276,11 +276,14 @@ private
(Utils.Head (+R.Project, Extension_Separator) & "_" &
Image (R.Version) & "_" &
(case R.Origin.Kind is
when Filesystem => "filesystem",
when Native => "native",
when Git | Hg => (if R.Origin.Commit'Length <= 8
then R.Origin.Commit
else R.Origin.Commit (R.Origin.Commit'First .. R.Origin.Commit'First + 7))));
when Filesystem => "filesystem",
when Native => "native",
when Source_Archive => "archive",
when Git | Hg =>
(if R.Origin.Commit'Length <= 8
then R.Origin.Commit
else R.Origin.Commit (R.Origin.Commit'First .. R.Origin.Commit'First + 7)),
when SVN => R.Origin.Commit));
function On_Platform_Actions (R : Release; P : Alire.Properties.Vector) return Alire.Properties.Vector is
(R.On_Platform_Properties (P, Actions.Action'Tag));