store: Test the `fallback?' store option.
* guix/store.scm (set-build-options): Rename #:try-fallback? to #:fallback?.
* tests/store.scm ("substitute --fallback"): New test.
			
			
This commit is contained in:
		
							parent
							
								
									acc26ff148
								
							
						
					
					
						commit
						c3eb878f0b
					
				
					 2 changed files with 53 additions and 2 deletions
				
			
		|  | @ -354,7 +354,7 @@ encoding conversion errors." | |||
|                               (status   k)))))))) | ||||
| 
 | ||||
| (define* (set-build-options server | ||||
|                             #:key keep-failed? keep-going? try-fallback? | ||||
|                             #:key keep-failed? keep-going? fallback? | ||||
|                             (verbosity 0) | ||||
|                             (max-build-jobs (current-processor-count)) | ||||
|                             (max-silent-time 3600) | ||||
|  | @ -377,7 +377,7 @@ encoding conversion errors." | |||
|                           ...))))) | ||||
|     (write-int (operation-id set-options) socket) | ||||
|     (send (boolean keep-failed?) (boolean keep-going?) | ||||
|           (boolean try-fallback?) (integer verbosity) | ||||
|           (boolean fallback?) (integer verbosity) | ||||
|           (integer max-build-jobs) (integer max-silent-time)) | ||||
|     (if (>= (nix-server-minor-version server) 2) | ||||
|         (send (boolean use-build-hook?))) | ||||
|  |  | |||
|  | @ -31,6 +31,7 @@ | |||
|   #:use-module (web uri) | ||||
|   #:use-module (srfi srfi-1) | ||||
|   #:use-module (srfi srfi-11) | ||||
|   #:use-module (srfi srfi-34) | ||||
|   #:use-module (srfi srfi-64)) | ||||
| 
 | ||||
| ;; Test the (guix store) module. | ||||
|  | @ -226,6 +227,56 @@ Deriver: ~a~%" | |||
|          (build-derivations s (list d)) | ||||
|          (equal? c (call-with-input-file o get-string-all))))) | ||||
| 
 | ||||
| (test-assert "substitute --fallback" | ||||
|   (let* ((s   (open-connection)) | ||||
|          (t   (random-text))                      ; contents of the output | ||||
|          (d   (build-expression->derivation | ||||
|                s "substitute-me-not" (%current-system) | ||||
|                `(call-with-output-file %output | ||||
|                   (lambda (p) | ||||
|                     (display ,t p))) | ||||
|                '() | ||||
|                #:guile-for-build | ||||
|                (package-derivation s %bootstrap-guile (%current-system)))) | ||||
|          (o   (derivation-path->output-path d)) | ||||
|          (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") | ||||
|                      (compose uri-path string->uri)))) | ||||
|     ;; Create fake substituter data, to be read by `substitute-binary'. | ||||
|     (call-with-output-file (string-append dir "/nix-cache-info") | ||||
|       (lambda (p) | ||||
|         (format p "StoreDir: ~a\nWantMassQuery: 0\n" | ||||
|                 (%store-prefix)))) | ||||
|     (call-with-output-file (string-append dir "/" (store-path-hash-part o) | ||||
|                                           ".narinfo") | ||||
|       (lambda (p) | ||||
|         (format p "StorePath: ~a | ||||
| URL: ~a | ||||
| Compression: none | ||||
| NarSize: 1234 | ||||
| NarHash: sha256:0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73 | ||||
| References:  | ||||
| System: ~a | ||||
| Deriver: ~a~%" | ||||
|                 o                                   ; StorePath | ||||
|                 "does-not-exist.nar"                ; relative URL | ||||
|                 (%current-system)                   ; System | ||||
|                 (basename d))))                     ; Deriver | ||||
| 
 | ||||
|     ;; Make sure we use `substitute-binary'. | ||||
|     (set-build-options s #:use-substitutes? #t) | ||||
|     (and (has-substitutes? s o) | ||||
|          (guard (c ((nix-protocol-error? c) | ||||
|                     ;; The substituter failed as expected.  Now make sure that | ||||
|                     ;; #:fallback? #t works correctly. | ||||
|                     (set-build-options s | ||||
|                                        #:use-substitutes? #t | ||||
|                                        #:fallback? #t) | ||||
|                     (and (build-derivations s (list d)) | ||||
|                          (equal? t (call-with-input-file o get-string-all))))) | ||||
|            ;; Should fail. | ||||
|            (build-derivations s (list d)) | ||||
|            #f)))) | ||||
| 
 | ||||
| (test-end "store") | ||||
| 
 | ||||
|  | ||||
|  |  | |||
		Reference in a new issue