diff options
Diffstat (limited to 'tests/channels.scm')
| -rw-r--r-- | tests/channels.scm | 139 |
1 files changed, 139 insertions, 0 deletions
diff --git a/tests/channels.scm b/tests/channels.scm new file mode 100644 index 0000000000..f3fc383ac3 --- /dev/null +++ b/tests/channels.scm @@ -0,0 +1,139 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (test-channels) + #:use-module (guix channels) + #:use-module ((guix build syscalls) #:select (mkdtemp!)) + #:use-module (guix tests) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) + +(test-begin "channels") + +(define* (make-instance #:key + (name 'fake) + (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)))) + ((@@ (guix channels) channel-instance) + name commit instance-dir)) + +(define instance--boring (make-instance)) +(define instance--no-deps + (make-instance #:spec + '(channel + (version 0) + (dependencies + (channel + (name test-channel) + (url "https://example.com/test-channel")))))) +(define instance--simple + (make-instance #:spec + '(channel + (version 0) + (dependencies + (channel + (name test-channel) + (url "https://example.com/test-channel")))))) +(define instance--with-dupes + (make-instance #:spec + '(channel + (version 0) + (dependencies + (channel + (name test-channel) + (url "https://example.com/test-channel")) + (channel + (name test-channel) + (url "https://example.com/test-channel") + (commit "abc1234")) + (channel + (name test-channel) + (url "https://example.com/test-channel-elsewhere")))))) + +(define read-channel-metadata + (@@ (guix channels) read-channel-metadata)) + + +(test-equal "read-channel-metadata returns #f if .guix-channel does not exist" + #f + (read-channel-metadata instance--boring)) + +(test-assert "read-channel-metadata returns <channel-metadata>" + (every (@@ (guix channels) channel-metadata?) + (map read-channel-metadata + (list instance--no-deps + instance--simple + instance--with-dupes)))) + +(test-assert "read-channel-metadata dependencies are channels" + (let ((deps ((@@ (guix channels) channel-metadata-dependencies) + (read-channel-metadata instance--simple)))) + (match deps + (((? channel? dep)) #t) + (_ #f)))) + +(test-assert "latest-channel-instances includes channel dependencies" + (let* ((channel (channel + (name 'test) + (url "test"))) + (test-dir (channel-instance-checkout instance--simple))) + (mock ((guix git) latest-repository-commit + (lambda* (store 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-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) + (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)) + ;; 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) + (eq? (channel-commit + (channel-instance-channel instance)) + 'abc1234))) + instances)))))) + +(test-end "channels") |