summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMaxime Devos <maximedevos@telenet.be>2022-09-01 11:43:38 +0200
committerGuix Patches Tester <>2022-09-01 11:10:24 +0100
commit71a7e7b95524e6ce7ae8c79d0a04896756fb0be4 (patch)
tree246d3a440075cc5a422e4cefedc31faba6dd0eba
parent19e2171e25f50e507edfc6ef4f1a0906f647f43e (diff)
downloadguix-patches-71a7e7b95524e6ce7ae8c79d0a04896756fb0be4.tar
guix-patches-71a7e7b95524e6ce7ae8c79d0a04896756fb0be4.tar.gz
tests/gnu-maintenance: Test latest-html-release.
* tests/gnu-maintenance.scm ("latest-html-release, no signature") ("latest-html-release, signature): Two new tests.
-rw-r--r--tests/gnu-maintenance.scm70
1 files changed, 69 insertions, 1 deletions
diff --git a/tests/gnu-maintenance.scm b/tests/gnu-maintenance.scm
index c04d8ba733..a9e2a0bb9f 100644
--- a/tests/gnu-maintenance.scm
+++ b/tests/gnu-maintenance.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -18,9 +19,14 @@
(define-module (test-gnu-maintenance)
#:use-module (guix gnu-maintenance)
+ #:use-module (guix tests)
+ #:use-module (guix tests http)
+ #:use-module (guix upstream)
+ #:use-module (guix utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64)
- #:use-module (ice-9 match))
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 textual-ports))
(test-begin "gnu-maintenance")
@@ -55,4 +61,66 @@
("mpg321_0.3.2.orig.tar.gz" "0.3.2")
("bvi-1.4.1.src.tar.gz" "1.4.1")))))
+(test-assert "latest-html-release, no signature"
+ (with-http-server
+ `((200 "<html xmlns=\"http://www.w3.org/1999/xhtml\">
+<head>
+<title>Releases!</title>
+</head>
+<body>
+<a href=\"bar/foo-1.tar.gz\">version 1</a>
+<a href=\"bar/foo-2.tar.gz\">version 2</a>
+</body>
+</html>"))
+ (let ()
+ (define package
+ (dummy-package "foo"
+ (source
+ (dummy-origin
+ (uri (string-append (%local-url) "/foo-1.tar.gz"))))
+ (properties
+ `((release-monitoring-url . ,(%local-url))))))
+ (define update ((upstream-updater-latest %generic-html-updater) package))
+ (define expected-new-url
+ (string-append (%local-url) "/foo-2.tar.gz"))
+ (and (pk 'u update)
+ (equal? (upstream-source-version update) "2")
+ (equal? (list expected-new-url)
+ (upstream-source-urls update))
+ (null? ;; both #false and the empty list are acceptable
+ (or (upstream-source-signature-urls update) '()))))))
+
+(test-assert "latest-html-release, signature"
+ (with-http-server
+ `((200 "<html xmlns=\"http://www.w3.org/1999/xhtml\">
+<head>
+<title>Signed releases!</title>
+</head>
+<body>
+<a href=\"bar/foo-1.tar.gz\">version 1</a>
+<a href=\"bar/foo-2.tar.gz\">version 2</a>
+<a href=\"bar/foo-1.tar.gz.sig\">version 1 signature</a>
+<a href=\"bar/foo-2.tar.gz.sig\">version 2 signature</a>
+</body>
+</html>"))
+ (let ()
+ (define package
+ (dummy-package "foo"
+ (source
+ (dummy-origin
+ (uri (string-append (%local-url) "/foo-1.tar.gz"))))
+ (properties
+ `((release-monitoring-url . ,(%local-url))))))
+ (define update ((upstream-updater-latest %generic-html-updater) package))
+ (define expected-new-url
+ (string-append (%local-url) "/foo-2.tar.gz"))
+ (define expected-signature-url
+ (string-append (%local-url) "/foo-2.tar.gz.sig"))
+ (and (pk 'u update)
+ (equal? (upstream-source-version update) "2")
+ (equal? (list expected-new-url)
+ (upstream-source-urls update))
+ (equal? (list expected-signature-url)
+ (upstream-source-signature-urls update))))))
+
(test-end)