36640207c9
Fixes <https://bugs.gnu.org/41595>. Reported by Jan Nieuwenhuizen <janneke@gnu.org>. * guix/quirks.scm (requires-guile-2.2?): New procedure. (%quirks): Add it. (%bug-41214-patch): Comment.
174 lines
6.5 KiB
Scheme
174 lines
6.5 KiB
Scheme
;;; 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 match)
|
||
#: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 (requires-guile-2.2? source)
|
||
"Return true if SOURCE uses Guile 2.2 for the shebang of
|
||
'compute-guix-derivation'."
|
||
(define content
|
||
(call-with-input-file (string-append source "/" %self-build-file)
|
||
read-string))
|
||
|
||
;; The 'find-best-packages-by-name' call is inserted by %BUG-41214-PATCH.
|
||
(string-contains content
|
||
(object->string
|
||
'(find-best-packages-by-name "guile" "2.2"))))
|
||
|
||
(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)
|
||
(,requires-guile-2.2? . ,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 %bug-41214-patch
|
||
;; Patch for <https://bugs.gnu.org/41214>. Around v1.0.0, (guix build
|
||
;; compile) would use Guile 2.2 procedures to access the set of available
|
||
;; compilation options. These procedures no longer exist in 3.0.
|
||
(let ()
|
||
(define (accesses-guile-2.2-optimization-options? source commit)
|
||
(catch 'system-error
|
||
(lambda ()
|
||
(match (call-with-input-file
|
||
(string-append source "/guix/build/compile.scm")
|
||
read)
|
||
(('define-module ('guix 'build 'compile)
|
||
_ ...
|
||
#:use-module ('language 'tree-il 'optimize)
|
||
#:use-module ('language 'cps 'optimize)
|
||
#:export ('%default-optimizations
|
||
'%lightweight-optimizations
|
||
'compile-files))
|
||
#t)
|
||
(_ #f)))
|
||
(const #f)))
|
||
|
||
(define (build-with-guile-2.2 source)
|
||
(substitute* (string-append source "/" %self-build-file)
|
||
(("\\(default-guile\\)")
|
||
;; Note: This goes hand in hand with the 'requires-guile-2.2?' quirk.
|
||
(object->string '(car (find-best-packages-by-name "guile" "2.2"))))
|
||
(("\\(find-best-packages-by-name \"guile-gcrypt\" #f\\)")
|
||
(object->string '(find-best-packages-by-name "guile2.2-gcrypt" #f))))
|
||
#t)
|
||
|
||
(patch accesses-guile-2.2-optimization-options?
|
||
build-with-guile-2.2)))
|
||
|
||
(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
|
||
%bug-41214-patch))
|