inferior: 'gexp->derivation-in-inferior' honors EXP's load path.
Previously the imported modules and extensions of EXP would be missing from the load path of 'guix repl'. * guix/inferior.scm (gexp->derivation-in-inferior)[script]: New variable. [trampoline]: Write (primitive-load #$script) to PIPE. Add #$output. * tests/channels.scm ("channel-instances->manifest")[depends?]: Check for requisites rather than direct references. Adjust callers accordingly.
This commit is contained in:
parent
ed75bdf35c
commit
1fafc383b1
|
@ -491,6 +491,10 @@ PACKAGE must be live."
|
|||
"Return a derivation that evaluates EXP with GUIX, an instance of Guix as
|
||||
returned for example by 'channel-instances->derivation'. Other arguments are
|
||||
passed as-is to 'gexp->derivation'."
|
||||
(define script
|
||||
;; EXP wrapped with a proper (set! %load-path …) prologue.
|
||||
(scheme-file "inferior-script.scm" exp))
|
||||
|
||||
(define trampoline
|
||||
;; This is a crude way to run EXP on GUIX. TODO: use 'raw-derivation' and
|
||||
;; make 'guix repl' the "builder"; this will require "opening up" the
|
||||
|
@ -501,9 +505,12 @@ passed as-is to 'gexp->derivation'."
|
|||
(let ((pipe (open-pipe* OPEN_WRITE
|
||||
#+(file-append guix "/bin/guix")
|
||||
"repl" "-t" "machine")))
|
||||
;; Unquote EXP right here so that its references to #$output
|
||||
;; propagate to the surrounding gexp.
|
||||
(write '#$exp pipe) ;XXX: load path for EXP?
|
||||
|
||||
;; XXX: EXP presumably refers to #$output but that reference is lost
|
||||
;; so explicitly reference it here.
|
||||
#$output
|
||||
|
||||
(write `(primitive-load #$script) pipe)
|
||||
|
||||
(unless (zero? (close-pipe pipe))
|
||||
(error "inferior failed" #+guix)))))
|
||||
|
|
|
@ -24,6 +24,7 @@
|
|||
#:use-module (guix store)
|
||||
#:use-module ((guix grafts) #:select (%graft?))
|
||||
#:use-module (guix derivations)
|
||||
#:use-module (guix sets)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
|
@ -187,12 +188,15 @@
|
|||
(manifest-entries manifest))
|
||||
|
||||
(define (depends? drv in out)
|
||||
;; Return true if DRV depends on all of IN and none of OUT.
|
||||
(let ((lst (map derivation-input-path (derivation-inputs drv)))
|
||||
;; Return true if DRV depends (directly or indirectly) on all of IN
|
||||
;; and none of OUT.
|
||||
(let ((set (list->set
|
||||
(requisites store
|
||||
(list (derivation-file-name drv)))))
|
||||
(in (map derivation-file-name in))
|
||||
(out (map derivation-file-name out)))
|
||||
(and (every (cut member <> lst) in)
|
||||
(not (any (cut member <> lst) out)))))
|
||||
(and (every (cut set-contains? set <>) in)
|
||||
(not (any (cut set-contains? set <>) out)))))
|
||||
|
||||
(define (lookup name)
|
||||
(run-with-store store
|
||||
|
@ -212,8 +216,8 @@
|
|||
(depends? drv1
|
||||
(list drv0) (list drv2 drv3))
|
||||
(depends? drv2
|
||||
(list drv1) (list drv0 drv3))
|
||||
(list drv1) (list drv3))
|
||||
(depends? drv3
|
||||
(list drv2 drv0) (list drv1))))))))
|
||||
(list drv2 drv0) (list))))))))
|
||||
|
||||
(test-end "channels")
|
||||
|
|
Loading…
Reference in New Issue