ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

tests: Make sure the daemon dumps directory entries deterministically.

Browse source 
* tests/store.scm ("write-file & export-path yield the same result"):
  New test.
This commit is contained in:
Ludovic Courtès 2015-10-31 22:37:23 +01:00
parent 043f4698f0
commit 320ca99917
1 changed files with 67 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

67
tests/store.scm
View file

@ -20,6 +20,7 @@ (define-module (test-store)
#: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 @@ (define (same? x y)
(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))