From 320ca99917c7bc028fa2f9df0fabe8f71ba988f7 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 31 Oct 2015 22:37:23 +0100
Subject: tests: Make sure the daemon dumps directory entries
 deterministically.

* tests/store.scm ("write-file & export-path yield the same result"):
  New test.
---
 tests/store.scm | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 67 insertions(+)

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))
-- 
cgit 1.4.1