1 files changed, 97 insertions, 1 deletions
diff --git a/tests/upstream.scm b/tests/upstream.scm
index e431956960..594334304a 100644
--- a/tests/upstream.scm
+++ b/tests/upstream.scm
@@ -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)