projects/guix·blob javascript-team · refs

77 lines · 3.2 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2016, 2023-2024 Ludovic Courtès <[email protected]>
3;;; Copyright © 2022 Ricardo Wurmus <[email protected]>
4;;;
5;;; This file is part of GNU Guix.
6;;;
7;;; GNU Guix is free software; you can redistribute it and/or modify it
8;;; under the terms of the GNU General Public License as published by
9;;; the Free Software Foundation; either version 3 of the License, or (at
10;;; your option) any later version.
11;;;
12;;; GNU Guix is distributed in the hope that it will be useful, but
13;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;;; GNU General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU General Public License
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19
20(define-module (test-upstream)
21 #:use-module (gnu packages base)
22 #:use-module (guix download)
23 #:use-module (guix packages)
24 #:use-module (guix build-system gnu)
25 #:use-module (guix import print)
26 #:use-module ((guix licenses) #:prefix license:)
27 #:use-module (guix upstream)
28 #:use-module (guix tests)
29 #:use-module (srfi srfi-26)
30 #:use-module (srfi srfi-64)
31 #:use-module (ice-9 match))
32
33
34(test-begin "upstream")
35
36(test-equal "coalesce-sources same version"
37 '((source "foo" "1"
38 ("ftp://example.org/foo-1.tar.xz"
39 "ftp://example.org/foo-1.tar.gz")
40 ("ftp://example.org/foo-1.tar.xz.sig"
41 "ftp://example.org/foo-1.tar.gz.sig")))
42
43 (map (lambda (source)
44 `(source ,(upstream-source-package source)
45 ,(upstream-source-version source)
46 ,(upstream-source-urls source)
47 ,(upstream-source-signature-urls source)))
48 (coalesce-sources (list (upstream-source
49 (package "foo") (version "1")
50 (urls '("ftp://example.org/foo-1.tar.gz"))
51 (signature-urls
52 '("ftp://example.org/foo-1.tar.gz.sig")))
53 (upstream-source
54 (package "foo") (version "1")
55 (urls '("ftp://example.org/foo-1.tar.xz"))
56 (signature-urls
57 '("ftp://example.org/foo-1.tar.xz.sig")))))))
58
59(test-equal "preferred-upstream-source"
60 '(("http://example.org/foo-2.0.tar.xz")
61 ("http://example.org/foo-2.0.tar.xz.sig"))
62 (let* ((package (dummy-package
63 "foo"
64 (version "1.0")
65 (source
66 (dummy-origin (uri "http://example.org/foo-1.0.tar.xz")))))
67 (source (upstream-source
68 (package "foo")
69 (version "2.0")
70 (urls '("http://example.org/foo-2.0.tar.gz"
71 "http://example.org/foo-2.0.tar.xz"))
72 (signature-urls (map (cut string-append <> ".sig") urls))))
73 (preferred (preferred-upstream-source source package)))
74 (list (upstream-source-urls preferred)
75 (upstream-source-signature-urls preferred))))
76
77(test-end)