From a93e91ff484005e05491621664ab71f888ad2ba2 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 21 Feb 2014 17:37:55 +0100
Subject: nar: 'write-file' can write to non-file ports.

* guix/nar.scm (write-contents): Use 'sendfile' only when P is a file
  port.
* tests/nar.scm ("write-file supports non-file output ports"): New test.
---
 tests/nar.scm | 7 +++++++
 1 file changed, 7 insertions(+)

(limited to 'tests/nar.scm')

diff --git a/tests/nar.scm b/tests/nar.scm
index 9f21f990c8..7ae8cf0aa7 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -183,6 +183,13 @@
 
 (test-begin "nar")
 
+(test-assert "write-file supports non-file output ports"
+  (let ((input  (string-append (dirname (search-path %load-path "guix.scm"))
+                               "/guix"))
+        (output (%make-void-port "w")))
+    (write-file input output)
+    #t))
+
 (test-assert "write-file + restore-file"
   (let* ((input  (string-append (dirname (search-path %load-path "guix.scm"))
                                 "/guix"))
-- 
cgit v1.2.3


From 96c7448f370227c9777a6acdac4ac65f1884fb43 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 21 Feb 2014 20:17:29 +0100
Subject: 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.
---
 guix/nar.scm  |  9 +++++++--
 tests/nar.scm | 27 ++++++++++++++++++++++++++-
 2 files changed, 33 insertions(+), 3 deletions(-)

(limited to 'tests/nar.scm')

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"))
-- 
cgit v1.2.3