diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2021-05-15 12:19:03 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2021-05-22 23:13:11 +0200 |
| commit | bc4d81d267830a3b1ccb63198f4100cc836e4e4e (patch) | |
| tree | 7ef8268c2920f0bb0f43d348183c3ffd6d96d39f /tests/lint.scm | |
| parent | dac6c21623475dbd1fa9679e33649eba461dd6b2 (diff) | |
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/lint.scm')
| -rw-r--r-- | tests/lint.scm | 34 |
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) |