diff options
author | Ludovic Courtès <ludo@gnu.org> | 2021-01-21 11:20:14 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2021-01-21 11:22:08 +0100 |
commit | 5225732b9b54ffa92b9d199246b87dae666a3f77 (patch) | |
tree | e9dadfba4ddf7d80f84598aa23d0a1876164d56f | |
parent | 5f7f4e16d64135291fc5b3d12e57476a52a97105 (diff) | |
download | 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.
-rw-r--r-- | tests/swh.scm | 37 |
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 |