ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

inferior: 'gexp->derivation-in-inferior' honors EXP's load path.

Browse source 
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 @@ (define* (gexp->derivation-in-inferior name exp guix
"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 @@ (define trampoline
(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)))))

16
tests/channels.scm
View file

@ -24,6 +24,7 @@ (define-module (test-channels)
#: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 @@ (define entries
(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 @@ (define (lookup name)
(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")