diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | guix/channels.scm | 77 | ||||
| -rw-r--r-- | guix/quirks.scm | 124 |
3 files changed, 129 insertions, 73 deletions
diff --git a/Makefile.am b/Makefile.am index 6a5dd64fed..fd368d7493 100644 --- a/Makefile.am +++ b/Makefile.am @@ -95,6 +95,7 @@ MODULES = \ guix/repl.scm \ guix/inferior.scm \ guix/describe.scm \ + guix/quirks.scm \ guix/channels.scm \ guix/gnu-maintenance.scm \ guix/self.scm \ diff --git a/guix/channels.scm b/guix/channels.scm index 0fa036446c..aca8302ba0 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -38,7 +38,6 @@ #: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) @@ -48,6 +47,7 @@ #:use-module (srfi srfi-35) #:autoload (guix self) (whole-package make-config.scm) #:autoload (guix inferior) (gexp->derivation-in-inferior) ;FIXME: circular dep + #:autoload (guix quirks) (%quirks %patches applicable-patch? apply-patch) #:use-module (ice-9 match) #:use-module (ice-9 vlist) #:use-module ((ice-9 rdelim) #:select (read-string)) @@ -200,24 +200,15 @@ description file or its default value." channel INSTANCE." (channel-metadata-dependencies (channel-instance-metadata instance))) -;; 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)) + ((patch rest ...) + (when (applicable-patch? patch checkout commit) + (apply-patch patch checkout)) (loop rest))))) (define* (latest-channel-instance store channel @@ -346,66 +337,6 @@ to '%package-module-path'." (gexp->derivation-in-inferior name build core))) -(define (syscalls-reexports-local-variables? source) - "Return true if (guix build syscalls) contains the bug described at -<https://bugs.gnu.org/36723>." - (catch 'system-error - (lambda () - (define content - (call-with-input-file (string-append source - "/guix/build/syscalls.scm") - read-string)) - - ;; The faulty code would use the 're-export' macro, causing the - ;; 'AT_SYMLINK_NOFOLLOW' local variable to be re-exported when using - ;; Guile > 2.2.4. - (string-contains content "(re-export variable)")) - (lambda args - (if (= ENOENT (system-error-errno args)) - #f - (apply throw args))))) - -(define (guile-2.2.4) - (module-ref (resolve-interface '(gnu packages guile)) - 'guile-2.2.4)) - -(define %quirks - ;; 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 %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 '%guile-for-build' should be good enough." diff --git a/guix/quirks.scm b/guix/quirks.scm new file mode 100644 index 0000000000..483169e70d --- /dev/null +++ b/guix/quirks.scm @@ -0,0 +1,124 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix quirks) + #:use-module ((guix build utils) #:select (substitute*)) + #:use-module (srfi srfi-9) + #:use-module (ice-9 rdelim) + #:export (%quirks + + patch? + applicable-patch? + apply-patch + + %patches)) + +;;; Commentary: +;;; +;;; Time traveling is a challenge! Sometimes, going back to the past requires +;;; adjusting the old source code so it can be evaluated with our modern day +;;; Guile and against our modern Guix APIs. This file describes quirks found +;;; in old Guix revisions, along with ways to address them or patch them. +;;; +;;; Code: + +(define (syscalls-reexports-local-variables? source) + "Return true if (guix build syscalls) contains the bug described at +<https://bugs.gnu.org/36723>." + (catch 'system-error + (lambda () + (define content + (call-with-input-file (string-append source + "/guix/build/syscalls.scm") + read-string)) + + ;; The faulty code would use the 're-export' macro, causing the + ;; 'AT_SYMLINK_NOFOLLOW' local variable to be re-exported when using + ;; Guile > 2.2.4. + (string-contains content "(re-export variable)")) + (lambda args + (if (= ENOENT (system-error-errno args)) + #f + (apply throw args))))) + +(define (guile-2.2.4) + (module-ref (resolve-interface '(gnu packages guile)) + 'guile-2.2.4)) + +(define %quirks + ;; 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))) + + +;;; +;;; Patches. +;;; + +;; Patch to apply to a source tree. +(define-record-type <patch> + (patch predicate application) + patch? + (predicate patch-predicate) ;procedure + (application patch-application)) ;procedure + +(define (applicable-patch? patch source commit) + "Return true if PATCH is applicable to SOURCE, a directory, which +corresponds to the given Guix COMMIT, a SHA1 hexadecimal string." + ;; The predicate is passed COMMIT so that it can choose to only apply to + ;; ancestors. + ((patch-predicate patch) source commit)) + +(define (apply-patch patch source) + "Apply PATCH onto SOURCE, directly modifying files beneath it." + ((patch-application patch) source)) + +(define %self-build-file + ;; The file containing code to build Guix. + "build-aux/build-self.scm") + +(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)) |