summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/channels.scm57
-rw-r--r--tests/crate.scm576
-rw-r--r--tests/guix-download.sh45
-rw-r--r--tests/guix-time-machine.sh4
-rw-r--r--tests/lint.scm53
-rw-r--r--tests/pack.scm50
-rw-r--r--tests/swh.scm95
-rw-r--r--tests/utils.scm28
8 files changed, 823 insertions, 85 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 <rekado@elephly.net>
-;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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/crate.scm b/tests/crate.scm
index 5aea5efaf3..ce2f08aade 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2023 David Elsing <david.elsing@posteo.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,7 +25,10 @@
#:use-module (guix import crate)
#:use-module (guix base32)
#:use-module (guix build-system cargo)
- #:use-module (gcrypt hash)
+ #:use-module ((gcrypt hash)
+ #:select ((sha256 . gcrypt-sha256)))
+ #:use-module (guix packages)
+ #:use-module (guix read-print)
#:use-module (guix tests)
#:use-module (gnu packages)
#:use-module (ice-9 iconv)
@@ -37,13 +41,18 @@
;; foo-1.0.0
;; foo-1.0.3
;; leaf-alice 0.7.5
+;; bar-1.0.0
+;; leaf-bob 3.0.1
+;; leaf-bob 3.0.2 (dev-dependency)
+;; leaf-bob 4.0.0 (dev-dependency)
;;
;; root-1.0.0
;; root-1.0.4
-;; intermediate-a 1.0.42
-;; intermeidate-b ^1.0.0
+;; intermediate-a 1.0.42
+;; intermediate-b ^1.0.0
;; leaf-alice ^0.7
-;; leaf-bob ^3
+;; leaf-bob ^3
+;; intermediate-c 1 (dev-dependency)
;;
;; intermediate-a-1.0.40
;; intermediate-a-1.0.42
@@ -55,10 +64,15 @@
;; intermediate-b-1.2.3
;; leaf-bob 3.0.1
;;
+;; intermediate-c-1.0.1
+;; leaf-alice 0.7.5 (dev-dependency)
+;;
;; leaf-alice-0.7.3
;; leaf-alice-0.7.5
;;
;; leaf-bob-3.0.1
+;; leaf-bob-3.0.2 (yanked)
+;; leaf-bob-4.0.0 (yanked)
(define test-foo-crate
@@ -111,6 +125,50 @@
]
}")
+(define test-bar-crate
+ "{
+ \"crate\": {
+ \"max_version\": \"1.0.0\",
+ \"name\": \"bar\",
+ \"description\": \"summary\",
+ \"homepage\": \"http://example.com\",
+ \"repository\": \"http://example.com\",
+ \"keywords\": [\"dummy\", \"test\"],
+ \"categories\": [\"test\"],
+ \"actual_versions\": [
+ { \"id\": 234100,
+ \"num\": \"1.0.0\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/bar/1.0.0/dependencies\"
+ },
+ \"yanked\": false
+ }
+ ]
+ }
+}")
+
+(define test-bar-dependencies
+ "{
+ \"dependencies\": [
+ {
+ \"crate_id\": \"leaf-bob\",
+ \"kind\": \"normal\",
+ \"req\": \"3.0.1\"
+ },
+ {
+ \"crate_id\": \"leaf-bob\",
+ \"kind\": \"dev\",
+ \"req\": \"^3.0.2\"
+ },
+ {
+ \"crate_id\": \"leaf-bob\",
+ \"kind\": \"dev\",
+ \"req\": \"^4.0.0\"
+ }
+ ]
+}")
+
(define test-root-crate
"{
\"crate\": {
@@ -164,6 +222,11 @@
\"crate_id\": \"leaf-bob\",
\"kind\": \"normal\",
\"req\": \"^3\"
+ },
+ {
+ \"crate_id\": \"intermediate-c\",
+ \"kind\": \"dev\",
+ \"req\": \"1\"
}
]
}")
@@ -262,6 +325,40 @@
]
}")
+(define test-intermediate-c-crate
+ "{
+ \"crate\": {
+ \"max_version\": \"1.0.1\",
+ \"name\": \"intermediate-c\",
+ \"description\": \"summary\",
+ \"homepage\": \"http://example.com\",
+ \"repository\": \"http://example.com\",
+ \"keywords\": [\"dummy\", \"test\"],
+ \"categories\": [\"test\"],
+ \"actual_versions\": [
+ { \"id\": 234290,
+ \"num\": \"1.0.1\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/intermediate-c/1.0.1/dependencies\"
+ },
+ \"yanked\": false
+ }
+ ]
+ }
+}")
+
+(define test-intermediate-c-dependencies
+ "{
+ \"dependencies\": [
+ {
+ \"crate_id\": \"leaf-alice\",
+ \"kind\": \"dev\",
+ \"req\": \"0.7.5\"
+ }
+ ]
+}")
+
(define test-leaf-alice-crate
"{
\"crate\": {
@@ -316,6 +413,22 @@
\"dependencies\": \"/api/v1/crates/leaf-bob/3.0.1/dependencies\"
},
\"yanked\": false
+ },
+ { \"id\": 234281,
+ \"num\": \"3.0.2\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/leaf-bob/3.0.2/dependencies\"
+ },
+ \"yanked\": true
+ },
+ { \"id\": 234282,
+ \"num\": \"4.0.0\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/leaf-bob/4.0.0/dependencies\"
+ },
+ \"yanked\": true
}
]
}
@@ -355,7 +468,7 @@
("https://crates.io/api/v1/crates/foo/1.0.3/download"
(set! test-source-hash
(bytevector->nix-base32-string
- (sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
(open-input-string "empty file\n"))
("https://crates.io/api/v1/crates/foo/1.0.3/dependencies"
(open-input-string test-foo-dependencies))
@@ -364,7 +477,7 @@
("https://crates.io/api/v1/crates/leaf-alice/0.7.5/download"
(set! test-source-hash
(bytevector->nix-base32-string
- (sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
(open-input-string "empty file\n"))
("https://crates.io/api/v1/crates/leaf-alice/0.7.5/dependencies"
(open-input-string test-leaf-alice-dependencies))
@@ -398,7 +511,7 @@
(pk 'fail x #f)))))
(unless have-guile-semver? (test-skip 1))
-(test-assert "cargo-recursive-import"
+(test-assert "crate-recursive-import"
;; Replace network resources with sample data.
(mock ((guix http-client) http-fetch
(lambda (url . rest)
@@ -408,7 +521,7 @@
("https://crates.io/api/v1/crates/root/1.0.4/download"
(set! test-source-hash
(bytevector->nix-base32-string
- (sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
(open-input-string "empty file\n"))
("https://crates.io/api/v1/crates/root/1.0.4/dependencies"
(open-input-string test-root-dependencies))
@@ -417,7 +530,7 @@
("https://crates.io/api/v1/crates/intermediate-a/1.0.42/download"
(set! test-source-hash
(bytevector->nix-base32-string
- (sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
(open-input-string "empty file\n"))
("https://crates.io/api/v1/crates/intermediate-a/1.0.42/dependencies"
(open-input-string test-intermediate-a-dependencies))
@@ -426,16 +539,25 @@
("https://crates.io/api/v1/crates/intermediate-b/1.2.3/download"
(set! test-source-hash
(bytevector->nix-base32-string
- (sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
(open-input-string "empty file\n"))
("https://crates.io/api/v1/crates/intermediate-b/1.2.3/dependencies"
(open-input-string test-intermediate-b-dependencies))
+ ("https://crates.io/api/v1/crates/intermediate-c"
+ (open-input-string test-intermediate-c-crate))
+ ("https://crates.io/api/v1/crates/intermediate-c/1.0.1/download"
+ (set! test-source-hash
+ (bytevector->nix-base32-string
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (open-input-string "empty file\n"))
+ ("https://crates.io/api/v1/crates/intermediate-c/1.0.1/dependencies"
+ (open-input-string test-intermediate-c-dependencies))
("https://crates.io/api/v1/crates/leaf-alice"
(open-input-string test-leaf-alice-crate))
("https://crates.io/api/v1/crates/leaf-alice/0.7.5/download"
(set! test-source-hash
(bytevector->nix-base32-string
- (sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
(open-input-string "empty file\n"))
("https://crates.io/api/v1/crates/leaf-alice/0.7.5/dependencies"
(open-input-string test-leaf-alice-dependencies))
@@ -444,7 +566,7 @@
("https://crates.io/api/v1/crates/leaf-bob/3.0.1/download"
(set! test-source-hash
(bytevector->nix-base32-string
- (sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
(open-input-string "empty file\n"))
("https://crates.io/api/v1/crates/leaf-bob/3.0.1/dependencies"
(open-input-string test-leaf-bob-dependencies))
@@ -452,7 +574,27 @@
(match (crate-recursive-import "root")
;; rust-intermediate-b has no dependency on the rust-leaf-alice
;; package, so this is a valid ordering
- (((define-public 'rust-leaf-alice-0.7
+ (((define-public 'rust-intermediate-c-1
+ (package
+ (name "rust-intermediate-c")
+ (version "1.0.1")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (crate-uri "intermediate-c" version))
+ (file-name
+ (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ (? string? hash)))))
+ (build-system cargo-build-system)
+ (arguments
+ ('quasiquote (#:skip-build? #t)))
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license (list license:expat license:asl2.0))))
+ (define-public 'rust-leaf-alice-0.7
(package
(name "rust-leaf-alice")
(version "0.7.5")
@@ -563,10 +705,157 @@
("rust-leaf-alice"
('unquote 'rust-leaf-alice-0.7))
("rust-leaf-bob"
+ ('unquote rust-leaf-bob-3)))
+ #:cargo-development-inputs
+ (("rust-intermediate-c"
+ ('unquote rust-intermediate-c-1))))))
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license (list license:expat license:asl2.0)))))
+ #t)
+ (x
+ (pk 'fail x #f)))
+ (match (crate-recursive-import "root"
+ #:recursive-dev-dependencies? #t)
+ ;; rust-intermediate-b has no dependency on the rust-leaf-alice
+ ;; package, so this is a valid ordering
+ (((define-public 'rust-intermediate-c-1
+ (package
+ (name "rust-intermediate-c")
+ (version "1.0.1")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (crate-uri "intermediate-c" version))
+ (file-name
+ (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ (? string? hash)))))
+ (build-system cargo-build-system)
+ (arguments
+ ('quasiquote (#:cargo-development-inputs
+ (("rust-leaf-alice"
+ ('unquote rust-leaf-alice-0.7))))))
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license (list license:expat license:asl2.0))))
+ (define-public 'rust-leaf-alice-0.7
+ (package
+ (name "rust-leaf-alice")
+ (version "0.7.5")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (crate-uri "leaf-alice" version))
+ (file-name
+ (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ (? string? hash)))))
+ (build-system cargo-build-system)
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license (list license:expat license:asl2.0))))
+ (define-public 'rust-leaf-bob-3
+ (package
+ (name "rust-leaf-bob")
+ (version "3.0.1")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (crate-uri "leaf-bob" version))
+ (file-name
+ (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ (? string? hash)))))
+ (build-system cargo-build-system)
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license (list license:expat license:asl2.0))))
+ (define-public 'rust-intermediate-b-1
+ (package
+ (name "rust-intermediate-b")
+ (version "1.2.3")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (crate-uri "intermediate-b" version))
+ (file-name
+ (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ (? string? hash)))))
+ (build-system cargo-build-system)
+ (arguments
+ ('quasiquote (#:cargo-inputs
+ (("rust-leaf-bob"
+ ('unquote rust-leaf-bob-3))))))
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license (list license:expat license:asl2.0))))
+ (define-public 'rust-intermediate-a-1
+ (package
+ (name "rust-intermediate-a")
+ (version "1.0.42")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (crate-uri "intermediate-a" version))
+ (file-name
+ (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ (? string? hash)))))
+ (build-system cargo-build-system)
+ (arguments
+ ('quasiquote (#:cargo-inputs
+ (("rust-intermediate-b"
+ ('unquote rust-intermediate-b-1))
+ ("rust-leaf-alice"
+ ('unquote 'rust-leaf-alice-0.7))
+ ("rust-leaf-bob"
('unquote rust-leaf-bob-3))))))
(home-page "http://example.com")
(synopsis "summary")
(description "summary")
+ (license (list license:expat license:asl2.0))))
+ (define-public 'rust-root-1
+ (package
+ (name "rust-root")
+ (version "1.0.4")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (crate-uri "root" version))
+ (file-name
+ (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ (? string? hash)))))
+ (build-system cargo-build-system)
+ (arguments
+ ('quasiquote (#:cargo-inputs
+ (("rust-intermediate-a"
+ ('unquote rust-intermediate-a-1))
+ ("rust-intermediate-b"
+ ('unquote rust-intermediate-b-1))
+ ("rust-leaf-alice"
+ ('unquote 'rust-leaf-alice-0.7))
+ ("rust-leaf-bob"
+ ('unquote rust-leaf-bob-3)))
+ #:cargo-development-inputs
+ (("rust-intermediate-c"
+ ('unquote rust-intermediate-c-1))))))
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
(license (list license:expat license:asl2.0)))))
#t)
(x
@@ -594,69 +883,209 @@
-(define test-doctool-crate
- "{
- \"crate\": {
- \"max_version\": \"2.2.2\",
- \"name\": \"leaf-bob\",
- \"description\": \"summary\",
- \"homepage\": \"http://example.com\",
- \"repository\": \"http://example.com\",
- \"keywords\": [\"dummy\", \"test\"],
- \"categories\": [\"test\"]
- \"actual_versions\": [
- { \"id\": 234280,
- \"num\": \"2.2.2\",
- \"license\": \"MIT OR Apache-2.0\",
- \"links\": {
- \"dependencies\": \"/api/v1/crates/doctool/2.2.2/dependencies\"
- },
- \"yanked\": false
- }
- ]
- }
-}")
+(define rust-leaf-bob-3
+ (package
+ (name "rust-leaf-bob")
+ (version "3.0.1")
+ (source #f)
+ (build-system #f)
+ (home-page #f)
+ (synopsis #f)
+ (description #f)
+ (license #f)))
-;; FIXME: This test depends on some existing packages
-(define test-doctool-dependencies
- "{
- \"dependencies\": [
- {
- \"crate_id\": \"docopt\",
- \"kind\": \"normal\",
- \"req\": \"^0.8.1\"
- }
- ]
-}")
+(define rust-leaf-bob-3.0.2-yanked
+ (package
+ (name "rust-leaf-bob")
+ (version "3.0.2")
+ (source #f)
+ (properties '((crate-version-yanked? . #t)))
+ (build-system #f)
+ (home-page #f)
+ (synopsis #f)
+ (description #f)
+ (license #f)))
-
-(test-assert "self-test: rust-docopt 0.8.x is gone, please adjust the test case"
- (not (null? (find-packages-by-name "rust-docopt" "0.8"))))
+(unless have-guile-semver? (test-skip 1))
+(test-assert "crate-recursive-import-honors-existing-packages"
+ (mock
+ ((gnu packages) find-packages-by-name
+ (lambda* (name #:optional version)
+ (match name
+ ("rust-leaf-bob"
+ (list rust-leaf-bob-3 rust-leaf-bob-3.0.2-yanked))
+ (_ '()))))
+ (mock
+ ((guix http-client) http-fetch
+ (lambda (url . rest)
+ (match url
+ ("https://crates.io/api/v1/crates/bar"
+ (open-input-string test-bar-crate))
+ ("https://crates.io/api/v1/crates/bar/1.0.0/download"
+ (set! test-source-hash
+ (bytevector->nix-base32-string
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (open-input-string "empty file\n"))
+ ("https://crates.io/api/v1/crates/bar/1.0.0/dependencies"
+ (open-input-string test-bar-dependencies))
+ ("https://crates.io/api/v1/crates/leaf-bob"
+ (open-input-string test-leaf-bob-crate))
+ ("https://crates.io/api/v1/crates/leaf-bob/3.0.2/download"
+ (set! test-source-hash
+ (bytevector->nix-base32-string
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (open-input-string "empty file\n"))
+ ("https://crates.io/api/v1/crates/leaf-bob/3.0.2/dependencies"
+ (open-input-string test-leaf-bob-dependencies))
+ ("https://crates.io/api/v1/crates/leaf-bob/4.0.0/download"
+ (set! test-source-hash
+ (bytevector->nix-base32-string
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (open-input-string "empty file\n"))
+ ("https://crates.io/api/v1/crates/leaf-bob/4.0.0/dependencies"
+ (open-input-string test-leaf-bob-dependencies))
+ (_ (error "Unexpected URL: " url)))))
+ (match (crate-recursive-import "bar"
+ #:allow-yanked? #t)
+ (((define-public 'rust-bar-1
+ (package
+ (name "rust-bar")
+ (version "1.0.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (crate-uri "bar" version))
+ (file-name
+ (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ (? string? hash)))))
+ (build-system cargo-build-system)
+ (arguments
+ ('quasiquote (#:cargo-inputs
+ (("rust-leaf-bob"
+ ('unquote 'rust-leaf-bob-3)))
+ #:cargo-development-inputs
+ (("rust-leaf-bob"
+ ('unquote 'rust-leaf-bob-3.0.2-yanked))
+ ("rust-leaf-bob"
+ ('unquote 'rust-leaf-bob-4.0.0-yanked))))))
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license (list license:expat license:asl2.0)))))
+ #t)
+ (x
+ (pk 'fail x #f))))))
(unless have-guile-semver? (test-skip 1))
-(test-assert "cargo-recursive-import-hoors-existing-packages"
- (mock ((guix http-client) http-fetch
- (lambda (url . rest)
- (match url
- ("https://crates.io/api/v1/crates/doctool"
- (open-input-string test-doctool-crate))
- ("https://crates.io/api/v1/crates/doctool/2.2.2/download"
- (set! test-source-hash
- (bytevector->nix-base32-string
- (sha256 (string->bytevector "empty file\n" "utf-8"))))
- (open-input-string "empty file\n"))
- ("https://crates.io/api/v1/crates/doctool/2.2.2/dependencies"
- (open-input-string test-doctool-dependencies))
- (_ (error "Unexpected URL: " url)))))
- (match (crate-recursive-import "doctool")
- (((define-public 'rust-doctool-2
+(test-assert "crate-import-only-yanked-available"
+ (mock
+ ((guix http-client) http-fetch
+ (lambda (url . rest)
+ (match url
+ ("https://crates.io/api/v1/crates/bar"
+ (open-input-string test-bar-crate))
+ ("https://crates.io/api/v1/crates/bar/1.0.0/download"
+ (set! test-source-hash
+ (bytevector->nix-base32-string
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (open-input-string "empty file\n"))
+ ("https://crates.io/api/v1/crates/bar/1.0.0/dependencies"
+ (open-input-string test-bar-dependencies))
+ ("https://crates.io/api/v1/crates/leaf-bob"
+ (open-input-string test-leaf-bob-crate))
+ ("https://crates.io/api/v1/crates/leaf-bob/3.0.1/download"
+ (set! test-source-hash
+ (bytevector->nix-base32-string
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (open-input-string "empty file\n"))
+ ("https://crates.io/api/v1/crates/leaf-bob/3.0.1/dependencies"
+ (open-input-string test-leaf-bob-dependencies))
+ ("https://crates.io/api/v1/crates/leaf-bob/3.0.2/download"
+ (set! test-source-hash
+ (bytevector->nix-base32-string
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (open-input-string "empty file\n"))
+ ("https://crates.io/api/v1/crates/leaf-bob/3.0.2/dependencies"
+ (open-input-string test-leaf-bob-dependencies))
+ ("https://crates.io/api/v1/crates/leaf-bob/4.0.0/download"
+ (set! test-source-hash
+ (bytevector->nix-base32-string
+ (gcrypt-sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (open-input-string "empty file\n"))
+ ("https://crates.io/api/v1/crates/leaf-bob/4.0.0/dependencies"
+ (open-input-string test-leaf-bob-dependencies))
+ (_ (error "Unexpected URL: " url)))))
+ (match (crate-recursive-import "bar"
+ #:recursive-dev-dependencies? #t
+ #:allow-yanked? #t)
+ (((define-public 'rust-leaf-bob-4.0.0-yanked
+ (package
+ (name "rust-leaf-bob")
+ (version "4.0.0")
+ ($ <comment> "; This version was yanked!\n" #t)
+ (source
+ (origin
+ (method url-fetch)
+ (uri (crate-uri "leaf-bob" version))
+ (file-name
+ (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ (? string? hash)))))
+ (properties ('quote (('crate-version-yanked? . #t))))
+ (build-system cargo-build-system)
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license (list license:expat license:asl2.0))))
+ (define-public 'rust-leaf-bob-3.0.2-yanked
(package
- (name "rust-doctool")
- (version "2.2.2")
+ (name "rust-leaf-bob")
+ (version "3.0.2")
+ ($ <comment> "; This version was yanked!\n" #t)
+ (source
+ (origin
+ (method url-fetch)
+ (uri (crate-uri "leaf-bob" version))
+ (file-name
+ (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ (? string? hash)))))
+ (properties ('quote (('crate-version-yanked? . #t))))
+ (build-system cargo-build-system)
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license (list license:expat license:asl2.0))))
+ (define-public 'rust-leaf-bob-3
+ (package
+ (name "rust-leaf-bob")
+ (version "3.0.1")
(source
(origin
(method url-fetch)
- (uri (crate-uri "doctool" version))
+ (uri (crate-uri "leaf-bob" version))
+ (file-name
+ (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ (? string? hash)))))
+ (build-system cargo-build-system)
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license (list license:expat license:asl2.0))))
+ (define-public 'rust-bar-1
+ (package
+ (name "rust-bar")
+ (version "1.0.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (crate-uri "bar" version))
(file-name
(string-append name "-" version ".tar.gz"))
(sha256
@@ -665,14 +1094,19 @@
(build-system cargo-build-system)
(arguments
('quasiquote (#:cargo-inputs
- (("rust-docopt"
- ('unquote 'rust-docopt-0.8))))))
+ (("rust-leaf-bob"
+ ('unquote 'rust-leaf-bob-3)))
+ #:cargo-development-inputs
+ (("rust-leaf-bob"
+ ('unquote 'rust-leaf-bob-3.0.2-yanked))
+ ("rust-leaf-bob"
+ ('unquote 'rust-leaf-bob-4.0.0-yanked))))))
(home-page "http://example.com")
(synopsis "summary")
(description "summary")
(license (list license:expat license:asl2.0)))))
#t)
(x
- (pk 'fail x #f)))))
+ (pk 'fail (pretty-print-with-comments (current-output-port) x) #f)))))
(test-end "crate")
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/guix-time-machine.sh b/tests/guix-time-machine.sh
index 983f796225..df75c681da 100644
--- a/tests/guix-time-machine.sh
+++ b/tests/guix-time-machine.sh
@@ -1,6 +1,6 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
-# Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2023-2024 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@@ -39,7 +39,7 @@ else
EXTRA_OPTIONS=""
fi
-# Visiting a commit older than v1.0.0 must fail (this test is expensive
+# Visiting a commit older than v0.16.0 must fail (this test is expensive
# because it clones the whole repository).
guix time-machine -q --commit=v0.15.0 $EXTRA_OPTIONS -- describe && false
diff --git a/tests/lint.scm b/tests/lint.scm
index a52a82237b..95d82d7490 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,28 @@
\"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)))
+ (check-archival (dummy-package "x" (source origin)))))))
+ (warning-contains? "scheduled" warnings)))
+
+(test-assert "archival: missing svn revision"
+ (let* ((origin (origin
+ (method svn-fetch)
+ (uri (svn-reference
+ (url "http://example.org/svn/foo")
+ (revision "1234")))
+ (sha256 (make-bytevector 32))))
+ ;; https://archive.softwareheritage.org/api/1/origin/save/
+ (save "{ \"origin_url\": \"http://example.org/svn/foo\",
+ \"save_request_date\": \"2014-11-17T22:09:38+01:00\",
+ \"save_request_status\": \"accepted\",
+ \"save_task_status\": \"scheduled\" }")
+ (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 +1438,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/pack.scm b/tests/pack.scm
index ac78817a70..55445ea1e9 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2017-2021, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,6 +30,7 @@
#:use-module (guix gexp)
#:use-module (guix modules)
#:use-module (guix utils)
+ #:use-module ((guix build utils) #:select (%store-directory))
#:use-module (gnu packages)
#:use-module ((gnu packages base) #:select (libc-utf8-locales-for-target))
#:use-module (gnu packages bootstrap)
@@ -251,6 +253,54 @@
(built-derivations (list check))))
(unless store (test-skip 1))
+ (test-assertm "docker-layered-image + localstatedir"
+ (mlet* %store-monad
+ ((guile (set-guile-for-build (default-guile)))
+ (profile -> (profile
+ (content (packages->manifest (list %bootstrap-guile)))
+ (hooks '())
+ (locales? #f)))
+ (tarball (docker-image "docker-pack" profile
+ #:symlinks '(("/bin/Guile" -> "bin/guile"))
+ #:localstatedir? #t
+ #:max-layers 100))
+ (check (gexp->derivation
+ "check-tarball"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match))
+
+ (define bin
+ (string-append "." #$profile "/bin"))
+
+ (define store
+ (string-append "." #$(%store-directory)))
+
+ (setenv "PATH" (string-append #$%tar-bootstrap "/bin"))
+ (mkdir "base")
+ (with-directory-excursion "base"
+ (invoke "tar" "xvf" #$tarball))
+
+ (match (find-files "base" "layer.tar")
+ ((layers ...)
+ (for-each (lambda (layer)
+ (invoke "tar" "xvf" layer)
+ (invoke "chmod" "--recursive" "u+w" store))
+ layers)))
+
+ (when
+ (and (file-exists? (string-append bin "/guile"))
+ (file-exists? "var/guix/db/db.sqlite")
+ (file-is-directory? "tmp")
+ (string=? (string-append #$%bootstrap-guile "/bin")
+ (readlink bin))
+ (string=? (string-append #$profile "/bin/guile")
+ (readlink "bin/Guile")))
+ (mkdir #$output)))))))
+ (built-derivations (list check))))
+
+ (unless store (test-skip 1))
(test-assertm "squashfs-image + localstatedir"
(mlet* %store-monad
((guile (set-guile-for-build (default-guile)))
diff --git a/tests/swh.scm b/tests/swh.scm
index a36f951241..11dcbdddd8 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,88 @@
(directory-entry-length entry)))
(lookup-directory "123"))))
+(test-equal "lookup-origin-revision"
+ '("cd86c72084993d9ef26fc9e24b73cea612b8c97b"
+ "d173c707ee88e3c89401ad77fafa65fcd9e9f5be")
+ (let ()
+ ;; Make sure that 'lookup-origin-revision' does the job, and in particular
+ ;; that it doesn't stop until it has found an actual revision:
+ ;; 'git-checkout visits point to directories instead of revisions.
+ ;; See <https://issues.guix.gnu.org/69070>.
+ (define visits
+ ;; Two visits of differing types: the first visit (type 'git-checkout')
+ ;; points to a directory, the second one (type 'git') points to a
+ ;; revision.
+ "[ {
+ \"origin\": \"https://example.org/repo.git\",
+ \"visit\": 1,
+ \"type\": \"git-checkout\",
+ \"date\": \"2020-05-17T21:43:45.422977+00:00\",
+ \"status\": \"full\",
+ \"metadata\": {},
+ \"type\": \"git-checkout\",
+ \"origin_visit_url\": \"/visit/42\",
+ \"snapshot_url\": \"/snapshot/1\"
+ }, {
+ \"origin\": \"https://example.org/repo.git\",
+ \"visit\": 2,
+ \"type\": \"git\",
+ \"date\": \"2020-05-17T21:43:49.422977+00:00\",
+ \"status\": \"full\",
+ \"metadata\": {},
+ \"type\": \"git\",
+ \"origin_visit_url\": \"/visit/41\",
+ \"snapshot_url\": \"/snapshot/2\"
+ } ]")
+ (define snapshot-for-git-checkout
+ "{ \"id\": 42,
+ \"branches\": { \"1.3.2\": {
+ \"target\": \"e4a4be18fae8d9c6528abff3bc9088feb19a76c7\",
+ \"target_type\": \"directory\",
+ \"target_url\": \"/directory/e4a4be18fae8d9c6528abff3bc9088feb19a76c7\"
+ }}
+ }")
+ (define snapshot-for-git
+ "{ \"id\": 42,
+ \"branches\": { \"1.3.2\": {
+ \"target\": \"e4a4be18fae8d9c6528abff3bc9088feb19a76c7\",
+ \"target_type\": \"revision\",
+ \"target_url\": \"/revision/e4a4be18fae8d9c6528abff3bc9088feb19a76c7\"
+ }}
+ }")
+ (define revision
+ "{ \"author\": {},
+ \"committer\": {},
+ \"committer_date\": \"2018-05-17T21:43:49.422977+00:00\",
+ \"date\": \"2018-05-17T21:43:49.422977+00:00\",
+ \"directory\": \"d173c707ee88e3c89401ad77fafa65fcd9e9f5be\",
+ \"directory_url\": \"/directory/d173c707ee88e3c89401ad77fafa65fcd9e9f5be\",
+ \"id\": \"cd86c72084993d9ef26fc9e24b73cea612b8c97b\",
+ \"merge\": false,
+ \"message\": \"Fix.\",
+ \"parents\": [],
+ \"type\": \"what type?\"
+ }")
+
+ (with-http-server `((200 ,%origin)
+ (200 ,visits)
+ (200 ,snapshot-for-git-checkout)
+ (200 ,snapshot-for-git)
+ (200 ,revision))
+ (parameterize ((%swh-base-url (%local-url)))
+ (let ((revision (lookup-origin-revision "https://example.org/repo.git"
+ "1.3.2")))
+ (list (revision-id revision)
+ (revision-directory revision)))))))
+
+(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
generated by cgit v1.2.3 (git 2.50.1) at 2025-08-14 16:22:00 +0000