guix build: Support '--with-source=PACKAGE@VERSION=URI'.

* 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, PKG@VER=URI"): New tests.
* doc/guix.texi (Package Transformation Options): Document the new
forms.
This commit is contained in:
Ludovic Courtès 2017-12-22 23:40:57 +01:00
parent 85f075a057
commit 3e30cdf1c3
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 94 additions and 36 deletions

View File

@ -5430,14 +5430,20 @@ without having to type in the definitions of package variants
@table @code @table @code
@item --with-source=@var{source} @item --with-source=@var{source}
Use @var{source} as the source of the corresponding package. @itemx --with-source=@var{package}=@var{source}
@itemx --with-source=@var{package}@@@var{version}=@var{source}
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 @var{source} must be a file name or a URL, as for @command{guix
download} (@pxref{Invoking guix download}). download} (@pxref{Invoking guix download}).
The ``corresponding package'' is taken to be the one specified on the When @var{package} is omitted,
command line the name of which matches the base of @var{source}---e.g., 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 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}. @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 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 @example
$ git clone git://git.sv.gnu.org/guix.git $ 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 @end example
@item --with-input=@var{package}=@var{replacement} @item --with-input=@var{package}=@var{replacement}

View File

@ -25,9 +25,12 @@
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix grafts) #:use-module (guix grafts)
#:use-module (guix utils)
;; Use the procedure that destructures "NAME-VERSION" forms. ;; Use the procedure that destructures "NAME-VERSION" forms.
#:use-module ((guix utils) #:hide (package-name->name+version)) #:use-module ((guix build utils)
#:use-module ((guix build utils) #:select (package-name->name+version)) #:select ((package-name->name+version
. hyphen-package-name->name+version)))
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix gexp) #:use-module (guix gexp)
@ -127,16 +130,13 @@ found. Return #f if no build log was found."
(define register-root* (define register-root*
(store-lift register-root)) (store-lift register-root))
(define (package-with-source store p uri)
"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) (define (numeric-extension? file-name)
;; Return true if FILE-NAME ends with digits. "Return true if FILE-NAME ends with digits."
(string-every char-set:hex-digit (file-extension file-name))) (string-every char-set:hex-digit (file-extension file-name)))
(define (tarball-base-name file-name) (define (tarball-base-name file-name)
;; Return the "base" of FILE-NAME, removing '.tar.gz' or similar "Return the \"base\" of FILE-NAME, removing '.tar.gz' or similar
;; extensions. extensions."
;; TODO: Factorize. ;; TODO: Factorize.
(cond ((not (file-extension file-name)) (cond ((not (file-extension file-name))
file-name) file-name)
@ -145,15 +145,22 @@ the new package's version number from URI."
((string=? (file-extension file-name) "tar") ((string=? (file-extension file-name) "tar")
(file-sans-extension file-name)) (file-sans-extension file-name))
((file-extension file-name) ((file-extension file-name)
(tarball-base-name (file-sans-extension file-name))) =>
(match-lambda
("scm" file-name)
(else (tarball-base-name (file-sans-extension file-name)))))
(else (else
file-name))) 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."
(let ((base (tarball-base-name (basename uri)))) (let ((base (tarball-base-name (basename uri))))
(let-values (((name version) (let-values (((_ version*)
(package-name->name+version base))) (hyphen-package-name->name+version base)))
(package (inherit p) (package (inherit p)
(version (or version (package-version p))) (version (or version version*
(package-version p)))
;; Use #:recursive? #t to allow for directories. ;; Use #:recursive? #t to allow for directories.
(source (download-to-store store uri (source (download-to-store store uri
@ -173,8 +180,23 @@ the new package's version number from URI."
matching URIs given in SOURCES." matching URIs given in SOURCES."
(define new-sources (define new-sources
(map (lambda (uri) (map (lambda (uri)
(cons (package-name->name+version (basename uri)) (match (string-index uri #\=)
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 "PKG@VER" 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)) sources))
(lambda (store obj) (lambda (store obj)
@ -182,9 +204,10 @@ matching URIs given in SOURCES."
(result '())) (result '()))
(match obj (match obj
((? package? p) ((? package? p)
(let ((source (assoc-ref sources (package-name p)))) (match (assoc-ref sources (package-name p))
(if source ((version source)
(package-with-source store p source) (package-with-source store p source version))
(#f
p))) p)))
(_ (_
obj))))) obj)))))

View File

@ -96,6 +96,35 @@
(string-contains (get-output-string port) (string-contains (get-output-string port)
"had no effect")))))) "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, PKG@VER=URI"
(let* ((p (dummy-package "foo"))
(s (search-path %load-path "guix.scm"))
(f (string-append "foo@42.0=" 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" (test-assert "options->transformation, with-input"
(let* ((p (dummy-package "guix.scm" (let* ((p (dummy-package "guix.scm"
(inputs `(("foo" ,(specification->package "coreutils")) (inputs `(("foo" ,(specification->package "coreutils"))