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:
Ludovic Courtès 2019-01-18 10:01:37 +01:00
parent ed75bdf35c
commit 1fafc383b1
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 20 additions and 9 deletions

View File

@ -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)))))

View File

@ -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")