Change `build-expression->derivation' to support sub-derivation inputs.
* guix/derivations.scm (build-expression->derivation): Change to expect INPUTS to have the form (NAME DRV-PATH SUB-DRV) or (NAME DRV-PATH), instead of (NAME . DRV-PATH). Update callers accordingly. * guix/gnu-build-system.scm, tests/builders.scm, tests/derivations.scm: Update accordingly.
This commit is contained in:
		
							parent
							
								
									c36db98c8e
								
							
						
					
					
						commit
						2acb2cb6d0
					
				
					 4 changed files with 25 additions and 20 deletions
				
			
		|  | @ -397,7 +397,7 @@ system, imported, and appears under FINAL-PATH in the resulting store path." | |||
| 
 | ||||
|   (let* ((files   (map (match-lambda | ||||
|                         ((final-path . file-name) | ||||
|                          (cons final-path | ||||
|                          (list final-path | ||||
|                                (add-to-store store (basename final-path) #t #f | ||||
|                                              "sha256" file-name)))) | ||||
|                        files)) | ||||
|  | @ -405,7 +405,7 @@ system, imported, and appears under FINAL-PATH in the resulting store path." | |||
|           `(begin | ||||
|              (mkdir %output) (chdir %output) | ||||
|              ,@(append-map (match-lambda | ||||
|                             ((final-path . store-path) | ||||
|                             ((final-path store-path) | ||||
|                              (append (match (parent-dirs final-path) | ||||
|                                        (() '()) | ||||
|                                        ((head ... tail) | ||||
|  | @ -442,11 +442,11 @@ search path." | |||
|                                        hash hash-algo | ||||
|                                        (modules '())) | ||||
|   "Return a derivation that executes Scheme expression EXP as a builder for | ||||
| derivation NAME.  INPUTS must be a list of string/derivation-path pairs.  EXP | ||||
| is evaluated in an environment where %OUTPUT is bound to the main output | ||||
| path, %OUTPUTS is bound to a list of output/path pairs, and where | ||||
| %BUILD-INPUTS is bound to an alist of string/output-path pairs made from | ||||
| INPUTS." | ||||
| derivation NAME.  INPUTS must be a list of (NAME DRV-PATH SUB-DRV) tuples; | ||||
| when SUB-DRV is omitted, \"out\" is assumed.  EXP is evaluated in an | ||||
| environment where %OUTPUT is bound to the main output path, %OUTPUTS is bound | ||||
| to a list of output/path pairs, and where %BUILD-INPUTS is bound to an alist | ||||
| of string/output-path pairs made from INPUTS." | ||||
|   (define guile | ||||
|     (string-append (derivation-path->output-path (%guile-for-build)) | ||||
|                    "/bin/guile")) | ||||
|  | @ -459,17 +459,21 @@ INPUTS." | |||
|                              ',outputs)) | ||||
|                       (define %build-inputs | ||||
|                         ',(map (match-lambda | ||||
|                                 ((name . drv) | ||||
|                                  (cons name | ||||
|                                        (if (derivation-path? drv) | ||||
|                                            (derivation-path->output-path drv) | ||||
|                                            drv)))) | ||||
|                                inputs))) ) | ||||
|                                 ((name drv . rest) | ||||
|                                  (let ((sub (match rest | ||||
|                                               (() "out") | ||||
|                                               ((x) x)))) | ||||
|                                    (cons name | ||||
|                                          (if (derivation-path? drv) | ||||
|                                              (derivation-path->output-path drv | ||||
|                                                                            sub) | ||||
|                                              drv))))) | ||||
|                                inputs)))) | ||||
|          (builder  (add-text-to-store store | ||||
|                                       (string-append name "-guile-builder") | ||||
|                                       (string-append (object->string prologue) | ||||
|                                                      (object->string exp)) | ||||
|                                       (map cdr inputs))) | ||||
|                                       (map second inputs))) | ||||
|          (mod-drv  (if (null? modules) | ||||
|                        #f | ||||
|                        (imported-modules store modules))) | ||||
|  | @ -482,7 +486,7 @@ INPUTS." | |||
|                 '(("HOME" . "/homeless")) | ||||
|                 `((,(%guile-for-build)) | ||||
|                   (,builder) | ||||
|                   ,@(map (compose list cdr) inputs) | ||||
|                   ,@(map cdr inputs) | ||||
|                   ,@(if mod-drv `((,mod-drv)) '())) | ||||
|                 #:hash hash #:hash-algo hash-algo | ||||
|                 #:outputs outputs))) | ||||
|  |  | |||
|  | @ -32,7 +32,7 @@ | |||
| 
 | ||||
| (define %standard-inputs | ||||
|   (map (lambda (name) | ||||
|          (cons name (nixpkgs-derivation name))) | ||||
|          (list name (nixpkgs-derivation name))) | ||||
|        '("gnutar" "gzip" "bzip2" "xz" | ||||
|          "coreutils" "gnused" "gnugrep" "bash" | ||||
|          "gcc" "binutils" "gnumake" "glibc"))) | ||||
|  | @ -54,8 +54,9 @@ input derivation INPUTS, using the usual procedure of the GNU Build System." | |||
| 
 | ||||
|   (build-expression->derivation store name system | ||||
|                                 builder | ||||
|                                 (alist-cons "source" source | ||||
|                                             (append inputs %standard-inputs)) | ||||
|                                 `(("source" ,source) | ||||
|                                   ,@inputs | ||||
|                                   ,@%standard-inputs) | ||||
|                                 #:outputs outputs | ||||
|                                 #:modules '((guix build gnu-build-system) | ||||
|                                             (guix build utils)))) | ||||
|  |  | |||
|  | @ -47,7 +47,7 @@ | |||
|                     "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")) | ||||
|          (tarball  (http-fetch %store url 'sha256 hash)) | ||||
|          (build    (gnu-build %store "hello-2.8" tarball | ||||
|                               `(("gawk" . ,(nixpkgs-derivation "gawk")))))) | ||||
|                               `(("gawk" ,(nixpkgs-derivation "gawk")))))) | ||||
|     (and (build-derivations %store (list (pk 'hello-drv build))) | ||||
|          (file-exists? (string-append (derivation-path->output-path build) | ||||
|                                       "/bin/hello"))))) | ||||
|  |  | |||
|  | @ -211,7 +211,7 @@ | |||
|                                    "uname" "-a"))))) | ||||
|          (drv-path   (build-expression->derivation %store "uname" (%current-system) | ||||
|                                                    builder | ||||
|                                                    `(("cu" . ,%coreutils)))) | ||||
|                                                    `(("cu" ,%coreutils)))) | ||||
|          (succeeded? (build-derivations %store (list drv-path)))) | ||||
|     (and succeeded? | ||||
|          (let ((p (derivation-path->output-path drv-path))) | ||||
|  |  | |||
		Reference in a new issue