gexp: 'file-append' correctly handles bases without an expander.
This fixes this use case:
  (file-append (let-system ...) ...)
* guix/gexp.scm (file-append-compiler): When BASE lacks an expander,
delegate to LOWERED.
* tests/gexp.scm ("let-system in file-append"): New test.
			
			
This commit is contained in:
		
							parent
							
								
									61ad9bc2ad
								
							
						
					
					
						commit
						6b30eb189e
					
				
					 2 changed files with 13 additions and 1 deletions
				
			
		|  | @ -685,7 +685,8 @@ SUFFIX." | ||||||
|   expander => (lambda (obj lowered output) |   expander => (lambda (obj lowered output) | ||||||
|                 (match obj |                 (match obj | ||||||
|                   (($ <file-append> base suffix) |                   (($ <file-append> base suffix) | ||||||
|                    (let* ((expand (lookup-expander base)) |                    (let* ((expand (or (lookup-expander base) | ||||||
|  |                                       (lookup-expander lowered))) | ||||||
|                           (base   (expand base lowered output))) |                           (base   (expand base lowered output))) | ||||||
|                      (string-append base (string-concatenate suffix))))))) |                      (string-append base (string-concatenate suffix))))))) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -441,6 +441,17 @@ | ||||||
|                   '(system-binding))) |                   '(system-binding))) | ||||||
|             (x x))))) |             (x x))))) | ||||||
| 
 | 
 | ||||||
|  | (test-assert "let-system in file-append" | ||||||
|  |   (let ((mixed (file-append (let-system (system target) | ||||||
|  |                               (if (not target) grep sed)) | ||||||
|  |                             "/bin")) | ||||||
|  |         (grep  (file-append grep "/bin")) | ||||||
|  |         (sed   (file-append sed "/bin"))) | ||||||
|  |     (and (equal? (gexp->sexp* #~(list #$mixed)) | ||||||
|  |                  (gexp->sexp* #~(list #$grep))) | ||||||
|  |          (equal? (gexp->sexp* #~(list #$mixed) "powerpc64le-linux-gnu") | ||||||
|  |                  (gexp->sexp* #~(list #$sed) "powerpc64le-linux-gnu"))))) | ||||||
|  | 
 | ||||||
| (test-assert "ungexp + ungexp-native" | (test-assert "ungexp + ungexp-native" | ||||||
|   (let* ((exp    (gexp (list (ungexp-native %bootstrap-guile) |   (let* ((exp    (gexp (list (ungexp-native %bootstrap-guile) | ||||||
|                              (ungexp coreutils) |                              (ungexp coreutils) | ||||||
|  |  | ||||||
		Reference in a new issue