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.
This commit is contained in:
parent
36bbbbd150
commit
96c7448f37
|
@ -177,8 +177,13 @@ sub-directories of FILE as needed."
|
||||||
((directory)
|
((directory)
|
||||||
(write-string "type" p)
|
(write-string "type" p)
|
||||||
(write-string "directory" p)
|
(write-string "directory" p)
|
||||||
(let ((entries (remove (cut member <> '("." ".."))
|
(let* ((select? (negate (cut member <> '("." ".."))))
|
||||||
(scandir f))))
|
|
||||||
|
;; '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)
|
(for-each (lambda (e)
|
||||||
(let ((f (string-append f "/" e)))
|
(let ((f (string-append f "/" e)))
|
||||||
(write-string "entry" p)
|
(write-string "entry" p)
|
||||||
|
|
|
@ -19,10 +19,14 @@
|
||||||
(define-module (test-nar)
|
(define-module (test-nar)
|
||||||
#:use-module (guix nar)
|
#:use-module (guix nar)
|
||||||
#:use-module (guix store)
|
#: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 bytevectors)
|
||||||
#:use-module (rnrs io ports)
|
#:use-module (rnrs io ports)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-35)
|
#:use-module (srfi srfi-35)
|
||||||
|
@ -190,6 +194,27 @@
|
||||||
(write-file input output)
|
(write-file input output)
|
||||||
#t))
|
#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"
|
(test-assert "write-file + restore-file"
|
||||||
(let* ((input (string-append (dirname (search-path %load-path "guix.scm"))
|
(let* ((input (string-append (dirname (search-path %load-path "guix.scm"))
|
||||||
"/guix"))
|
"/guix"))
|
||||||
|
|
Loading…
Reference in New Issue