nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
guix/inferior.scm
View File

@ -491,6 +491,10 @@ PACKAGE must be live."
"Return a derivation that evaluates EXP with GUIX, an instance of Guix as "Return a derivation that evaluates EXP with GUIX, an instance of Guix as
returned for example by 'channel-instances->derivation'. Other arguments are returned for example by 'channel-instances->derivation'. Other arguments are
passed as-is to 'gexp->derivation'." 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 (define trampoline
;; This is a crude way to run EXP on GUIX. TODO: use 'raw-derivation' and ;; 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 ;; 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 (let ((pipe (open-pipe* OPEN_WRITE
#+(file-append guix "/bin/guix") #+(file-append guix "/bin/guix")
"repl" "-t" "machine"))) "repl" "-t" "machine")))
;; Unquote EXP right here so that its references to #$output
;; propagate to the surrounding gexp. ;; XXX: EXP presumably refers to #$output but that reference is lost
(write '#$exp pipe) ;XXX: load path for EXP? ;; so explicitly reference it here.
#$output
(write `(primitive-load #$script) pipe)
(unless (zero? (close-pipe pipe)) (unless (zero? (close-pipe pipe))
(error "inferior failed" #+guix))))) (error "inferior failed" #+guix)))))

16
tests/channels.scm
View File

@ -24,6 +24,7 @@
#:use-module (guix store) #:use-module (guix store)
#:use-module ((guix grafts) #:select (%graft?)) #:use-module ((guix grafts) #:select (%graft?))
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix sets)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
@ -187,12 +188,15 @@
(manifest-entries manifest)) (manifest-entries manifest))
(define (depends? drv in out) (define (depends? drv in out)
;; Return true if DRV depends on all of IN and none of OUT. ;; Return true if DRV depends (directly or indirectly) on all of IN
(let ((lst (map derivation-input-path (derivation-inputs drv))) ;; and none of OUT.
(let ((set (list->set
(requisites store
(list (derivation-file-name drv)))))
(in (map derivation-file-name in)) (in (map derivation-file-name in))
(out (map derivation-file-name out))) (out (map derivation-file-name out)))
(and (every (cut member <> lst) in) (and (every (cut set-contains? set <>) in)
(not (any (cut member <> lst) out))))) (not (any (cut set-contains? set <>) out)))))
(define (lookup name) (define (lookup name)
(run-with-store store (run-with-store store
@ -212,8 +216,8 @@
(depends? drv1 (depends? drv1
(list drv0) (list drv2 drv3)) (list drv0) (list drv2 drv3))
(depends? drv2 (depends? drv2
(list drv1) (list drv0 drv3)) (list drv1) (list drv3))
(depends? drv3 (depends? drv3
(list drv2 drv0) (list drv1)))))))) (list drv2 drv0) (list))))))))
(test-end "channels") (test-end "channels")