Commit | Line | Data |
---|---|---|
20507347 LC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> | |
3 | ;;; | |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (guix quirks) | |
20 | #:use-module ((guix build utils) #:select (substitute*)) | |
21 | #:use-module (srfi srfi-9) | |
01611d14 | 22 | #:use-module (ice-9 match) |
20507347 LC |
23 | #:use-module (ice-9 rdelim) |
24 | #:export (%quirks | |
25 | ||
26 | patch? | |
27 | applicable-patch? | |
28 | apply-patch | |
29 | ||
30 | %patches)) | |
31 | ||
32 | ;;; Commentary: | |
33 | ;;; | |
34 | ;;; Time traveling is a challenge! Sometimes, going back to the past requires | |
35 | ;;; adjusting the old source code so it can be evaluated with our modern day | |
36 | ;;; Guile and against our modern Guix APIs. This file describes quirks found | |
37 | ;;; in old Guix revisions, along with ways to address them or patch them. | |
38 | ;;; | |
39 | ;;; Code: | |
40 | ||
41 | (define (syscalls-reexports-local-variables? source) | |
42 | "Return true if (guix build syscalls) contains the bug described at | |
43 | <https://bugs.gnu.org/36723>." | |
44 | (catch 'system-error | |
45 | (lambda () | |
46 | (define content | |
47 | (call-with-input-file (string-append source | |
48 | "/guix/build/syscalls.scm") | |
49 | read-string)) | |
50 | ||
51 | ;; The faulty code would use the 're-export' macro, causing the | |
52 | ;; 'AT_SYMLINK_NOFOLLOW' local variable to be re-exported when using | |
53 | ;; Guile > 2.2.4. | |
54 | (string-contains content "(re-export variable)")) | |
55 | (lambda args | |
56 | (if (= ENOENT (system-error-errno args)) | |
57 | #f | |
58 | (apply throw args))))) | |
59 | ||
60 | (define (guile-2.2.4) | |
61 | (module-ref (resolve-interface '(gnu packages guile)) | |
62 | 'guile-2.2.4)) | |
63 | ||
64 | (define %quirks | |
65 | ;; List of predicate/package pairs. This allows us to provide information | |
66 | ;; about specific Guile versions that old Guix revisions might need to use | |
67 | ;; just to be able to build and run the trampoline in %SELF-BUILD-FILE. See | |
68 | ;; <https://bugs.gnu.org/37506> | |
69 | `((,syscalls-reexports-local-variables? . ,guile-2.2.4))) | |
70 | ||
71 | \f | |
72 | ;;; | |
73 | ;;; Patches. | |
74 | ;;; | |
75 | ||
76 | ;; Patch to apply to a source tree. | |
77 | (define-record-type <patch> | |
78 | (patch predicate application) | |
79 | patch? | |
80 | (predicate patch-predicate) ;procedure | |
81 | (application patch-application)) ;procedure | |
82 | ||
83 | (define (applicable-patch? patch source commit) | |
84 | "Return true if PATCH is applicable to SOURCE, a directory, which | |
85 | corresponds to the given Guix COMMIT, a SHA1 hexadecimal string." | |
86 | ;; The predicate is passed COMMIT so that it can choose to only apply to | |
87 | ;; ancestors. | |
88 | ((patch-predicate patch) source commit)) | |
89 | ||
90 | (define (apply-patch patch source) | |
91 | "Apply PATCH onto SOURCE, directly modifying files beneath it." | |
92 | ((patch-application patch) source)) | |
93 | ||
94 | (define %self-build-file | |
95 | ;; The file containing code to build Guix. | |
96 | "build-aux/build-self.scm") | |
97 | ||
98 | (define %bug-41028-patch | |
99 | ;; Patch for <https://bugs.gnu.org/41028>. The faulty code is the | |
100 | ;; 'compute-guix-derivation' body, which uses 'call-with-new-thread' without | |
101 | ;; importing (ice-9 threads). However, the 'call-with-new-thread' binding | |
102 | ;; is no longer available in the default name space on Guile 3.0. | |
103 | (let () | |
104 | (define (missing-ice-9-threads-import? source commit) | |
105 | ;; Return true if %SELF-BUILD-FILE is missing an (ice-9 threads) import. | |
106 | (define content | |
107 | (call-with-input-file (string-append source "/" %self-build-file) | |
108 | read-string)) | |
109 | ||
110 | (and (string-contains content "(call-with-new-thread") | |
111 | (not (string-contains content "(ice-9 threads)")))) | |
112 | ||
113 | (define (add-missing-ice-9-threads-import source) | |
114 | ;; Add (ice-9 threads) import in the gexp of 'compute-guix-derivation'. | |
115 | (substitute* (string-append source "/" %self-build-file) | |
116 | (("^ +\\(use-modules \\(ice-9 match\\)\\)") | |
117 | (object->string '(use-modules (ice-9 match) (ice-9 threads)))))) | |
118 | ||
119 | (patch missing-ice-9-threads-import? add-missing-ice-9-threads-import))) | |
120 | ||
01611d14 LC |
121 | (define %bug-41214-patch |
122 | ;; Patch for <https://bugs.gnu.org/41214>. Around v1.0.0, (guix build | |
123 | ;; compile) would use Guile 2.2 procedures to access the set of available | |
124 | ;; compilation options. These procedures no longer exist in 3.0. | |
125 | (let () | |
126 | (define (accesses-guile-2.2-optimization-options? source commit) | |
127 | (catch 'system-error | |
128 | (lambda () | |
129 | (match (call-with-input-file | |
130 | (string-append source "/guix/build/compile.scm") | |
131 | read) | |
132 | (('define-module ('guix 'build 'compile) | |
133 | _ ... | |
134 | #:use-module ('language 'tree-il 'optimize) | |
135 | #:use-module ('language 'cps 'optimize) | |
136 | #:export ('%default-optimizations | |
137 | '%lightweight-optimizations | |
138 | 'compile-files)) | |
139 | #t) | |
140 | (_ #f))) | |
141 | (const #f))) | |
142 | ||
143 | (define (build-with-guile-2.2 source) | |
144 | (substitute* (string-append source "/" %self-build-file) | |
145 | (("\\(default-guile\\)") | |
146 | (object->string '(car (find-best-packages-by-name "guile" "2.2")))) | |
147 | (("\\(find-best-packages-by-name \"guile-gcrypt\" #f\\)") | |
148 | (object->string '(find-best-packages-by-name "guile2.2-gcrypt" #f)))) | |
149 | #t) | |
150 | ||
151 | (patch accesses-guile-2.2-optimization-options? | |
152 | build-with-guile-2.2))) | |
153 | ||
20507347 LC |
154 | (define %patches |
155 | ;; Bits of past Guix revisions can become incompatible with newer Guix and | |
156 | ;; Guile. This variable lists <patch> records for the Guix source tree that | |
157 | ;; apply to the Guix source. | |
01611d14 LC |
158 | (list %bug-41028-patch |
159 | %bug-41214-patch)) |