guix build: Add '--with-commit'.
* guix/git.scm (<git-checkout>)[commit]: New field. (git-checkout-compiler): Honor it. * guix/scripts/build.scm (evaluate-git-replacement-specs): Add 'proc' parameter and honor it. (transform-package-source-branch)[replace]: New procedure. Adjust 'evaluate-git-replacement-specs' accordingly. (transform-package-source-commit): New procedure. (%transformations, %transformation-options) (show-transformation-options-help): Add 'with-commit'. * tests/guix-build-branch.sh: Add test. * doc/guix.texi (Package Transformation Options): Document it.
This commit is contained in:
Ludovic Courtès
Ludovic Courtès
parent
96915a448c
commit
b18f7234aa
|
|
@ -6478,6 +6478,11 @@ integration (CI).
|
|||
Checkouts are kept in a cache under @file{~/.cache/guix/checkouts} to speed up
|
||||
consecutive accesses to the same repository. You may want to clean it up once
|
||||
in a while to save disk space.
|
||||
|
||||
@item --with-commit=@var{package}=@var{commit}
|
||||
This is similar to @code{--with-branch}, except that it builds from
|
||||
@var{commit} rather than the tip of a branch. @var{commit} must be a valid
|
||||
Git commit SHA1 identifier.
|
||||
@end table
|
||||
|
||||
@node Additional Build Options
|
||||
|
|
|
|||
11
guix/git.scm
11
guix/git.scm
|
|
@ -198,12 +198,13 @@ Log progress and checkout info to LOG-PORT."
|
|||
;;; Checkouts.
|
||||
;;;
|
||||
|
||||
;; Representation of the "latest" checkout of a branch.
|
||||
;; Representation of the "latest" checkout of a branch or a specific commit.
|
||||
(define-record-type* <git-checkout>
|
||||
git-checkout make-git-checkout
|
||||
git-checkout?
|
||||
(url git-checkout-url)
|
||||
(branch git-checkout-branch (default "master")))
|
||||
(branch git-checkout-branch (default "master"))
|
||||
(commit git-checkout-commit (default #f)))
|
||||
|
||||
(define latest-repository-commit*
|
||||
(store-lift latest-repository-commit))
|
||||
|
|
@ -213,7 +214,9 @@ Log progress and checkout info to LOG-PORT."
|
|||
;; "Compile" CHECKOUT by updating the local checkout and adding it to the
|
||||
;; store.
|
||||
(match checkout
|
||||
(($ <git-checkout> url branch)
|
||||
(($ <git-checkout> url branch commit)
|
||||
(latest-repository-commit* url
|
||||
#:ref `(branch . ,branch)
|
||||
#:ref (if commit
|
||||
`(commit . ,commit)
|
||||
`(branch . ,branch))
|
||||
#:log-port (current-error-port)))))
|
||||
|
|
|
|||
|
|
@ -272,16 +272,17 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them."
|
|||
(rewrite obj)
|
||||
obj))))
|
||||
|
||||
(define (evaluate-git-replacement-specs specs)
|
||||
(define (evaluate-git-replacement-specs specs proc)
|
||||
"Parse SPECS, a list of strings like \"guile=stable-2.2\", and return a list
|
||||
of package pairs. Raise an error if an element of SPECS uses invalid syntax,
|
||||
or if a package it refers to could not be found."
|
||||
of package pairs, where (PROC PACKAGE URL BRANCH-OR-COMMIT) returns the
|
||||
replacement package. Raise an error if an element of SPECS uses invalid
|
||||
syntax, or if a package it refers to could not be found."
|
||||
(define not-equal
|
||||
(char-set-complement (char-set #\=)))
|
||||
|
||||
(map (lambda (spec)
|
||||
(match (string-tokenize spec not-equal)
|
||||
((name branch)
|
||||
((name branch-or-commit)
|
||||
(let* ((old (specification->package name))
|
||||
(source (package-source old))
|
||||
(url (cond ((and (origin? source)
|
||||
|
|
@ -293,11 +294,7 @@ or if a package it refers to could not be found."
|
|||
(leave (G_ "the source of ~a is not a Git \
|
||||
reference~%")
|
||||
(package-full-name old))))))
|
||||
(cons old
|
||||
(package
|
||||
(inherit old)
|
||||
(version (string-append "git." branch))
|
||||
(source (git-checkout (url url) (branch branch)))))))
|
||||
(cons old (proc old url branch-or-commit))))
|
||||
(x
|
||||
(leave (G_ "invalid replacement specification: ~s~%") spec))))
|
||||
specs))
|
||||
|
|
@ -307,7 +304,36 @@ reference~%")
|
|||
dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
|
||||
strings like \"guile-next=stable-3.0\" meaning that packages are built using
|
||||
'guile-next' from the latest commit on its 'stable-3.0' branch."
|
||||
(let* ((replacements (evaluate-git-replacement-specs replacement-specs))
|
||||
(define (replace old url branch)
|
||||
(package
|
||||
(inherit old)
|
||||
(version (string-append "git." branch))
|
||||
(source (git-checkout (url url) (branch branch)))))
|
||||
|
||||
(let* ((replacements (evaluate-git-replacement-specs replacement-specs
|
||||
replace))
|
||||
(rewrite (package-input-rewriting replacements)))
|
||||
(lambda (store obj)
|
||||
(if (package? obj)
|
||||
(rewrite obj)
|
||||
obj))))
|
||||
|
||||
(define (transform-package-source-commit replacement-specs)
|
||||
"Return a procedure that, when passed a package, replaces its direct
|
||||
dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
|
||||
strings like \"guile-next=cabba9e\" meaning that packages are built using
|
||||
'guile-next' from commit 'cabba9e'."
|
||||
(define (replace old url commit)
|
||||
(package
|
||||
(inherit old)
|
||||
(version (string-append "git."
|
||||
(if (< (string-length commit) 7)
|
||||
commit
|
||||
(string-take commit 7))))
|
||||
(source (git-checkout (url url) (commit commit)))))
|
||||
|
||||
(let* ((replacements (evaluate-git-replacement-specs replacement-specs
|
||||
replace))
|
||||
(rewrite (package-input-rewriting replacements)))
|
||||
(lambda (store obj)
|
||||
(if (package? obj)
|
||||
|
|
@ -322,7 +348,8 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using
|
|||
`((with-source . ,transform-package-source)
|
||||
(with-input . ,transform-package-inputs)
|
||||
(with-graft . ,transform-package-inputs/graft)
|
||||
(with-branch . ,transform-package-source-branch)))
|
||||
(with-branch . ,transform-package-source-branch)
|
||||
(with-commit . ,transform-package-source-commit)))
|
||||
|
||||
(define %transformation-options
|
||||
;; The command-line interface to the above transformations.
|
||||
|
|
@ -338,7 +365,9 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using
|
|||
(option '("with-graft") #t #f
|
||||
(parser 'with-graft))
|
||||
(option '("with-branch") #t #f
|
||||
(parser 'with-branch)))))
|
||||
(parser 'with-branch))
|
||||
(option '("with-commit") #t #f
|
||||
(parser 'with-commit)))))
|
||||
|
||||
(define (show-transformation-options-help)
|
||||
(display (G_ "
|
||||
|
|
@ -350,9 +379,12 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using
|
|||
(display (G_ "
|
||||
--with-graft=PACKAGE=REPLACEMENT
|
||||
graft REPLACEMENT on packages that refer to PACKAGE"))
|
||||
(display (G_ "
|
||||
(display (G_ "
|
||||
--with-branch=PACKAGE=BRANCH
|
||||
build PACKAGE from the latest commit of BRANCH")))
|
||||
build PACKAGE from the latest commit of BRANCH"))
|
||||
(display (G_ "
|
||||
--with-commit=PACKAGE=COMMIT
|
||||
build PACKAGE from COMMIT")))
|
||||
|
||||
|
||||
(define (options->transformation opts)
|
||||
|
|
|
|||
|
|
@ -46,3 +46,8 @@ orig_drv="`guix build guix -d`"
|
|||
latest_drv="`guix build guix --with-branch=guile-gcrypt=master -d`"
|
||||
guix gc -R "$latest_drv" | grep guile-gcrypt-git.master
|
||||
test "$orig_drv" != "$latest_drv"
|
||||
|
||||
v0_1_0_drv="`guix build guix --with-commit=guile-gcrypt=9e3eacdec1d -d`"
|
||||
guix gc -R "$v0_1_0_drv" | grep guile-gcrypt-git.9e3eacd
|
||||
test "$v0_1_0_drv" != "$latest_drv"
|
||||
test "$v0_1_0_drv" != "$orig_drv"
|
||||
|
|
|
|||
Loading…
Reference in New Issue