diff options
Diffstat (limited to 'tests')
-rw-r--r-- | tests/lint.scm | 33 | ||||
-rw-r--r-- | tests/swh.scm | 21 | ||||
-rw-r--r-- | tests/utils.scm | 28 |
3 files changed, 76 insertions, 6 deletions
diff --git a/tests/lint.scm b/tests/lint.scm index a52a82237b..87213fcc78 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-2023 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2024 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> @@ -1358,7 +1358,8 @@ ;; https://archive.softwareheritage.org/api/1/content/ (content "{ \"checksums\": {}, \"data_url\": \"xyz\", \"length\": 42 }")) - (with-http-server `((200 ,content)) + (with-http-server `((404 "") ;extid + (200 ,content)) (parameterize ((%swh-base-url (%local-url))) (check-archival (dummy-package "x" (source origin))))))) @@ -1378,7 +1379,8 @@ \"type\": \"file\", \"name\": \"README\" \"length\": 42 } ]")) - (with-http-server `((404 "") ;lookup-content + (with-http-server `((404 "") ;lookup-directory-by-nar-hash + (404 "") ;lookup-content (200 ,disarchive) ;Disarchive database lookup (200 ,directory)) ;lookup-directory (mock ((guix download) %disarchive-mirrors (list (%local-url))) @@ -1397,7 +1399,8 @@ \"save_request_date\": \"2014-11-17T22:09:38+01:00\", \"save_request_status\": \"accepted\", \"save_task_status\": \"scheduled\" }") - (warnings (with-http-server `((404 "No revision.") ;lookup-revision + (warnings (with-http-server `((404 "No extid.") ;lookup-directory-by-nar-hash + (404 "No revision.") ;lookup-revision (404 "No origin.") ;lookup-origin (200 ,save)) ;save-origin (parameterize ((%swh-base-url (%local-url))) @@ -1415,7 +1418,27 @@ ;; https://archive.softwareheritage.org/api/1/revision/ (revision "{ \"author\": {}, \"parents\": [], \"date\": \"2014-11-17T22:09:38+01:00\" }")) - (with-http-server `((200 ,revision)) + (with-http-server `((404 "No directory.") ;lookup-directory-by-nar-hash + (200 ,revision)) + (parameterize ((%swh-base-url (%local-url))) + (check-archival (dummy-package "x" (source origin))))))) + +(test-equal "archival: nar-sha256 extid available" + '() + (let* ((origin (origin + (method git-fetch) + (uri (git-reference + (url "http://example.org/foo.git") + (commit "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))) + (sha256 (make-bytevector 32)))) + ;; https://archive.softwareheritage.org/api/1/extid/doc/ + (extid "{ \"extid_type\": \"nar-sha256\", + \"extid\": \"1234\", + \"extid_version\": 0, + \"target\": \"swh:1:dir:cabba93\", + \"target_url\": \"boo\" + }")) + (with-http-server `((200 ,extid)) (parameterize ((%swh-base-url (%local-url))) (check-archival (dummy-package "x" (source origin))))))) diff --git a/tests/swh.scm b/tests/swh.scm index a36f951241..e7ced6b50c 100644 --- a/tests/swh.scm +++ b/tests/swh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2019-2021, 2024 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,6 +18,7 @@ (define-module (test-swh) #:use-module (guix swh) + #:use-module (guix base32) #:use-module (guix tests http) #:use-module (web response) #:use-module (srfi srfi-19) @@ -56,6 +57,16 @@ \"length\": 456, \"dir_id\": 2 } ]") +(define %external-id + "{ \"extid_type\": \"nar-sha256\", + \"extid\": +\"0b56ba94c2b83b8f74e3772887c1109135802eb3e8962b628377987fe97e1e63\", + \"version\": 0, + \"target\": \"swh:1:dir:84a8b34591712c0a90bab0af604188bcd1fe3153\", + \"target_url\": +\"https://archive.softwareheritage.org/swh:1:dir:84a8b34591712c0a90bab0af604188bcd1fe3153\" + }") + (define-syntax-rule (with-json-result str exp ...) (with-http-server `((200 ,str)) (parameterize ((%swh-base-url (%local-url))) @@ -98,6 +109,14 @@ (directory-entry-length entry))) (lookup-directory "123")))) +(test-equal "lookup-directory-by-nar-hash" + "swh:1:dir:84a8b34591712c0a90bab0af604188bcd1fe3153" + (with-json-result %external-id + (lookup-directory-by-nar-hash + (nix-base32-string->bytevector + "0qqygvlpz63phdi2p5p8ncp80dci230qfa3pwds8yfxqqaablmhb") + 'sha256))) + (test-equal "rate limit reached" 3000000000 (let ((too-many (build-response diff --git a/tests/utils.scm b/tests/utils.scm index 5664165c85..52f3b58ede 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2023 Foundation Devices, Inc. <hello@foundationdevices.com> +;;; Copyright © 2024 Herman Rimm <herman@rimm.ee> ;;; ;;; This file is part of GNU Guix. ;;; @@ -274,6 +275,33 @@ skip these tests." string-reverse) (call-with-input-file temp-file get-string-all))) +(test-equal "insert-expression" + "(define-public package-1\n 'package)\n +(define-public package-2\n 'package)\n" + (begin + (call-with-output-file temp-file + (lambda (port) + (display "(define-public package-2\n 'package)\n" port))) + (insert-expression `((filename . ,temp-file) + (line . 0) + (column . 0)) + `(define-public package-1 'package)) + (call-with-input-file temp-file get-string-all))) + +(test-equal "find-definition-insertion-location" + (list `((filename . ,temp-file) (line . 0) (column . 0)) + `((filename . ,temp-file) (line . 5) (column . 0)) + #f) + (begin + (call-with-output-file temp-file + (lambda (port) + (display "(define-public package-1\n 'foo)\n\n" port) + (display "(define foo 'bar)\n\n" port) + (display "(define-public package-2\n 'baz)\n" port))) + (map (lambda (term) + (find-definition-insertion-location temp-file term)) + (list 'package 'package-1 'package-2)))) + (test-equal "string-distance" '(0 1 1 5 5) (list |