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
					
				
					 2 changed files with 33 additions and 3 deletions
				
			
		|  | @ -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) | ||||
|  |  | |||
|  | @ -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")) | ||||
|  |  | |||
		Reference in a new issue