aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-02-21 20:17:29 +0100
committerLudovic Courtès <ludo@gnu.org>2014-02-21 23:49:53 +0100
commit96c7448f370227c9777a6acdac4ac65f1884fb43 (patch)
treeba30d68dfab3493adcd3c5cc96cd774d818de180
parent36bbbbd150f75c2a6dab2473643c3723e606e41d (diff)
downloadguix-96c7448f370227c9777a6acdac4ac65f1884fb43.tar
guix-96c7448f370227c9777a6acdac4ac65f1884fb43.tar.gz
nar: Produce archives with files sorted in C collation order.
* guix/nar.scm (write-file) <directory>: Pass 'string<?' as the second argument to 'scandir'. * tests/nar.scm ("write-file puts file in C locale collation order"): New test.
-rw-r--r--guix/nar.scm9
-rw-r--r--tests/nar.scm27
2 files changed, 33 insertions, 3 deletions
diff --git a/guix/nar.scm b/guix/nar.scm
index 9ba6e4ce2c..5bf174554c 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -177,8 +177,13 @@ sub-directories of FILE as needed."
((directory)
(write-string "type" p)
(write-string "directory" p)
- (let ((entries (remove (cut member <> '("." ".."))
- (scandir f))))
+ (let* ((select? (negate (cut member <> '("." ".."))))
+
+ ;; 'scandir' defaults to 'string-locale<?' to sort files, but
+ ;; this happens to be case-insensitive (at least in 'en_US'
+ ;; locale on libc 2.18.) Conversely, we want files to be
+ ;; sorted in a case-sensitive fashion.
+ (entries (scandir f select? string<?)))
(for-each (lambda (e)
(let ((f (string-append f "/" e)))
(write-string "entry" p)
diff --git a/tests/nar.scm b/tests/nar.scm
index 7ae8cf0aa7..16a7845342 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -19,10 +19,14 @@
(define-module (test-nar)
#:use-module (guix nar)
#:use-module (guix store)
- #:use-module ((guix hash) #:select (open-sha256-input-port))
+ #:use-module ((guix hash)
+ #:select (open-sha256-port open-sha256-input-port))
+ #:use-module ((guix packages)
+ #:select (base32))
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
@@ -190,6 +194,27 @@
(write-file input output)
#t))
+(test-equal "write-file puts file in C locale collation order"
+ (base32 "0sfn5r63k88w9ls4hivnvscg82bqg8a0w7955l6xlk4g96jnb2z3")
+ (let ((input (string-append %test-dir ".input")))
+ (dynamic-wind
+ (lambda ()
+ (define (touch file)
+ (call-with-output-file (string-append input "/" file)
+ (const #t)))
+
+ (mkdir input)
+ (touch "B")
+ (touch "Z")
+ (touch "a")
+ (symlink "B" (string-append input "/z")))
+ (lambda ()
+ (let-values (((port get-hash) (open-sha256-port)))
+ (write-file input port)
+ (get-hash)))
+ (lambda ()
+ (rm-rf input)))))
+
(test-assert "write-file + restore-file"
(let* ((input (string-append (dirname (search-path %load-path "guix.scm"))
"/guix"))