aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/channels.scm27
-rw-r--r--tests/channels.scm45
2 files changed, 41 insertions, 31 deletions
diff --git a/guix/channels.scm b/guix/channels.scm
index 87ad729a70..415246cbd1 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -110,8 +110,8 @@
(define-record-type <channel-metadata>
(channel-metadata directory dependencies)
channel-metadata?
- (directory channel-metadata-directory)
- (dependencies channel-metadata-dependencies))
+ (directory channel-metadata-directory) ;string with leading slash
+ (dependencies channel-metadata-dependencies)) ;list of <channel>
(define (channel-reference channel)
"Return the \"reference\" for CHANNEL, an sexp suitable for
@@ -129,7 +129,9 @@ if valid metadata could not be read from PORT."
(let ((directory (and=> (assoc-ref properties 'directory) first))
(dependencies (or (assoc-ref properties 'dependencies) '())))
(channel-metadata
- directory
+ (cond ((not directory) "/")
+ ((string-prefix? "/" directory) directory)
+ (else (string-append "/" directory)))
(map (lambda (item)
(let ((get (lambda* (key #:optional default)
(or (and=> (assoc-ref item key) first) default))))
@@ -157,29 +159,26 @@ if valid metadata could not be read from PORT."
(define (read-channel-metadata-from-source source)
"Return a channel-metadata record read from channel's SOURCE/.guix-channel
-description file, or return #F if SOURCE/.guix-channel does not exist."
+description file, or return the default channel-metadata record if that file
+doesn't exist."
(catch 'system-error
(lambda ()
(call-with-input-file (string-append source "/.guix-channel")
read-channel-metadata))
(lambda args
(if (= ENOENT (system-error-errno args))
- #f
+ (channel-metadata "/" '())
(apply throw args)))))
(define (channel-instance-metadata instance)
"Return a channel-metadata record read from the channel INSTANCE's
-description file, or return #F if the channel instance does not include the
-file."
+description file or its default value."
(read-channel-metadata-from-source (channel-instance-checkout instance)))
(define (channel-instance-dependencies instance)
"Return the list of channels that are declared as dependencies for the given
channel INSTANCE."
- (match (channel-instance-metadata instance)
- (#f '())
- (($ <channel-metadata> directory dependencies)
- dependencies)))
+ (channel-metadata-dependencies (channel-instance-metadata instance)))
(define* (latest-channel-instances store channels #:optional (previous-channels '()))
"Return a list of channel instances corresponding to the latest checkouts of
@@ -261,7 +260,7 @@ objects. The assumption is that SOURCE contains package modules to be added
to '%package-module-path'."
(let* ((metadata (read-channel-metadata-from-source source))
- (directory (and=> metadata channel-metadata-directory)))
+ (directory (channel-metadata-directory metadata)))
(define build
;; This is code that we'll run in CORE, a Guix instance, with its own
@@ -281,9 +280,7 @@ to '%package-module-path'."
(string-append #$output "/share/guile/site/"
(effective-version)))
- (let* ((subdir (if #$directory
- (string-append "/" #$directory)
- ""))
+ (let* ((subdir #$directory)
(source (string-append #$source subdir)))
(compile-files source go (find-files source "\\.scm$"))
(mkdir-p (dirname scm))
diff --git a/tests/channels.scm b/tests/channels.scm
index 1f1357fca7..e83b5437d3 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -42,9 +42,9 @@
(commit "cafebabe")
(spec #f))
(define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX"))
- (and spec
- (with-output-to-file (string-append instance-dir "/.guix-channel")
- (lambda _ (format #t "~a" spec))))
+ (when spec
+ (call-with-output-file (string-append instance-dir "/.guix-channel")
+ (lambda (port) (write spec port))))
(checkout->channel-instance instance-dir
#:commit commit
#:name name))
@@ -55,12 +55,10 @@
'(channel (version 42) (dependencies whatever))))
(define instance--no-deps
(make-instance #:spec
- '(channel
- (version 0)
- (dependencies
- (channel
- (name test-channel)
- (url "https://example.com/test-channel"))))))
+ '(channel (version 0))))
+(define instance--sub-directory
+ (make-instance #:spec
+ '(channel (version 0) (directory "modules"))))
(define instance--simple
(make-instance #:spec
'(channel
@@ -87,11 +85,26 @@
(define channel-instance-metadata
(@@ (guix channels) channel-instance-metadata))
+(define channel-metadata-directory
+ (@@ (guix channels) channel-metadata-directory))
+(define channel-metadata-dependencies
+ (@@ (guix channels) channel-metadata-dependencies))
-(test-equal "channel-instance-metadata returns #f if .guix-channel does not exist"
- #f
- (channel-instance-metadata instance--boring))
+(test-equal "channel-instance-metadata returns default if .guix-channel does not exist"
+ '("/" ())
+ (let ((metadata (channel-instance-metadata instance--boring)))
+ (list (channel-metadata-directory metadata)
+ (channel-metadata-dependencies metadata))))
+
+(test-equal "channel-instance-metadata and default dependencies"
+ '()
+ (channel-metadata-dependencies (channel-instance-metadata instance--no-deps)))
+
+(test-equal "channel-instance-metadata and directory"
+ "/modules"
+ (channel-metadata-directory
+ (channel-instance-metadata instance--sub-directory)))
(test-equal "channel-instance-metadata rejects unsupported version"
1 ;line number in the generated '.guix-channel'
@@ -141,7 +154,7 @@
("test" (values test-dir 'whatever))
(_ (values "/not-important" 'not-important)))))
(let ((instances (latest-channel-instances #f (list channel))))
- (and (eq? 2 (length instances))
+ (and (= 2 (length instances))
(lset= eq?
'(test test-channel)
(map (compose channel-name channel-instance-channel)
@@ -152,9 +165,9 @@
(and (eq? (channel-name
(channel-instance-channel instance))
'test-channel)
- (eq? (channel-commit
- (channel-instance-channel instance))
- 'abc1234)))
+ (string=? (channel-commit
+ (channel-instance-channel instance))
+ "abc1234")))
instances))))))
(test-assert "channel-instances->manifest"