ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

swh: Test proper handling of null visit snapshot URL.

Browse source 
* tests/swh.scm (%origin): Change "visits_url" to "origin_visits_url".
(%visits): New variable.
("origin-visit, no snapshots"): New test.
This commit is contained in:
Ludovic Courtès 2021-01-21 11:20:14 +01:00
parent 5f7f4e16d6
commit 5225732b9b
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 34 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
tests/swh.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -20,15 +20,32 @@ (define-module (test-swh)
#:use-module (guix swh) #:use-module (guix swh)
#:use-module (guix tests http) #:use-module (guix tests http)
#:use-module (web response) #: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). ;; Test the JSON mapping machinery used in (guix swh).
(define %origin (define %origin
"{ \"visits_url\": \"/visits/42\", "{ \"origin_visits_url\": \"/visits/42\",
\"type\": \"git\", \"type\": \"git\",
\"url\": \"http://example.org/guix.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 (define %directory-entries
"[ { \"name\": \"one\", "[ { \"name\": \"one\",
\"type\": \"regular\", \"type\": \"regular\",
@ -59,6 +76,20 @@ (define-syntax-rule (with-json-result str exp ...)
(parameterize ((%swh-base-url (%local-url))) (parameterize ((%swh-base-url (%local-url)))
(lookup-origin "http://example.org/whatever")))) (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" (test-equal "lookup-directory"
'(("one" 123) ("two" 456)) '(("one" 123) ("two" 456))
(with-json-result %directory-entries (with-json-result %directory-entries