diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/channels.scm | 57 | ||||
| -rw-r--r-- | tests/guix-download.sh | 45 | ||||
| -rw-r--r-- | tests/lint.scm | 33 | ||||
| -rw-r--r-- | tests/swh.scm | 21 | ||||
| -rw-r--r-- | tests/utils.scm | 28 |
5 files changed, 172 insertions, 12 deletions
diff --git a/tests/channels.scm b/tests/channels.scm index 6c4276deb4..c56e4e6a71 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Ricardo Wurmus <[email protected]> -;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <[email protected]> +;;; Copyright © 2019-2020, 2022, 2024 Ludovic Courtès <[email protected]> ;;; ;;; This file is part of GNU Guix. ;;; @@ -191,11 +191,60 @@ (and (eq? (channel-name (channel-instance-channel instance)) 'test-channel) - (string=? (channel-commit - (channel-instance-channel instance)) - "abc1234"))) + (equal? (channel-commit + (channel-instance-channel instance)) + "abc1234"))) instances))))))) +(test-equal "latest-channel-instances reads dependencies from most-specific instance" + '(chan1 chan2) + ;; Here '.guix-channel' in DIRECTORY2 is less specific than the + ;; user-provided channel spec in ONE: the latter specifies a commit. Since + ;; the most specific one "wins", the bogus '.guix-channel' file added in + ;; DIRECTORY1 as its second commit must not be taken into account. + ;; See <https://issues.guix.gnu.org/68822>. + (with-temporary-git-repository directory1 + `((add "a.scm" "(define-module (a))") + (commit "first commit") + (add ".guix-channel" + ,(object->string + '(channel + (version 0) + (dependencies + ;; Attempting to fetch this dependency would fail. + (channel + (name nonexistent-dependency) + (url "http://guix.example.org/does-not-exist.git")))))) + (commit "second commit")) + (with-temporary-git-repository directory2 + `((add ".guix-channel" + ,(object->string + `(channel (version 0) + (dependencies + (channel + (name chan1) + ;; Note: no 'commit' field here. + (url ,(string-append "file://" directory1))))))) + (commit "initial commit")) + (with-repository directory1 repository + (let* ((commit (find-commit repository "first")) + (one (channel + (url (string-append "file://" directory1)) + (commit (oid->string (commit-id commit))) ;<- specific + (name 'chan1))) + (two (channel + (url (string-append "file://" directory2)) + (name 'chan2)))) + + (with-store store + (map (compose channel-name channel-instance-channel) + (delete-duplicates + (append (latest-channel-instances store (list one two)) + (latest-channel-instances store (list two one))) + (lambda (instance1 instance2) + (string=? (channel-instance-commit instance1) + (channel-instance-commit instance2))))))))))) + (test-equal "latest-channel-instances #:validate-pull" 'descendant diff --git a/tests/guix-download.sh b/tests/guix-download.sh index f4cb335eef..d4cd2ea6b9 100644 --- a/tests/guix-download.sh +++ b/tests/guix-download.sh @@ -16,6 +16,12 @@ # You should have received a copy of the GNU General Public License # along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. +# Define some files/folders needed for the tests. +output="t-download-$$" +test_git_repo="$(mktemp -d)" +output_dir="t-archive-dir-$$" +trap 'rm -rf "$test_git_repo" ; rm -f "$output" ; rm -rf "$output_dir"' EXIT + # # Test the `guix download' command-line utility. # @@ -36,8 +42,6 @@ guix download "file://$abs_top_srcdir/README" guix download "$abs_top_srcdir/README" # This one too, even if it cannot talk to the daemon. -output="t-download-$$" -trap 'rm -f "$output"' EXIT GUIX_DAEMON_SOCKET="/nowhere" guix download -o "$output" \ "file://$abs_top_srcdir/README" cmp "$output" "$abs_top_srcdir/README" @@ -45,4 +49,41 @@ cmp "$output" "$abs_top_srcdir/README" # This one should fail. guix download "file:///does-not-exist" "file://$abs_top_srcdir/README" && false +# Test git support with local repository. +# First, create a dummy git repo in the temporary directory. +( + cd $test_git_repo + git init + touch test + git config user.name "User" + git config user.email "user@domain" + git add test + git commit -m "Commit" + git tag -a -m "v1" v1 +) + +# Extract commit number. +commit=$((cd $test_git_repo && git log) | head -n 1 | cut -f2 -d' ') + +# We expect that guix hash is working properly or at least that the output of +# 'guix download' is consistent with 'guix hash'. +expected_hash=$(guix hash -rx $test_git_repo) + +# Test the different options +for option in "" "--commit=$commit" "--commit=v1" "--branch=master" +do + command_output="$(guix download --git $option "file://$test_git_repo")" + computed_hash="$(echo $command_output | cut -f2 -d' ')" + store_path="$(echo $command_output | cut -f1 -d' ')" + [ "$expected_hash" = "$computed_hash" ] + diff -r -x ".git" $test_git_repo $store_path +done + +# Should fail. +guix download --git --branch=non_existent "file://$test_git_repo" && false + +# Same but download to file instead of store. +guix download --git "file://$test_git_repo" -o $output_dir +diff -r -x ".git" $test_git_repo $output_dir + exit 0 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 <[email protected]> ;;; Copyright © 2014, 2015, 2016 Eric Bavier <[email protected]> -;;; Copyright © 2014-2023 Ludovic Courtès <[email protected]> +;;; Copyright © 2014-2024 Ludovic Courtès <[email protected]> ;;; Copyright © 2015, 2016 Mathieu Lirzin <[email protected]> ;;; Copyright © 2016 Hartmut Goebel <[email protected]> ;;; Copyright © 2017 Alex Kost <[email protected]> @@ -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 <[email protected]> +;;; Copyright © 2019-2021, 2024 Ludovic Courtès <[email protected]> ;;; ;;; 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 <[email protected]> ;;; Copyright © 2021 Maxime Devos <[email protected]> ;;; Copyright © 2023 Foundation Devices, Inc. <[email protected]> +;;; Copyright © 2024 Herman Rimm <[email protected]> ;;; ;;; 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 |