diff options
| -rw-r--r-- | guix/gexp.scm | 28 | ||||
| -rw-r--r-- | tests/gexp.scm | 11 |
2 files changed, 22 insertions, 17 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm index fd5dc49233..5021688ac7 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -678,32 +678,28 @@ references; otherwise, return only non-native references." (if (direct-store-path? str) (cons `(,str) result) result)) - (($ <gexp-input> (? struct? thing) output) - (if (lookup-compiler thing) + (($ <gexp-input> (? struct? thing) output n?) + (if (and (eqv? n? native?) (lookup-compiler thing)) ;; THING is a derivation, or a package, or an origin, etc. (cons `(,thing ,output) result) result)) (($ <gexp-input> (lst ...) output n?) - (fold-right add-reference-inputs result - ;; XXX: For now, automatically convert LST to a list of - ;; gexp-inputs. - (map (match-lambda - ((? gexp-input? x) x) - (x (%gexp-input x "out" (or n? native?)))) - lst))) + (if (eqv? native? n?) + (fold-right add-reference-inputs result + ;; XXX: For now, automatically convert LST to a list of + ;; gexp-inputs. + (map (match-lambda + ((? gexp-input? x) x) + (x (%gexp-input x "out" (or n? native?)))) + lst)) + result)) (_ ;; Ignore references to other kinds of objects. result))) - (define (native-input? x) - (and (gexp-input? x) - (gexp-input-native? x))) - (fold-right add-reference-inputs '() - (if native? - (filter native-input? (gexp-references exp)) - (remove native-input? (gexp-references exp))))) + (gexp-references exp))) (define gexp-native-inputs (cut gexp-inputs <> #:native? #t)) diff --git a/tests/gexp.scm b/tests/gexp.scm index 354d28f014..797d5fa457 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -277,6 +277,14 @@ (ungexp %bootstrap-guile))))) (list (gexp-inputs exp) '<> (gexp-native-inputs exp)))) +(test-equal "ungexp + ungexp-native, nested, special mixture" + `(() <> ((,coreutils "out"))) + + ;; (gexp-native-inputs exp) used to return '(), wrongfully. + (let* ((foo (gexp (foo (ungexp-native coreutils)))) + (exp (gexp (bar (ungexp foo))))) + (list (gexp-inputs exp) '<> (gexp-native-inputs exp)))) + (test-assert "input list" (let ((exp (gexp (display '(ungexp (list %bootstrap-guile coreutils))))) @@ -327,7 +335,8 @@ `(list ,@(cons 5 outputs)))))) (test-assert "input list splicing + ungexp-native-splicing" - (let* ((inputs (list (gexp-input glibc "debug") %bootstrap-guile)) + (let* ((inputs (list (gexp-input glibc "debug" #:native? #t) + %bootstrap-guile)) (exp (gexp (list (ungexp-native-splicing (cons (+ 2 3) inputs)))))) (and (lset= equal? `((,glibc "debug") (,%bootstrap-guile "out")) |