diff options
| -rw-r--r-- | tests/store.scm | 67 |
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)) |