From b18f7234aac9eb42097c1b4cda7efe0be5aab132 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 30 Nov 2018 13:24:48 +0100 Subject: guix build: Add '--with-commit'. * guix/git.scm ()[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. --- guix/git.scm | 11 +++++---- guix/scripts/build.scm | 60 ++++++++++++++++++++++++++++++++++++++------------ 2 files changed, 53 insertions(+), 18 deletions(-) (limited to 'guix') diff --git a/guix/git.scm b/guix/git.scm index 56cebb06ed..f5593ab57c 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -198,12 +198,13 @@ (define (dot-git? file stat) ;;; 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 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 @@ (define-gexp-compiler (git-checkout-compiler (checkout ) ;; "Compile" CHECKOUT by updating the local checkout and adding it to the ;; store. (match checkout - (($ url branch) + (($ url branch commit) (latest-repository-commit* url - #:ref `(branch . ,branch) + #:ref (if commit + `(commit . ,commit) + `(branch . ,branch)) #:log-port (current-error-port))))) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index e8f2fe973d..5532c65eb6 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -272,16 +272,17 @@ (define (replacement-pair old new) (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 @@ (define not-equal (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 @@ (define (transform-package-source-branch replacement-specs) 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 @@ (define %transformations `((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 @@ (define %transformation-options (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 @@ (define (show-transformation-options-help) (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) -- cgit v1.2.3