~ruther/guix-local

1123759b4549bedc1a44b5d59a30c886e58ff6bc — Ludovic Courtès 11 years ago 607e1b5
gexp: Fix handling of nativeness in nested gexps.

* guix/gexp.scm (gexp-inputs): Remove 'references' parameter; add
  #:native? and honor it.
  [add-reference-inputs]: Distinguish between native gexp inputs, and
  non-native gexp inputs.  Honor 'native?' field of list inputs.
* tests/gexp.scm ("ungexp + ungexp-native, nested"): New test.
2 files changed, 27 insertions(+), 9 deletions(-)

M guix/gexp.scm
M tests/gexp.scm
M guix/gexp.scm => guix/gexp.scm +21 -9
@@ 353,13 353,23 @@ The other arguments are as for 'derivation'."
                      #:allowed-references allowed
                      #:local-build? local-build?))))

(define* (gexp-inputs exp #:optional (references gexp-references))
  "Return the input list for EXP, using REFERENCES to get its list of
references."
(define* (gexp-inputs exp #:key native?)
  "Return the input list for EXP.  When NATIVE? is true, return only native
references; otherwise, return only non-native references."
  (define (add-reference-inputs ref result)
    (match ref
      (($ <gexp-input> (? gexp? exp))
       (append (gexp-inputs exp references) result))
      (($ <gexp-input> (? gexp? exp) _ #t)
       (if native?
           (append (gexp-inputs exp)
                   (gexp-inputs exp #:native? #t)
                   result)
           result))
      (($ <gexp-input> (? gexp? exp) _ #f)
       (if native?
           (append (gexp-inputs exp #:native? #t)
                   result)
           (append (gexp-inputs exp)
                   result)))
      (($ <gexp-input> (? string? str))
       (if (direct-store-path? str)
           (cons `(,str) result)


@@ 369,13 379,13 @@ references."
           ;; THING is a derivation, or a package, or an origin, etc.
           (cons `(,thing ,output) result)
           result))
      (($ <gexp-input> (lst ...) output native?)
      (($ <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" native?)))
                         (x (%gexp-input x "out" (or n? native?))))
                        lst)))
      (_
       ;; Ignore references to other kinds of objects.


@@ 383,10 393,12 @@ references."

  (fold-right add-reference-inputs
              '()
              (references exp)))
              (if native?
                  (gexp-native-references exp)
                  (gexp-references exp))))

(define gexp-native-inputs
  (cut gexp-inputs <> gexp-native-references))
  (cut gexp-inputs <> #:native? #t))

(define (gexp-outputs exp)
  "Return the outputs referred to by EXP as a list of strings."

M tests/gexp.scm => tests/gexp.scm +6 -0
@@ 160,6 160,12 @@
         (equal? `(list ,guile ,cu ,libc ,bu)
                 (gexp->sexp* exp target)))))

(test-equal "ungexp + ungexp-native, nested"
  (list `((,%bootstrap-guile "out")) '<> `((,coreutils "out")))
  (let* ((exp (gexp (list (ungexp-native (gexp (ungexp coreutils)))
                          (ungexp %bootstrap-guile)))))
    (list (gexp-inputs exp) '<> (gexp-native-inputs exp))))

(test-assert "input list"
  (let ((exp   (gexp (display
                      '(ungexp (list %bootstrap-guile coreutils)))))