Subject: [PATCH 9/9] tests/gnu-maintenance: Test latest-html-release.

From: Maxime Devos <[email-masked]>
Date: Thu, 1 Sep 2022 11:43:38 +0200

* tests/gnu-maintenance.scm
("latest-html-release, no signature")
("latest-html-release, signature): Two new tests.
---
 tests/gnu-maintenance.scm | 70 ++++++++++++++++++++++++++++++++++++++-
 1 file changed, 69 insertions(+), 1 deletion(-)

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 <[email-masked]>
+;;; Copyright © 2022 Maxime Devos <[email-masked]>
 ;;;
 ;;; 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 @@ (define-module (test-gnu-maintenance)
              ("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)
-- 
2.37.2