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 | ||
36640207 LC |
60 | (define (requires-guile-2.2? source) |
61 | "Return true if SOURCE uses Guile 2.2 for the shebang of | |
62 | 'compute-guix-derivation'." | |
63 | (define content | |
64 | (call-with-input-file (string-append source "/" %self-build-file) | |
65 | read-string)) | |
66 | ||
67 | ;; The 'find-best-packages-by-name' call is inserted by %BUG-41214-PATCH. | |
68 | (string-contains content | |
69 | (object->string | |
70 | '(find-best-packages-by-name "guile" "2.2")))) | |
71 | ||
20507347 LC |
72 | (define (guile-2.2.4) |
73 | (module-ref (resolve-interface '(gnu packages guile)) | |
74 | 'guile-2.2.4)) | |
75 | ||
76 | (define %quirks | |
77 | ;; List of predicate/package pairs. This allows us to provide information | |
78 | ;; about specific Guile versions that old Guix revisions might need to use | |
79 | ;; just to be able to build and run the trampoline in %SELF-BUILD-FILE. See | |
80 | ;; <https://bugs.gnu.org/37506> | |
36640207 LC |
81 | `((,syscalls-reexports-local-variables? . ,guile-2.2.4) |
82 | (,requires-guile-2.2? . ,guile-2.2.4))) | |
20507347 LC |
83 | |
84 | \f | |
85 | ;;; | |
86 | ;;; Patches. | |
87 | ;;; | |
88 | ||
89 | ;; Patch to apply to a source tree. | |
90 | (define-record-type <patch> | |
91 | (patch predicate application) | |
92 | patch? | |
93 | (predicate patch-predicate) ;procedure | |
94 | (application patch-application)) ;procedure | |
95 | ||
96 | (define (applicable-patch? patch source commit) | |
97 | "Return true if PATCH is applicable to SOURCE, a directory, which | |
98 | corresponds to the given Guix COMMIT, a SHA1 hexadecimal string." | |
99 | ;; The predicate is passed COMMIT so that it can choose to only apply to | |
100 | ;; ancestors. | |
101 | ((patch-predicate patch) source commit)) | |
102 | ||
103 | (define (apply-patch patch source) | |
104 | "Apply PATCH onto SOURCE, directly modifying files beneath it." | |
105 | ((patch-application patch) source)) | |
106 | ||
107 | (define %self-build-file | |
108 | ;; The file containing code to build Guix. | |
109 | "build-aux/build-self.scm") | |
110 | ||
111 | (define %bug-41028-patch | |
112 | ;; Patch for <https://bugs.gnu.org/41028>. The faulty code is the | |
113 | ;; 'compute-guix-derivation' body, which uses 'call-with-new-thread' without | |
114 | ;; importing (ice-9 threads). However, the 'call-with-new-thread' binding | |
115 | ;; is no longer available in the default name space on Guile 3.0. | |
116 | (let () | |
117 | (define (missing-ice-9-threads-import? source commit) | |
118 | ;; Return true if %SELF-BUILD-FILE is missing an (ice-9 threads) import. | |
119 | (define content | |
120 | (call-with-input-file (string-append source "/" %self-build-file) | |
121 | read-string)) | |
122 | ||
123 | (and (string-contains content "(call-with-new-thread") | |
124 | (not (string-contains content "(ice-9 threads)")))) | |
125 | ||
126 | (define (add-missing-ice-9-threads-import source) | |
127 | ;; Add (ice-9 threads) import in the gexp of 'compute-guix-derivation'. | |
128 | (substitute* (string-append source "/" %self-build-file) | |
129 | (("^ +\\(use-modules \\(ice-9 match\\)\\)") | |
130 | (object->string '(use-modules (ice-9 match) (ice-9 threads)))))) | |
131 | ||
132 | (patch missing-ice-9-threads-import? add-missing-ice-9-threads-import))) | |
133 | ||
01611d14 LC |
134 | (define %bug-41214-patch |
135 | ;; Patch for <https://bugs.gnu.org/41214>. Around v1.0.0, (guix build | |
136 | ;; compile) would use Guile 2.2 procedures to access the set of available | |
137 | ;; compilation options. These procedures no longer exist in 3.0. | |
138 | (let () | |
139 | (define (accesses-guile-2.2-optimization-options? source commit) | |
140 | (catch 'system-error | |
141 | (lambda () | |
e85d7ed6 LC |
142 | (call-with-input-file (string-append source |
143 | "/guix/build/compile.scm") | |
144 | (lambda (port) | |
145 | (match (read port) | |
146 | (('define-module ('guix 'build 'compile) | |
147 | _ ... | |
148 | #:use-module ('language 'tree-il 'optimize) | |
149 | #:use-module ('language 'cps 'optimize) | |
150 | #:export ('%default-optimizations | |
151 | '%lightweight-optimizations | |
152 | 'compile-files)) | |
153 | #t) | |
154 | (_ | |
155 | ;; Before v1.0.0 (ca. Dec. 2018), the 'use-modules' form | |
156 | ;; would show up in a subsequent 'cond-expand' clause. | |
157 | ;; See <https://bugs.gnu.org/42519>. | |
158 | (match (read port) | |
159 | (('cond-expand | |
160 | ('guile-2.2 ('use-modules ('language 'tree-il 'optimize) | |
161 | _ ...)) | |
162 | _ ...) | |
163 | #t) | |
164 | (_ | |
165 | #f))))))) | |
01611d14 LC |
166 | (const #f))) |
167 | ||
168 | (define (build-with-guile-2.2 source) | |
169 | (substitute* (string-append source "/" %self-build-file) | |
170 | (("\\(default-guile\\)") | |
36640207 | 171 | ;; Note: This goes hand in hand with the 'requires-guile-2.2?' quirk. |
01611d14 LC |
172 | (object->string '(car (find-best-packages-by-name "guile" "2.2")))) |
173 | (("\\(find-best-packages-by-name \"guile-gcrypt\" #f\\)") | |
174 | (object->string '(find-best-packages-by-name "guile2.2-gcrypt" #f)))) | |
175 | #t) | |
176 | ||
177 | (patch accesses-guile-2.2-optimization-options? | |
178 | build-with-guile-2.2))) | |
179 | ||
20507347 LC |
180 | (define %patches |
181 | ;; Bits of past Guix revisions can become incompatible with newer Guix and | |
182 | ;; Guile. This variable lists <patch> records for the Guix source tree that | |
183 | ;; apply to the Guix source. | |
01611d14 LC |
184 | (list %bug-41028-patch |
185 | %bug-41214-patch)) |