mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-12 14:16:55 -05:00
store: Add 'log-file' procedure.
* guix/store.scm (log-file): New procedure. * tests/store.scm ("log-file, derivation", "log-file, output file name"): New tests.
This commit is contained in:
parent
08184ebf16
commit
eddd4077a5
2 changed files with 49 additions and 1 deletions
|
@ -87,7 +87,8 @@ (define-module (guix store)
|
||||||
store-path?
|
store-path?
|
||||||
derivation-path?
|
derivation-path?
|
||||||
store-path-package-name
|
store-path-package-name
|
||||||
store-path-hash-part))
|
store-path-hash-part
|
||||||
|
log-file))
|
||||||
|
|
||||||
(define %protocol-version #x10c)
|
(define %protocol-version #x10c)
|
||||||
|
|
||||||
|
@ -660,3 +661,23 @@ (define (store-path-hash-part path)
|
||||||
"/([0-9a-df-np-sv-z]{32})-[^/]+$"))))
|
"/([0-9a-df-np-sv-z]{32})-[^/]+$"))))
|
||||||
(and=> (regexp-exec path-rx path)
|
(and=> (regexp-exec path-rx path)
|
||||||
(cut match:substring <> 1))))
|
(cut match:substring <> 1))))
|
||||||
|
|
||||||
|
(define (log-file store file)
|
||||||
|
"Return the build log file for FILE, or #f if none could be found. FILE
|
||||||
|
must be an absolute store file name, or a derivation file name."
|
||||||
|
(define state-dir ; XXX: factorize
|
||||||
|
(or (getenv "NIX_STATE_DIR") %state-directory))
|
||||||
|
|
||||||
|
(cond ((derivation-path? file)
|
||||||
|
(let* ((base (basename file))
|
||||||
|
(log (string-append (dirname state-dir) ; XXX: ditto
|
||||||
|
"/log/nix/drvs/"
|
||||||
|
(string-take base 2) "/"
|
||||||
|
(string-drop base 2) ".bz2")))
|
||||||
|
(and (file-exists? log) log)))
|
||||||
|
(else
|
||||||
|
(match (valid-derivers store file)
|
||||||
|
((derivers ...)
|
||||||
|
;; Return the first that works.
|
||||||
|
(any (cut log-file store <>) derivers))
|
||||||
|
(_ #f)))))
|
||||||
|
|
|
@ -140,6 +140,33 @@ (define (same? x y)
|
||||||
(equal? (valid-derivers %store o)
|
(equal? (valid-derivers %store o)
|
||||||
(list (derivation-file-name d))))))
|
(list (derivation-file-name d))))))
|
||||||
|
|
||||||
|
(test-assert "log-file, derivation"
|
||||||
|
(let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
|
||||||
|
(s (add-to-store %store "bash" #t "sha256"
|
||||||
|
(search-bootstrap-binary "bash"
|
||||||
|
(%current-system))))
|
||||||
|
(d (derivation %store "the-thing"
|
||||||
|
s `("-e" ,b)
|
||||||
|
#:env-vars `(("foo" . ,(random-text)))
|
||||||
|
#:inputs `((,b) (,s)))))
|
||||||
|
(and (build-derivations %store (list d))
|
||||||
|
(file-exists? (pk (log-file %store (derivation-file-name d)))))))
|
||||||
|
|
||||||
|
(test-assert "log-file, output file name"
|
||||||
|
(let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
|
||||||
|
(s (add-to-store %store "bash" #t "sha256"
|
||||||
|
(search-bootstrap-binary "bash"
|
||||||
|
(%current-system))))
|
||||||
|
(d (derivation %store "the-thing"
|
||||||
|
s `("-e" ,b)
|
||||||
|
#:env-vars `(("foo" . ,(random-text)))
|
||||||
|
#:inputs `((,b) (,s))))
|
||||||
|
(o (derivation->output-path d)))
|
||||||
|
(and (build-derivations %store (list d))
|
||||||
|
(file-exists? (pk (log-file %store o)))
|
||||||
|
(string=? (log-file %store (derivation-file-name d))
|
||||||
|
(log-file %store o)))))
|
||||||
|
|
||||||
(test-assert "no substitutes"
|
(test-assert "no substitutes"
|
||||||
(let* ((s (open-connection))
|
(let* ((s (open-connection))
|
||||||
(d1 (package-derivation s %bootstrap-guile (%current-system)))
|
(d1 (package-derivation s %bootstrap-guile (%current-system)))
|
||||||
|
|
Loading…
Reference in a new issue