rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

channels: Move quirks and patches to (guix quirks). 

* guix/channels.scm (apply-patches): Don't access <patch> record
directly; use 'applicable-patch?' and 'apply-patch' instead.
(<patch>, syscalls-reexports-local-variables?)
(guile-2.2.4, %quirks, %bug-41028-patch, %patches): Move to...
* guix/quirks.scm: ... here.  New file.
(apply-patch, applicable-patch?): New procedures.
This commit is contained in:
Ludovic Courtès 2020-05-14 22:53:44 +02:00
parent bbd9c9c901
commit 2050734717
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 129 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile.am
View File

@ -95,6 +95,7 @@ MODULES = \
guix/repl.scm \ guix/repl.scm \
guix/inferior.scm \ guix/inferior.scm \
guix/describe.scm \ guix/describe.scm \
guix/quirks.scm \
guix/channels.scm \ guix/channels.scm \
guix/gnu-maintenance.scm \ guix/gnu-maintenance.scm \
guix/self.scm \ guix/self.scm \

77
guix/channels.scm
View File

@ -38,7 +38,6 @@
#:select (source-properties->location #:select (source-properties->location
&error-location &error-location
&fix-hint)) &fix-hint))
#:use-module ((guix build utils) #:select (substitute*))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-2) #:use-module (srfi srfi-2)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
@ -48,6 +47,7 @@
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:autoload (guix self) (whole-package make-config.scm) #:autoload (guix self) (whole-package make-config.scm)
#:autoload (guix inferior) (gexp->derivation-in-inferior) ;FIXME: circular dep #: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 match)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
#:use-module ((ice-9 rdelim) #:select (read-string)) #:use-module ((ice-9 rdelim) #:select (read-string))
@ -200,24 +200,15 @@ description file or its default value."
channel INSTANCE." channel INSTANCE."
(channel-metadata-dependencies (channel-instance-metadata 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) (define (apply-patches checkout commit patches)
"Apply the matching PATCHES to CHECKOUT, modifying files in place. The "Apply the matching PATCHES to CHECKOUT, modifying files in place. The
result is unspecified." result is unspecified."
(let loop ((patches patches)) (let loop ((patches patches))
(match patches (match patches
(() #t) (() #t)
((($ <patch> predicate modify) rest ...) ((patch rest ...)
;; PREDICATE is passed COMMIT so that it can choose to only apply to (when (applicable-patch? patch checkout commit)
;; ancestors. (apply-patch patch checkout))
(when (predicate checkout commit)
(modify checkout))
(loop rest))))) (loop rest)))))
(define* (latest-channel-instance store channel (define* (latest-channel-instance store channel
@ -346,66 +337,6 @@ to '%package-module-path'."
(gexp->derivation-in-inferior name build core))) (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)) (define* (guile-for-source source #:optional (quirks %quirks))
"Return the Guile package to use when building SOURCE or #f if the default "Return the Guile package to use when building SOURCE or #f if the default
'%guile-for-build' should be good enough." '%guile-for-build' should be good enough."

124
guix/quirks.scm Normal file
View File

@ -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))