01/02: guix build: Support 'address@hidden'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 3e30cdf1c35ebeb52630ec19b3b43b9e6d5ffb81
Author: Ludovic Courtès <address@hidden>
Date:   Fri Dec 22 23:40:57 2017 +0100

    guix build: Support 'address@hidden'.
    
    * guix/scripts/build.scm (numeric-extension?, tarball-base-name): New
    procedures, formerly in 'package-with-source'.
    (transform-package-source)[new-sources]: Look for '=' in URI.  Each
    element of the list of now a (PKG VERSION SOURCE) tuple.
    Pass VERSION to 'package-with-source'.
    (package-with-source): Add 'version' parameter and honor it.
    * tests/scripts-build.scm ("options->transformation, with-source, PKG=URI")
    ("options->transformation, with-source, address@hidden"): New tests.
    * doc/guix.texi (Package Transformation Options): Document the new
    forms.
---
 doc/guix.texi           | 16 +++++++---
 guix/scripts/build.scm  | 85 +++++++++++++++++++++++++++++++------------------
 tests/scripts-build.scm | 29 +++++++++++++++++
 3 files changed, 94 insertions(+), 36 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 94d4d8f..4e83c76 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5430,14 +5430,20 @@ without having to type in the definitions of package 
variants
 @table @code
 
 @item address@hidden
-Use @var{source} as the source of the corresponding package.
address@hidden address@hidden@var{source}
address@hidden address@hidden@@@address@hidden
+Use @var{source} as the source of @var{package}, and @var{version} as
+its version number.
 @var{source} must be a file name or a URL, as for @command{guix
 download} (@pxref{Invoking guix download}).
 
-The ``corresponding package'' is taken to be the one specified on the
-command line the name of which matches the base of @var{source}---e.g.,
+When @var{package} is omitted,
+it is taken to be the package name specified on the
+command line that matches the base of @var{source}---e.g.,
 if @var{source} is @code{/src/guile-2.0.10.tar.gz}, the corresponding
-package is @code{guile}.  Likewise, the version string is inferred from
+package is @code{guile}.
+
+Likewise, when @var{version} is omitted, the version string is inferred from
 @var{source}; in the previous example, it is @code{2.0.10}.
 
 This option allows users to try out versions of packages other than the
@@ -5460,7 +5466,7 @@ guix build guile 
--with-source=../guile-2.0.9.219-e1bb7.tar.xz
 
 @example
 $ git clone git://git.sv.gnu.org/guix.git
-$ guix build guix --with-source=./guix
+$ guix build guix --with-source=guix@@1.0=./guix
 @end example
 
 @item address@hidden@var{replacement}
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 0571b87..57f2d82 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -25,9 +25,12 @@
   #:use-module (guix packages)
   #:use-module (guix grafts)
 
+  #:use-module (guix utils)
+
   ;; Use the procedure that destructures "NAME-VERSION" forms.
-  #:use-module ((guix utils) #:hide (package-name->name+version))
-  #:use-module ((guix build utils) #:select (package-name->name+version))
+  #:use-module ((guix build utils)
+                #:select ((package-name->name+version
+                           . hyphen-package-name->name+version)))
 
   #:use-module (guix monads)
   #:use-module (guix gexp)
@@ -127,33 +130,37 @@ found.  Return #f if no build log was found."
 (define register-root*
   (store-lift register-root))
 
-(define (package-with-source store p uri)
+(define (numeric-extension? file-name)
+  "Return true if FILE-NAME ends with digits."
+  (string-every char-set:hex-digit (file-extension file-name)))
+
+(define (tarball-base-name file-name)
+  "Return the \"base\" of FILE-NAME, removing '.tar.gz' or similar
+extensions."
+  ;; TODO: Factorize.
+  (cond ((not (file-extension file-name))
+         file-name)
+        ((numeric-extension? file-name)
+         file-name)
+        ((string=? (file-extension file-name) "tar")
+         (file-sans-extension file-name))
+        ((file-extension file-name)
+         =>
+         (match-lambda
+           ("scm" file-name)
+           (else  (tarball-base-name (file-sans-extension file-name)))))
+        (else
+         file-name)))
+
+(define* (package-with-source store p uri #:optional version)
   "Return a package based on P but with its source taken from URI.  Extract
 the new package's version number from URI."
-  (define (numeric-extension? file-name)
-    ;; Return true if FILE-NAME ends with digits.
-    (string-every char-set:hex-digit (file-extension file-name)))
-
-  (define (tarball-base-name file-name)
-    ;; Return the "base" of FILE-NAME, removing '.tar.gz' or similar
-    ;; extensions.
-    ;; TODO: Factorize.
-    (cond ((not (file-extension file-name))
-           file-name)
-          ((numeric-extension? file-name)
-           file-name)
-          ((string=? (file-extension file-name) "tar")
-           (file-sans-extension file-name))
-          ((file-extension file-name)
-           (tarball-base-name (file-sans-extension file-name)))
-          (else
-           file-name)))
-
   (let ((base (tarball-base-name (basename uri))))
-    (let-values (((name version)
-                  (package-name->name+version base)))
+    (let-values (((_ version*)
+                  (hyphen-package-name->name+version base)))
       (package (inherit p)
-               (version (or version (package-version p)))
+               (version (or version version*
+                            (package-version p)))
 
                ;; Use #:recursive? #t to allow for directories.
                (source (download-to-store store uri
@@ -173,8 +180,23 @@ the new package's version number from URI."
 matching URIs given in SOURCES."
   (define new-sources
     (map (lambda (uri)
-           (cons (package-name->name+version (basename uri))
-                 uri))
+           (match (string-index uri #\=)
+             (#f
+              ;; Determine the package name and version from URI.
+              (call-with-values
+                  (lambda ()
+                    (hyphen-package-name->name+version
+                     (tarball-base-name (basename uri))))
+                (lambda (name version)
+                  (list name version uri))))
+             (index
+              ;; What's before INDEX is a "address@hidden" or "PKG" spec.
+              (call-with-values
+                  (lambda ()
+                    (package-name->name+version (string-take uri index)))
+                (lambda (name version)
+                  (list name version
+                        (string-drop uri (+ 1 index))))))))
          sources))
 
   (lambda (store obj)
@@ -182,10 +204,11 @@ matching URIs given in SOURCES."
                (result   '()))
       (match obj
         ((? package? p)
-         (let ((source (assoc-ref sources (package-name p))))
-           (if source
-               (package-with-source store p source)
-               p)))
+         (match (assoc-ref sources (package-name p))
+           ((version source)
+            (package-with-source store p source version))
+           (#f
+            p)))
         (_
          obj)))))
 
diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm
index a408ea6..190426e 100644
--- a/tests/scripts-build.scm
+++ b/tests/scripts-build.scm
@@ -96,6 +96,35 @@
              (string-contains (get-output-string port)
                               "had no effect"))))))
 
+(test-assert "options->transformation, with-source, PKG=URI"
+  (let* ((p (dummy-package "foo"))
+         (s (search-path %load-path "guix.scm"))
+         (f (string-append "foo=" s))
+         (t (options->transformation `((with-source . ,f)))))
+    (with-store store
+      (let ((new (t store p)))
+        (and (not (eq? new p))
+             (string=? (package-name new) (package-name p))
+             (string=? (package-version new)
+                       (package-version p))
+             (string=? (package-source new)
+                       (add-to-store store (basename s) #t
+                                     "sha256" s)))))))
+
+(test-assert "options->transformation, with-source, address@hidden"
+  (let* ((p (dummy-package "foo"))
+         (s (search-path %load-path "guix.scm"))
+         (f (string-append "address@hidden" s))
+         (t (options->transformation `((with-source . ,f)))))
+    (with-store store
+      (let ((new (t store p)))
+        (and (not (eq? new p))
+             (string=? (package-name new) (package-name p))
+             (string=? (package-version new) "42.0")
+             (string=? (package-source new)
+                       (add-to-store store (basename s) #t
+                                     "sha256" s)))))))
+
 (test-assert "options->transformation, with-input"
   (let* ((p (dummy-package "guix.scm"
               (inputs `(("foo" ,(specification->package "coreutils"))