aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-05-15 12:19:03 +0200
committerLudovic Courtès <ludo@gnu.org>2021-05-22 23:13:11 +0200
commitbc4d81d267830a3b1ccb63198f4100cc836e4e4e (patch)
tree7ef8268c2920f0bb0f43d348183c3ffd6d96d39f /tests
parentdac6c21623475dbd1fa9679e33649eba461dd6b2 (diff)
downloadguix-bc4d81d267830a3b1ccb63198f4100cc836e4e4e.tar
guix-bc4d81d267830a3b1ccb63198f4100cc836e4e4e.tar.gz
lint: archival: Lookup content in Disarchive database.
* guix/lint.scm (lookup-disarchive-spec): New procedure. (check-archival): When 'lookup-content' returns #f, call 'lookup-disarchive-spec'. Call 'lookup-directory' on the result of 'lookup-directory'. * guix/download.scm (%disarchive-mirrors): Make public. * tests/lint.scm ("archival: missing content"): Set '%disarchive-mirrors'. ("archival: content unavailable but disarchive available"): New test.
Diffstat (limited to 'tests')
-rw-r--r--tests/lint.scm34
1 files changed, 30 insertions, 4 deletions
diff --git a/tests/lint.scm b/tests/lint.scm
index a2c8665142..d54fafc1d2 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
@@ -1008,10 +1008,13 @@
(method url-fetch)
(uri "http://example.org/foo.tgz")
(sha256 (make-bytevector 32))))
- (warnings (with-http-server '((404 "Not archived."))
+ (warnings (with-http-server '((404 "Not archived.")
+ (404 "Not in Disarchive database."))
(parameterize ((%swh-base-url (%local-url)))
- (check-archival (dummy-package "x"
- (source origin)))))))
+ (mock ((guix download) %disarchive-mirrors
+ (list (%local-url)))
+ (check-archival (dummy-package "x"
+ (source origin))))))))
(warning-contains? "not archived" warnings)))
(test-equal "archival: content available"
@@ -1027,6 +1030,29 @@
(parameterize ((%swh-base-url (%local-url)))
(check-archival (dummy-package "x" (source origin)))))))
+(test-equal "archival: content unavailable but disarchive available"
+ '()
+ (let* ((origin (origin
+ (method url-fetch)
+ (uri "http://example.org/foo.tgz")
+ (sha256 (make-bytevector 32))))
+ (disarchive (object->string
+ '(disarchive (version 0)
+ ...
+ "swh:1:dir:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))
+ ;; https://archive.softwareheritage.org/api/1/directory/
+ (directory "[ { \"checksums\": {},
+ \"dir_id\": \"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\",
+ \"type\": \"file\",
+ \"name\": \"README\"
+ \"length\": 42 } ]"))
+ (with-http-server `((404 "") ;lookup-content
+ (200 ,disarchive) ;Disarchive database lookup
+ (200 ,directory)) ;lookup-directory
+ (mock ((guix download) %disarchive-mirrors (list (%local-url)))
+ (parameterize ((%swh-base-url (%local-url)))
+ (check-archival (dummy-package "x" (source origin))))))))
+
(test-assert "archival: missing revision"
(let* ((origin (origin
(method git-fetch)