bug#41028: Channel/inferior error with core-updates: Unbound variable: call-with-new-thread

[Ludovic Courtès]

Comrades,

Christopher Baines <address@hidden> skribis:

> (use-modules (guix channels)
>              (guix inferior))
>
> (define channels
>   (list (channel
>          (name 'guix)
>          (url "https://git.savannah.gnu.org/git/guix.git";)
>          (commit
>           "e02c2f85b36ce1c733bd908a210ce1182bdd2560"))))
>
> (define inferior
>   (inferior-for-channels channels))
>
> (first (lookup-inferior-packages inferior "linux-libre" "5.2.21"))
>
>
> If you save that as a file then attempt to build it:
>
>
> → guix build -f test.scm 
> Updating channel 'guix' from Git repository at 
> 'https://git.savannah.gnu.org/git/guix.git'...
> Backtrace:
>            4 (primitive-load "/gnu/store/8mv5bpjgxg9c369xnbb5rf1kv9r?")
> In ice-9/eval.scm:
>     619:8  3 (_ #(#(#(#(#(#(#(#(#(#(#(?) ?) ?) ?) ?) ?) ?) ?) ?) ?) ?))
>    182:19  2 (proc #(#(#(#(#(#(#(#(#(#(# ?) ?) ?) ?) ?) ?) ?) ?) ?) ?))
>    142:16  1 (compile-top-call #<directory (guile-user) 7f1e0abc1f00> ?)
> In unknown file:
>            0 (%resolve-variable (7 . call-with-new-thread) #<directo?>)
>
> ERROR: In procedure %resolve-variable:
> Unbound variable: call-with-new-thread

The attached patches add a mechanism to patch the Guix source tree, and
then use that mechanism to add the missing (ice-9 threads) import.  With
this I can do:

  ./pre-inst-env guix time-machine \
     --commit=e02c2f85b36ce1c733bd908a210ce1182bdd2560 -- build linux-libre

… which is a simple way to do what the manifest above was about.

If we think a bit long-term, I think the %quirks and %patches mechanisms
are a necessary evil.  The goal is for ‘build-self.scm’ to use as little
of the Guix API, as well as Guile APIs that are presumably here to stay.
But as we’re already seeing, there are unavoidably incompatibilities
that arise here and there.  The good news is that we know today how to
modify yesterday’s code to work well, or which Guile version to use to
get it to run.

Thoughts?

Thanks,
Ludo’.

>From 4ec2c3b5527b2189b3f767a980f80dee3c6717ae Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
Date: Wed, 6 May 2020 22:18:52 +0200
Subject: [PATCH 1/3] channels: Add 'latest-channel-instance'.

* guix/channels.scm (latest-channel-instance): New procedure.
(latest-channel-instances): Use it.
---
 guix/channels.scm | 32 ++++++++++++++++++--------------
 1 file changed, 18 insertions(+), 14 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index 041fae2a9c..4ffc366d6a 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -199,6 +199,14 @@ description file or its default value."
 channel INSTANCE."
   (channel-metadata-dependencies (channel-instance-metadata instance)))
 
+(define (latest-channel-instance store channel)
+  "Return the latest channel instance for CHANNEL."
+  (let-values (((checkout commit)
+                (latest-repository-commit store (channel-url channel)
+                                          #:ref (channel-reference
+                                                 channel))))
+    (channel-instance channel commit checkout)))
+
 (define* (latest-channel-instances store channels #:optional 
(previous-channels '()))
   "Return a list of channel instances corresponding to the latest checkouts of
 CHANNELS and the channels on which they depend.  PREVIOUS-CHANNELS is a list
@@ -224,20 +232,16 @@ of previously processed channels."
                            (G_ "Updating channel '~a' from Git repository at 
'~a'...~%")
                            (channel-name channel)
                            (channel-url channel))
-                   (let-values (((checkout commit)
-                                 (latest-repository-commit store (channel-url 
channel)
-                                                           #:ref 
(channel-reference
-                                                                  channel))))
-                     (let ((instance (channel-instance channel commit 
checkout)))
-                       (let-values (((new-instances new-channels)
-                                     (latest-channel-instances
-                                      store
-                                      (channel-instance-dependencies instance)
-                                      previous-channels)))
-                         (values (append (cons channel new-channels)
-                                         previous-channels)
-                                 (append (cons instance new-instances)
-                                         instances))))))))
+                   (let ((instance (latest-channel-instance store channel)))
+                     (let-values (((new-instances new-channels)
+                                   (latest-channel-instances
+                                    store
+                                    (channel-instance-dependencies instance)
+                                    previous-channels)))
+                       (values (append (cons channel new-channels)
+                                       previous-channels)
+                               (append (cons instance new-instances)
+                                       instances)))))))
            previous-channels
            '()                                    ;instances
            channels))
-- 
2.26.2

>From 18f2efd43b824f87b3d3a5dbcba9e8c363798f5b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
Date: Wed, 6 May 2020 22:45:31 +0200
Subject: [PATCH 2/3] channels: Add mechanism to patch checkouts of the 'guix
 channel.

* guix/channels.scm (<patch>): New record type.
(apply-patches): New procedure.
(latest-channel-instance)[dot-git?]: New procedure.
Use 'update-cached-checkout' and 'add-to-store' instead of
'latest-repository-commit'.  Call 'apply-patches' when CHANNEL is the
'guix channel.
(%patches): New variable.
* guix/git.scm (url+commit->name): Make public.
* tests/channels.scm ("latest-channel-instances includes channel dependencies")
("latest-channel-instances excludes duplicate channel dependencies"):
Mock 'update-cached-checkout' instead of 'latest-repository-commit'.
Wrap body in 'with-store' and pass the store to 'latest-channel-instances'.
---
 guix/channels.scm  | 50 +++++++++++++++++++++++++++++++-----
 guix/git.scm       |  1 +
 tests/channels.scm | 64 ++++++++++++++++++++++++----------------------
 3 files changed, 79 insertions(+), 36 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index 4ffc366d6a..75b53c3a8e 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -199,13 +199,45 @@ description file or its default value."
 channel INSTANCE."
   (channel-metadata-dependencies (channel-instance-metadata instance)))
 
-(define (latest-channel-instance store channel)
+;; Patch to apply to a source tree.
+(define-record-type <patch>
+  (patch predicate application)
+  patch?
+  (predicate    patch-predicate)                  ;procedure
+  (application  patch-application))               ;procedure
+
+(define (apply-patches checkout commit patches)
+  "Apply the matching PATCHES to CHECKOUT, modifying files in place.  The
+result is unspecified."
+  (let loop ((patches patches))
+    (match patches
+      (() #t)
+      ((($ <patch> predicate modify) rest ...)
+       ;; PREDICATE is passed COMMIT so that it can choose to only apply to
+       ;; ancestors.
+       (when (predicate checkout commit)
+         (modify checkout))
+       (loop rest)))))
+
+(define* (latest-channel-instance store channel
+                                  #:key (patches %patches))
   "Return the latest channel instance for CHANNEL."
+  (define (dot-git? file stat)
+    (and (string=? (basename file) ".git")
+         (eq? 'directory (stat:type stat))))
+
   (let-values (((checkout commit)
-                (latest-repository-commit store (channel-url channel)
-                                          #:ref (channel-reference
-                                                 channel))))
-    (channel-instance channel commit checkout)))
+                (update-cached-checkout (channel-url channel)
+                                        #:ref (channel-reference channel))))
+    (when (guix-channel? channel)
+      ;; Apply the relevant subset of PATCHES directly in CHECKOUT.  This is
+      ;; safe to do because 'switch-to-ref' eventually does a hard reset.
+      (apply-patches checkout commit patches))
+
+    (let* ((name     (url+commit->name (channel-url channel) commit))
+           (checkout (add-to-store store name #t "sha256" checkout
+                                   #:select? (negate dot-git?))))
+      (channel-instance channel commit checkout))))
 
 (define* (latest-channel-instances store channels #:optional 
(previous-channels '()))
   "Return a list of channel instances corresponding to the latest checkouts of
@@ -337,12 +369,18 @@ to '%package-module-path'."
               'guile-2.2.4))
 
 (define %quirks
-  ;; List of predicate/package pairs.  This allows us provide information
+  ;; List of predicate/package pairs.  This allows us to provide information
   ;; about specific Guile versions that old Guix revisions might need to use
   ;; just to be able to build and run the trampoline in %SELF-BUILD-FILE.  See
   ;; <https://bugs.gnu.org/37506>
   `((,syscalls-reexports-local-variables? . ,guile-2.2.4)))
 
+(define %patches
+  ;; Bits of past Guix revisions can become incompatible with newer Guix and
+  ;; Guile.  This variable lists <patch> records for the Guix source tree that
+  ;; apply to the Guix source.
+  '())
+
 (define* (guile-for-source source #:optional (quirks %quirks))
   "Return the Guile package to use when building SOURCE or #f if the default
 '%guile-for-build' should be good enough."
diff --git a/guix/git.scm b/guix/git.scm
index 5fffd429bd..92121156cf 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -40,6 +40,7 @@
 
             with-repository
             update-cached-checkout
+            url+commit->name
             latest-repository-commit
             commit-difference
 
diff --git a/tests/channels.scm b/tests/channels.scm
index f5a7955483..910088ba15 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -135,44 +135,48 @@
                    (name 'test)
                    (url "test")))
          (test-dir (channel-instance-checkout instance--simple)))
-    (mock ((guix git) latest-repository-commit
-           (lambda* (store url #:key ref)
+    (mock ((guix git) update-cached-checkout
+           (lambda* (url #:key ref)
              (match url
-               ("test" (values test-dir 'whatever))
-               (_ (values "/not-important" 'not-important)))))
-          (let ((instances (latest-channel-instances #f (list channel))))
-            (and (eq? 2 (length instances))
-                 (lset= eq?
-                        '(test test-channel)
-                        (map (compose channel-name channel-instance-channel)
-                             instances)))))))
+               ("test" (values test-dir "caf3cabba9e"))
+               (_      (values (channel-instance-checkout instance--no-deps)
+                               "abcde1234")))))
+          (with-store store
+            (let ((instances (latest-channel-instances store (list channel))))
+              (and (eq? 2 (length instances))
+                   (lset= eq?
+                          '(test test-channel)
+                          (map (compose channel-name channel-instance-channel)
+                               instances))))))))
 
 (test-assert "latest-channel-instances excludes duplicate channel dependencies"
   (let* ((channel (channel
                    (name 'test)
                    (url "test")))
          (test-dir (channel-instance-checkout instance--with-dupes)))
-    (mock ((guix git) latest-repository-commit
-           (lambda* (store url #:key ref)
+    (mock ((guix git) update-cached-checkout
+           (lambda* (url #:key ref)
              (match url
-               ("test" (values test-dir 'whatever))
-               (_ (values "/not-important" 'not-important)))))
-          (let ((instances (latest-channel-instances #f (list channel))))
-            (and (= 2 (length instances))
-                 (lset= eq?
-                        '(test test-channel)
-                        (map (compose channel-name channel-instance-channel)
-                             instances))
-                 ;; only the most specific channel dependency should remain,
-                 ;; i.e. the one with a specified commit.
-                 (find (lambda (instance)
-                         (and (eq? (channel-name
-                                    (channel-instance-channel instance))
-                                   'test-channel)
-                              (string=? (channel-commit
-                                         (channel-instance-channel instance))
-                                        "abc1234")))
-                       instances))))))
+               ("test" (values test-dir "caf3cabba9e"))
+               (_      (values (channel-instance-checkout instance--no-deps)
+                               "abcde1234")))))
+          (with-store store
+            (let ((instances (latest-channel-instances store (list channel))))
+              (and (= 2 (length instances))
+                   (lset= eq?
+                          '(test test-channel)
+                          (map (compose channel-name channel-instance-channel)
+                               instances))
+                   ;; only the most specific channel dependency should remain,
+                   ;; i.e. the one with a specified commit.
+                   (find (lambda (instance)
+                           (and (eq? (channel-name
+                                      (channel-instance-channel instance))
+                                     'test-channel)
+                                (string=? (channel-commit
+                                           (channel-instance-channel instance))
+                                          "abc1234")))
+                         instances)))))))
 
 (test-assert "channel-instances->manifest"
   ;; Compute the manifest for a graph of instances and make sure we get a
-- 
2.26.2

>From 66e2ef6ae0958fa45e14c3528c767cd84e24a480 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
Date: Wed, 6 May 2020 23:17:47 +0200
Subject: [PATCH 3/3] channels: Add patch for <https://bugs.gnu.org/41028>.

Without this patch, we couldn't jump from here to commits before
05e783871c2c69b402e088863d46f5be7915ac74 because the
'compute-guix-derivation' script would crash with an unbound-variable
error for 'call-with-new-thread'.

Fixes <https://bugs.gnu.org/41028>.
Reported by Christopher Baines <address@hidden>.

* guix/channels.scm (%bug-41028-patch): New variable.
(%patches): Add it.
---
 guix/channels.scm | 27 ++++++++++++++++++++++++++-
 1 file changed, 26 insertions(+), 1 deletion(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index 75b53c3a8e..0fa036446c 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -38,6 +38,7 @@
                 #:select (source-properties->location
                           &error-location
                           &fix-hint))
+  #:use-module ((guix build utils) #:select (substitute*))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-9)
@@ -375,11 +376,35 @@ to '%package-module-path'."
   ;; <https://bugs.gnu.org/37506>
   `((,syscalls-reexports-local-variables? . ,guile-2.2.4)))
 
+
+(define %bug-41028-patch
+  ;; Patch for <https://bugs.gnu.org/41028>.  The faulty code is the
+  ;; 'compute-guix-derivation' body, which uses 'call-with-new-thread' without
+  ;; importing (ice-9 threads).  However, the 'call-with-new-thread' binding
+  ;; is no longer available in the default name space on Guile 3.0.
+  (let ()
+    (define (missing-ice-9-threads-import? source commit)
+      ;; Return true if %SELF-BUILD-FILE is missing an (ice-9 threads) import.
+      (define content
+        (call-with-input-file (string-append source "/" %self-build-file)
+          read-string))
+
+      (and (string-contains content "(call-with-new-thread")
+           (not (string-contains content "(ice-9 threads)"))))
+
+    (define (add-missing-ice-9-threads-import source)
+      ;; Add (ice-9 threads) import in the gexp of 'compute-guix-derivation'.
+      (substitute* (string-append source "/" %self-build-file)
+        (("^ +\\(use-modules \\(ice-9 match\\)\\)")
+         (object->string '(use-modules (ice-9 match) (ice-9 threads))))))
+
+   (patch missing-ice-9-threads-import? add-missing-ice-9-threads-import)))
+
 (define %patches
   ;; Bits of past Guix revisions can become incompatible with newer Guix and
   ;; Guile.  This variable lists <patch> records for the Guix source tree that
   ;; apply to the Guix source.
-  '())
+  (list %bug-41028-patch))
 
 (define* (guile-for-source source #:optional (quirks %quirks))
   "Return the Guile package to use when building SOURCE or #f if the default
-- 
2.26.2