nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

guix-build: Make `--root' effective for .drv files too. 

* guix-build.in (guix-build)[register-root]: Change first argument to
  `paths', which should be a list of store paths.  Update caller to call
  `derivation-path->output-paths' on DRV.  When `derivations-only?',
  also register root for .drv files.
This commit is contained in:
Ludovic Courtès 2013-01-06 00:18:43 +01:00
parent 7244a5f74e
commit 2646c55b03
1 changed files with 26 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
guix-build.in
View File

@ -171,27 +171,24 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(alist-cons 'argument arg result)) (alist-cons 'argument arg result))
%default-options)) %default-options))
(define (register-root drv root) (define (register-root paths root)
;; Register ROOT as an indirect GC root for DRV's outputs. ;; Register ROOT as an indirect GC root for all of PATHS.
(let* ((root (string-append (canonicalize-path (dirname root)) (let* ((root (string-append (canonicalize-path (dirname root))
"/" root)) "/" root)))
(drv* (call-with-input-file drv read-derivation))
(outputs (derivation-outputs drv*))
(outputs* (map (compose derivation-output-path cdr) outputs)))
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(match outputs* (match paths
((output) ((path)
(symlink output root) (symlink path root)
(add-indirect-root (%store) root)) (add-indirect-root (%store) root))
((outputs ...) ((paths ...)
(fold (lambda (output count) (fold (lambda (path count)
(let ((root (string-append root "-" (number->string count)))) (let ((root (string-append root "-" (number->string count))))
(symlink output root) (symlink path root)
(add-indirect-root (%store) root)) (add-indirect-root (%store) root))
(+ 1 count)) (+ 1 count))
0 0
outputs)))) paths))))
(lambda args (lambda args
(format (current-error-port) (format (current-error-port)
(_ "failed to create GC root `~a': ~a~%") (_ "failed to create GC root `~a': ~a~%")
@ -234,7 +231,11 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(append (remove (compose (cut valid-path? (%store) <>) (append (remove (compose (cut valid-path? (%store) <>)
derivation-path->output-path) derivation-path->output-path)
drv) drv)
(map derivation-input-path req))))) (map derivation-input-path req))))
(roots (filter-map (match-lambda
(('gc-root . root) root)
(_ #f))
opts)))
(if (assoc-ref opts 'dry-run?) (if (assoc-ref opts 'dry-run?)
(format (current-error-port) (format (current-error-port)
(N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]"
@ -255,7 +256,10 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
#:verbosity (assoc-ref opts 'verbosity)) #:verbosity (assoc-ref opts 'verbosity))
(if (assoc-ref opts 'derivations-only?) (if (assoc-ref opts 'derivations-only?)
(begin
(format #t "~{~a~%~}" drv) (format #t "~{~a~%~}" drv)
(for-each (cut register-root <> <>)
(map list drv) roots))
(or (assoc-ref opts 'dry-run?) (or (assoc-ref opts 'dry-run?)
(and (build-derivations (%store) drv) (and (build-derivations (%store) drv)
(for-each (lambda (d) (for-each (lambda (d)
@ -268,15 +272,12 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
d out-name))) d out-name)))
(derivation-outputs drv))))) (derivation-outputs drv)))))
drv) drv)
(let ((roots (filter-map (match-lambda
(('gc-root . root)
root)
(_ #f))
opts)))
(when roots
(for-each (cut register-root <> <>) (for-each (cut register-root <> <>)
drv roots) (map (lambda (drv)
#t)))))))))) (map cdr
(derivation-path->output-paths drv)))
drv)
roots)))))))))
;; Local Variables: ;; Local Variables:
;; eval: (put 'guard 'scheme-indent-function 1) ;; eval: (put 'guard 'scheme-indent-function 1)