tribes/guix
1
0
Fork 1
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-05-25 02:21:49 +02:00
Code Activity

lint: archival: Lookup content in Disarchive database.

Browse Source 
* 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.
This commit is contained in:
Ludovic Courtès
2021-05-15 12:19:03 +02:00
parent dac6c21623
commit bc4d81d267
3 changed files with 89 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tests/lint.scm
+30 -4
View File
@@ -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)