summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/channels.scm50
-rw-r--r--guix/git.scm1
-rw-r--r--tests/channels.scm64
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