diff options
| -rw-r--r-- | guix/channels.scm | 50 | ||||
| -rw-r--r-- | guix/git.scm | 1 | ||||
| -rw-r--r-- | tests/channels.scm | 64 |
3 files changed, 79 insertions, 36 deletions
diff --git a/guix/channels.scm b/guix/channels.scm index 4ffc366d6a..75b53c3a8e 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -199,13 +199,45 @@ description file or its default value." channel INSTANCE." (channel-metadata-dependencies (channel-instance-metadata instance))) -(define (latest-channel-instance store channel) +;; 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)) + (loop rest))))) + +(define* (latest-channel-instance store channel + #:key (patches %patches)) "Return the latest channel instance for CHANNEL." + (define (dot-git? file stat) + (and (string=? (basename file) ".git") + (eq? 'directory (stat:type stat)))) + (let-values (((checkout commit) - (latest-repository-commit store (channel-url channel) - #:ref (channel-reference - channel)))) - (channel-instance channel commit checkout))) + (update-cached-checkout (channel-url channel) + #:ref (channel-reference channel)))) + (when (guix-channel? channel) + ;; Apply the relevant subset of PATCHES directly in CHECKOUT. This is + ;; safe to do because 'switch-to-ref' eventually does a hard reset. + (apply-patches checkout commit patches)) + + (let* ((name (url+commit->name (channel-url channel) commit)) + (checkout (add-to-store store name #t "sha256" checkout + #:select? (negate dot-git?)))) + (channel-instance channel commit checkout)))) (define* (latest-channel-instances store channels #:optional (previous-channels '())) "Return a list of channel instances corresponding to the latest checkouts of @@ -337,12 +369,18 @@ to '%package-module-path'." 'guile-2.2.4)) (define %quirks - ;; List of predicate/package pairs. This allows us provide information + ;; 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 %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. + '()) + (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/git.scm b/guix/git.scm index 5fffd429bd..92121156cf 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -40,6 +40,7 @@ with-repository update-cached-checkout + url+commit->name latest-repository-commit commit-difference diff --git a/tests/channels.scm b/tests/channels.scm index f5a7955483..910088ba15 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -135,44 +135,48 @@ (name 'test) (url "test"))) (test-dir (channel-instance-checkout instance--simple))) - (mock ((guix git) latest-repository-commit - (lambda* (store url #:key ref) + (mock ((guix git) update-cached-checkout + (lambda* (url #:key ref) (match url - ("test" (values test-dir 'whatever)) - (_ (values "/not-important" 'not-important))))) - (let ((instances (latest-channel-instances #f (list channel)))) - (and (eq? 2 (length instances)) - (lset= eq? - '(test test-channel) - (map (compose channel-name channel-instance-channel) - instances))))))) + ("test" (values test-dir "caf3cabba9e")) + (_ (values (channel-instance-checkout instance--no-deps) + "abcde1234"))))) + (with-store store + (let ((instances (latest-channel-instances store (list channel)))) + (and (eq? 2 (length instances)) + (lset= eq? + '(test test-channel) + (map (compose channel-name channel-instance-channel) + instances)))))))) (test-assert "latest-channel-instances excludes duplicate channel dependencies" (let* ((channel (channel (name 'test) (url "test"))) (test-dir (channel-instance-checkout instance--with-dupes))) - (mock ((guix git) latest-repository-commit - (lambda* (store url #:key ref) + (mock ((guix git) update-cached-checkout + (lambda* (url #:key ref) (match url - ("test" (values test-dir 'whatever)) - (_ (values "/not-important" 'not-important))))) - (let ((instances (latest-channel-instances #f (list channel)))) - (and (= 2 (length instances)) - (lset= eq? - '(test test-channel) - (map (compose channel-name channel-instance-channel) - instances)) - ;; only the most specific channel dependency should remain, - ;; i.e. the one with a specified commit. - (find (lambda (instance) - (and (eq? (channel-name - (channel-instance-channel instance)) - 'test-channel) - (string=? (channel-commit - (channel-instance-channel instance)) - "abc1234"))) - instances)))))) + ("test" (values test-dir "caf3cabba9e")) + (_ (values (channel-instance-checkout instance--no-deps) + "abcde1234"))))) + (with-store store + (let ((instances (latest-channel-instances store (list channel)))) + (and (= 2 (length instances)) + (lset= eq? + '(test test-channel) + (map (compose channel-name channel-instance-channel) + instances)) + ;; only the most specific channel dependency should remain, + ;; i.e. the one with a specified commit. + (find (lambda (instance) + (and (eq? (channel-name + (channel-instance-channel instance)) + 'test-channel) + (string=? (channel-commit + (channel-instance-channel instance)) + "abc1234"))) + instances))))))) (test-assert "channel-instances->manifest" ;; Compute the manifest for a graph of instances and make sure we get a |