aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-01-21 11:20:14 +0100
committerLudovic Courtès <ludo@gnu.org>2021-01-21 11:22:08 +0100
commit5225732b9b54ffa92b9d199246b87dae666a3f77 (patch)
treee9dadfba4ddf7d80f84598aa23d0a1876164d56f /tests
parent5f7f4e16d64135291fc5b3d12e57476a52a97105 (diff)
downloadguix-5225732b9b54ffa92b9d199246b87dae666a3f77.tar
guix-5225732b9b54ffa92b9d199246b87dae666a3f77.tar.gz
swh: Test proper handling of null visit snapshot URL.
* tests/swh.scm (%origin): Change "visits_url" to "origin_visits_url". (%visits): New variable. ("origin-visit, no snapshots"): New test.
Diffstat (limited to 'tests')
-rw-r--r--tests/swh.scm37
1 files changed, 34 insertions, 3 deletions
diff --git a/tests/swh.scm b/tests/swh.scm
index 06984b2a80..a36f951241 100644
--- a/tests/swh.scm
+++ b/tests/swh.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,15 +20,32 @@
#:use-module (guix swh)
#:use-module (guix tests http)
#:use-module (web response)
- #:use-module (srfi srfi-64))
+ #:use-module (srfi srfi-19)
+ #:use-module (srfi srfi-64)
+ #:use-module (ice-9 match))
;; Test the JSON mapping machinery used in (guix swh).
(define %origin
- "{ \"visits_url\": \"/visits/42\",
+ "{ \"origin_visits_url\": \"/visits/42\",
\"type\": \"git\",
\"url\": \"http://example.org/guix.git\" }")
+(define %visits
+ ;; A single visit where 'snapshot_url' is null.
+ ;; See <https://bugs.gnu.org/45615>.
+ "[ {
+ \"origin\": \"https://github.com/Genivia/ugrep\",
+ \"visit\": 1,
+ \"date\": \"2020-05-17T21:43:45.422977+00:00\",
+ \"status\": \"ongoing\",
+ \"snapshot\": null,
+ \"metadata\": {},
+ \"type\": \"git\",
+ \"origin_visit_url\": \"https://archive.softwareheritage.org/api/1/origin/https://github.com/Genivia/ugrep/visit/1/\",
+ \"snapshot_url\": null
+ } ]")
+
(define %directory-entries
"[ { \"name\": \"one\",
\"type\": \"regular\",
@@ -59,6 +76,20 @@
(parameterize ((%swh-base-url (%local-url)))
(lookup-origin "http://example.org/whatever"))))
+(test-equal "origin-visit, no snapshots"
+ '("https://github.com/Genivia/ugrep"
+ "2020-05-17T21:43:45Z"
+ #f) ;see <https://bugs.gnu.org/45615>
+ (with-http-server `((200 ,%origin)
+ (200 ,%visits))
+ (parameterize ((%swh-base-url (%local-url)))
+ (let ((origin (lookup-origin "http://example.org/whatever")))
+ (match (origin-visits origin)
+ ((visit)
+ (list (visit-origin visit)
+ (date->string (visit-date visit) "~4")
+ (visit-snapshot-url visit))))))))
+
(test-equal "lookup-directory"
'(("one" 123) ("two" 456))
(with-json-result %directory-entries