aboutsummaryrefslogtreecommitdiff
path: root/tests/store.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-10-31 22:37:23 +0100
committerLudovic Courtès <ludo@gnu.org>2015-11-01 14:26:54 +0100
commit320ca99917c7bc028fa2f9df0fabe8f71ba988f7 (patch)
tree8e903f94fcf682911d4578d699b262b8789eb412 /tests/store.scm
parent043f4698f0f1913ca29e73fcde1e66176fbaee33 (diff)
downloadguix-320ca99917c7bc028fa2f9df0fabe8f71ba988f7.tar
guix-320ca99917c7bc028fa2f9df0fabe8f71ba988f7.tar.gz
tests: Make sure the daemon dumps directory entries deterministically.
* tests/store.scm ("write-file & export-path yield the same result"): New test.
Diffstat (limited to 'tests/store.scm')
-rw-r--r--tests/store.scm67
1 files changed, 67 insertions, 0 deletions
diff --git a/tests/store.scm b/tests/store.scm
index 96b64781dd..60d1085f99 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -20,6 +20,7 @@
#:use-module (guix tests)
#:use-module (guix store)
#:use-module (guix utils)
+ #:use-module (guix monads)
#:use-module (guix hash)
#:use-module (guix base32)
#:use-module (guix packages)
@@ -592,6 +593,72 @@
(equal? (list file0) (references %store file1))
(equal? (list file1) (references %store file2))))))
+(test-assert "write-file & export-path yield the same result"
+ ;; Here we compare 'write-file' and the daemon's own implementation.
+ ;; 'write-file' is the reference because we know it sorts file
+ ;; deterministically. Conversely, the daemon uses 'readdir' and the entries
+ ;; currently happen to be sorted as a side-effect of some unrelated
+ ;; operation (search for 'unhacked' in archive.cc.) Make sure we detect any
+ ;; changes there.
+ (run-with-store %store
+ (mlet* %store-monad ((drv1 (package->derivation %bootstrap-guile))
+ (out1 -> (derivation->output-path drv1))
+ (data -> (unfold (cut >= <> 26)
+ (lambda (i)
+ (random-bytevector 128))
+ 1+ 0))
+ (build
+ -> #~(begin
+ (use-modules (rnrs io ports) (srfi srfi-1))
+ (let ()
+ (define letters
+ (map (lambda (i)
+ (string
+ (integer->char
+ (+ i (char->integer #\a)))))
+ (iota 26)))
+ (define (touch file data)
+ (call-with-output-file file
+ (lambda (port)
+ (put-bytevector port data))))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ ;; The files must be different so they have
+ ;; different inode numbers, and the inode
+ ;; order must differ from the lexicographic
+ ;; order.
+ (for-each touch
+ (append (drop letters 10)
+ (take letters 10))
+ (list #$@data))
+ #t)))
+ (drv2 (gexp->derivation "bunch" build))
+ (out2 -> (derivation->output-path drv2))
+ (item-info -> (store-lift query-path-info)))
+ (mbegin %store-monad
+ (built-derivations (list drv1 drv2))
+ (foldm %store-monad
+ (lambda (item result)
+ (define ref-hash
+ (let-values (((port get) (open-sha256-port)))
+ (write-file item port)
+ (close-port port)
+ (get)))
+
+ ;; 'query-path-info' returns a hash produced by using the
+ ;; daemon's C++ 'dump' function, which is the implementation
+ ;; under test.
+ (>>= (item-info item)
+ (lambda (info)
+ (return
+ (and result
+ (bytevector=? (path-info-hash info) ref-hash))))))
+ #t
+ (list out1 out2))))
+ #:guile-for-build (%guile-for-build)))
+
(test-assert "import corrupt path"
(let* ((text (random-text))
(file (add-text-to-store %store "text" text))