TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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:
Ludovic Courtès 2013-11-12 00:10:10 +01:00
parent 08184ebf16
commit eddd4077a5
2 changed files with 49 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
guix/store.scm
View File

@ -87,7 +87,8 @@
store-path?
derivation-path?
store-path-package-name
store-path-hash-part))
store-path-hash-part
log-file))
(define %protocol-version #x10c)
@ -660,3 +661,23 @@ syntactically valid store path."
"/([0-9a-df-np-sv-z]{32})-[^/]+$"))))
(and=> (regexp-exec path-rx path)
(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)))))

27
tests/store.scm
View File

@ -140,6 +140,33 @@
(equal? (valid-derivers %store o)
(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"
(let* ((s (open-connection))
(d1 (package-derivation s %bootstrap-guile (%current-system)))