me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ricardo Wurmus 2022-01-04 21:26:29 +01:00
parent 6a54715988
commit a6bf1c108e
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC
1 changed files with 97 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
tests/upstream.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -17,9 +18,16 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(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 tests)
#:use-module (srfi srfi-64))
#:use-module (srfi srfi-64)
#:use-module (ice-9 match))
(test-begin "upstream")
@ -46,4 +54,92 @@
(signature-urls
'("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)