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

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 1fafc383b1f04fcdaa49941f5bb64ac3008cfad8
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jan 18 10:01:37 2019 +0100

    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.
---
 guix/inferior.scm  | 13 ++++++++++---
 tests/channels.scm | 16 ++++++++++------
 2 files changed, 20 insertions(+), 9 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 4dfb242..9f19e7d 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -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)))))
diff --git a/tests/channels.scm b/tests/channels.scm
index 7df1b8c..8540aef 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -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")