tests: Make sure the daemon dumps directory entries deterministically.
* tests/store.scm ("write-file & export-path yield the same result"): New test.
This commit is contained in:
parent
043f4698f0
commit
320ca99917
@ -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))
|
||||
|
Loading…
Reference in New Issue
Block a user