mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
tests: Add tests for changed-inputs on old-style inputs.
All these tests pass, because they only test the old-style input alists with labels. * tests/upstream.scm ("changed-inputs returns no changes", "changed-inputs returns changes to labelled input list", "changed-inputs returns changes to all labelled input lists"): New tests.
This commit is contained in:
parent
6a54715988
commit
a6bf1c108e
1 changed files with 97 additions and 1 deletions
|
@ -1,5 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -17,9 +18,16 @@
|
||||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (test-upstream)
|
(define-module (test-upstream)
|
||||||
|
#:use-module (gnu packages base)
|
||||||
|
#:use-module (guix download)
|
||||||
|
#:use-module (guix packages)
|
||||||
|
#:use-module (guix build-system gnu)
|
||||||
|
#:use-module (guix import print)
|
||||||
|
#:use-module ((guix licenses) #:prefix license:)
|
||||||
#:use-module (guix upstream)
|
#:use-module (guix upstream)
|
||||||
#:use-module (guix tests)
|
#:use-module (guix tests)
|
||||||
#:use-module (srfi srfi-64))
|
#:use-module (srfi srfi-64)
|
||||||
|
#:use-module (ice-9 match))
|
||||||
|
|
||||||
|
|
||||||
(test-begin "upstream")
|
(test-begin "upstream")
|
||||||
|
@ -46,4 +54,92 @@ (define-module (test-upstream)
|
||||||
(signature-urls
|
(signature-urls
|
||||||
'("ftp://example.org/foo-1.tar.xz.sig"))))))
|
'("ftp://example.org/foo-1.tar.xz.sig"))))))
|
||||||
|
|
||||||
|
(define test-package
|
||||||
|
(package
|
||||||
|
(name "test")
|
||||||
|
(version "2.10")
|
||||||
|
(source (origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append "mirror://gnu/hello/hello-" version
|
||||||
|
".tar.gz"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(inputs
|
||||||
|
`(("hello" ,hello)))
|
||||||
|
(native-inputs
|
||||||
|
`(("sed" ,sed)
|
||||||
|
("tar" ,tar)))
|
||||||
|
(propagated-inputs
|
||||||
|
`(("grep" ,grep)))
|
||||||
|
(home-page "http://localhost")
|
||||||
|
(synopsis "test")
|
||||||
|
(description "test")
|
||||||
|
(license license:gpl3+)))
|
||||||
|
|
||||||
|
(define test-package-sexp
|
||||||
|
'(package
|
||||||
|
(name "test")
|
||||||
|
(version "2.10")
|
||||||
|
(source (origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append "mirror://gnu/hello/hello-" version
|
||||||
|
".tar.gz"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(inputs
|
||||||
|
`(("hello" ,hello)))
|
||||||
|
(native-inputs
|
||||||
|
`(("sed" ,sed)
|
||||||
|
("tar" ,tar)))
|
||||||
|
(propagated-inputs
|
||||||
|
`(("grep" ,grep)))
|
||||||
|
(home-page "http://localhost")
|
||||||
|
(synopsis "test")
|
||||||
|
(description "test")
|
||||||
|
(license license:gpl3+)))
|
||||||
|
|
||||||
|
(test-equal "changed-inputs returns no changes"
|
||||||
|
'()
|
||||||
|
(changed-inputs test-package test-package-sexp))
|
||||||
|
|
||||||
|
(test-assert "changed-inputs returns changes to labelled input list"
|
||||||
|
(let ((changes (changed-inputs
|
||||||
|
(package
|
||||||
|
(inherit test-package)
|
||||||
|
(inputs `(("hello" ,hello)
|
||||||
|
("sed" ,sed))))
|
||||||
|
test-package-sexp)))
|
||||||
|
(match changes
|
||||||
|
;; Exactly one change
|
||||||
|
(((? upstream-input-change? item))
|
||||||
|
(and (equal? (upstream-input-change-type item)
|
||||||
|
'regular)
|
||||||
|
(equal? (upstream-input-change-action item)
|
||||||
|
'remove)
|
||||||
|
(string=? (upstream-input-change-name item)
|
||||||
|
"sed")))
|
||||||
|
(else (pk else #false)))))
|
||||||
|
|
||||||
|
(test-assert "changed-inputs returns changes to all labelled input lists"
|
||||||
|
(let ((changes (changed-inputs
|
||||||
|
(package
|
||||||
|
(inherit test-package)
|
||||||
|
(inputs '())
|
||||||
|
(native-inputs '())
|
||||||
|
(propagated-inputs '()))
|
||||||
|
test-package-sexp)))
|
||||||
|
(match changes
|
||||||
|
(((? upstream-input-change? items) ...)
|
||||||
|
(and (equal? (map upstream-input-change-type items)
|
||||||
|
'(regular native native propagated))
|
||||||
|
(equal? (map upstream-input-change-action items)
|
||||||
|
'(add add add add))
|
||||||
|
(equal? (map upstream-input-change-name items)
|
||||||
|
'("hello" "sed" "tar" "grep"))))
|
||||||
|
(else (pk else #false)))))
|
||||||
|
|
||||||
(test-end)
|
(test-end)
|
||||||
|
|
Loading…
Reference in a new issue