~ruther/guix-local

5b14a7902c58d9fb7923f9e16871f549fbe59b6e — Ludovic Courtès 9 years ago 9fc037f
gexp: Native inputs of nested gexps are properly accounted for.

Previously, 'gexp-native-inputs' would not return the native inputs of
nested gexps.  For example, this:

  (gexp-native-inputs #~(foo #$#~(bar #+coreutils)))

would return '().

* guix/gexp.scm (gexp-inputs)[add-reference-inputs]: In the
non-recursive cases, check whether N? and NATIVE? are the same, and act
accordingly.
[native-input?]: Remove.
Fold over all of (gexp-references exp).
* tests/gexp.scm ("ungexp + ungexp-native, nested, special mixture"):
New test.
* tests/gexp.scm ("input list splicing + ungexp-native-splicing"): Pass
 #:native? #t to 'gexp-input'.
2 files changed, 22 insertions(+), 17 deletions(-)

M guix/gexp.scm
M tests/gexp.scm
M guix/gexp.scm => guix/gexp.scm +12 -16
@@ 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))

M tests/gexp.scm => tests/gexp.scm +10 -1
@@ 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"))