summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/crate.scm357
-rw-r--r--tests/derivations.scm18
-rw-r--r--tests/gem.scm25
-rw-r--r--tests/guix-lint.sh11
-rw-r--r--tests/import-utils.scm23
-rw-r--r--tests/processes.scm40
6 files changed, 453 insertions, 21 deletions
diff --git a/tests/crate.scm b/tests/crate.scm
index c14862ad9f..61933a8de8 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -28,7 +28,7 @@
#:use-module (ice-9 match)
#:use-module (srfi srfi-64))
-(define test-crate
+(define test-foo-crate
"{
\"crate\": {
\"max_version\": \"1.0.0\",
@@ -50,7 +50,7 @@
}
}")
-(define test-dependencies
+(define test-foo-dependencies
"{
\"dependencies\": [
{
@@ -60,9 +60,182 @@
]
}")
+(define test-root-crate
+ "{
+ \"crate\": {
+ \"max_version\": \"1.0.0\",
+ \"name\": \"root\",
+ \"description\": \"summary\",
+ \"homepage\": \"http://example.com\",
+ \"repository\": \"http://example.com\",
+ \"keywords\": [\"dummy\" \"test\"],
+ \"categories\": [\"test\"]
+ \"actual_versions\": [
+ { \"id\": \"foo\",
+ \"num\": \"1.0.0\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/root/1.0.0/dependencies\"
+ }
+ }
+ ]
+ }
+}")
+
+(define test-root-dependencies
+ "{
+ \"dependencies\": [
+ {
+ \"crate_id\": \"intermediate-1\",
+ \"kind\": \"normal\",
+ },
+ {
+ \"crate_id\": \"intermediate-2\",
+ \"kind\": \"normal\",
+ }
+ {
+ \"crate_id\": \"leaf-alice\",
+ \"kind\": \"normal\",
+ },
+ {
+ \"crate_id\": \"leaf-bob\",
+ \"kind\": \"normal\",
+ },
+ ]
+}")
+
+(define test-intermediate-1-crate
+ "{
+ \"crate\": {
+ \"max_version\": \"1.0.0\",
+ \"name\": \"intermediate-1\",
+ \"description\": \"summary\",
+ \"homepage\": \"http://example.com\",
+ \"repository\": \"http://example.com\",
+ \"keywords\": [\"dummy\" \"test\"],
+ \"categories\": [\"test\"]
+ \"actual_versions\": [
+ { \"id\": \"intermediate-1\",
+ \"num\": \"1.0.0\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/intermediate-1/1.0.0/dependencies\"
+ }
+ }
+ ]
+ }
+}")
+
+(define test-intermediate-1-dependencies
+ "{
+ \"dependencies\": [
+ {
+ \"crate_id\": \"intermediate-2\",
+ \"kind\": \"normal\",
+ },
+ {
+ \"crate_id\": \"leaf-alice\",
+ \"kind\": \"normal\",
+ },
+ {
+ \"crate_id\": \"leaf-bob\",
+ \"kind\": \"normal\",
+ }
+ ]
+}")
+
+(define test-intermediate-2-crate
+ "{
+ \"crate\": {
+ \"max_version\": \"1.0.0\",
+ \"name\": \"intermediate-2\",
+ \"description\": \"summary\",
+ \"homepage\": \"http://example.com\",
+ \"repository\": \"http://example.com\",
+ \"keywords\": [\"dummy\" \"test\"],
+ \"categories\": [\"test\"]
+ \"actual_versions\": [
+ { \"id\": \"intermediate-2\",
+ \"num\": \"1.0.0\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/intermediate-2/1.0.0/dependencies\"
+ }
+ }
+ ]
+ }
+}")
+
+(define test-intermediate-2-dependencies
+ "{
+ \"dependencies\": [
+ {
+ \"crate_id\": \"leaf-bob\",
+ \"kind\": \"normal\",
+ },
+ ]
+}")
+
+(define test-leaf-alice-crate
+ "{
+ \"crate\": {
+ \"max_version\": \"1.0.0\",
+ \"name\": \"leaf-alice\",
+ \"description\": \"summary\",
+ \"homepage\": \"http://example.com\",
+ \"repository\": \"http://example.com\",
+ \"keywords\": [\"dummy\" \"test\"],
+ \"categories\": [\"test\"]
+ \"actual_versions\": [
+ { \"id\": \"leaf-alice\",
+ \"num\": \"1.0.0\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/leaf-alice/1.0.0/dependencies\"
+ }
+ }
+ ]
+ }
+}")
+
+(define test-leaf-alice-dependencies
+ "{
+ \"dependencies\": []
+}")
+
+(define test-leaf-bob-crate
+ "{
+ \"crate\": {
+ \"max_version\": \"1.0.0\",
+ \"name\": \"leaf-bob\",
+ \"description\": \"summary\",
+ \"homepage\": \"http://example.com\",
+ \"repository\": \"http://example.com\",
+ \"keywords\": [\"dummy\" \"test\"],
+ \"categories\": [\"test\"]
+ \"actual_versions\": [
+ { \"id\": \"leaf-bob\",
+ \"num\": \"1.0.0\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/leaf-bob/1.0.0/dependencies\"
+ }
+ }
+ ]
+ }
+}")
+
+(define test-leaf-bob-dependencies
+ "{
+ \"dependencies\": []
+}")
+
(define test-source-hash
"")
+(define string->license
+ (@@ (guix import crate) string->license))
+
(test-begin "crate")
(test-equal "guix-package->crate-name"
@@ -79,14 +252,14 @@
(lambda (url . rest)
(match url
("https://crates.io/api/v1/crates/foo"
- (open-input-string test-crate))
+ (open-input-string test-foo-crate))
("https://crates.io/api/v1/crates/foo/1.0.0/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/foo/1.0.0/dependencies"
- (open-input-string test-dependencies))
+ (open-input-string test-foo-dependencies))
(_ (error "Unexpected URL: " url)))))
(match (crate->guix-package "foo")
(('package
@@ -111,4 +284,180 @@
(x
(pk 'fail x #f)))))
+(test-assert "cargo-recursive-import"
+ ;; Replace network resources with sample data.
+ (mock ((guix http-client) http-fetch
+ (lambda (url . rest)
+ (match url
+ ("https://crates.io/api/v1/crates/root"
+ (open-input-string test-root-crate))
+ ("https://crates.io/api/v1/crates/root/1.0.0/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/root/1.0.0/dependencies"
+ (open-input-string test-root-dependencies))
+ ("https://crates.io/api/v1/crates/intermediate-1"
+ (open-input-string test-intermediate-1-crate))
+ ("https://crates.io/api/v1/crates/intermediate-1/1.0.0/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/intermediate-1/1.0.0/dependencies"
+ (open-input-string test-intermediate-1-dependencies))
+ ("https://crates.io/api/v1/crates/intermediate-2"
+ (open-input-string test-intermediate-2-crate))
+ ("https://crates.io/api/v1/crates/intermediate-2/1.0.0/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/intermediate-2/1.0.0/dependencies"
+ (open-input-string test-intermediate-2-dependencies))
+ ("https://crates.io/api/v1/crates/leaf-alice"
+ (open-input-string test-leaf-alice-crate))
+ ("https://crates.io/api/v1/crates/leaf-alice/1.0.0/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/leaf-alice/1.0.0/dependencies"
+ (open-input-string test-leaf-alice-dependencies))
+ ("https://crates.io/api/v1/crates/leaf-bob"
+ (open-input-string test-leaf-bob-crate))
+ ("https://crates.io/api/v1/crates/leaf-bob/1.0.0/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/leaf-bob/1.0.0/dependencies"
+ (open-input-string test-leaf-bob-dependencies))
+ (_ (error "Unexpected URL: " url)))))
+ (match (crate-recursive-import "root")
+ ;; rust-intermediate-2 has no dependency on the rust-leaf-alice package, so this is a valid ordering
+ ((('package
+ ('name "rust-leaf-alice")
+ ('version (? string? ver))
+ ('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)))
+ ('package
+ ('name "rust-leaf-bob")
+ ('version (? string? ver))
+ ('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)))
+ ('package
+ ('name "rust-intermediate-2")
+ ('version (? string? ver))
+ ('source
+ ('origin
+ ('method 'url-fetch)
+ ('uri ('crate-uri "intermediate-2" '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))))))
+ ('home-page "http://example.com")
+ ('synopsis "summary")
+ ('description "summary")
+ ('license ('list 'license:expat 'license:asl2.0)))
+ ('package
+ ('name "rust-intermediate-1")
+ ('version (? string? ver))
+ ('source
+ ('origin
+ ('method 'url-fetch)
+ ('uri ('crate-uri "intermediate-1" 'version))
+ ('file-name
+ ('string-append 'name "-" 'version ".tar.gz"))
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('build-system 'cargo-build-system)
+ ('arguments
+ ('quasiquote
+ ('#:cargo-inputs (("rust-intermediate-2" ('unquote rust-intermediate-2))
+ ("rust-leaf-alice" ('unquote rust-leaf-alice))
+ ("rust-leaf-bob" ('unquote rust-leaf-bob))))))
+ ('home-page "http://example.com")
+ ('synopsis "summary")
+ ('description "summary")
+ ('license ('list 'license:expat 'license:asl2.0)))
+ ('package
+ ('name "rust-root")
+ ('version (? string? ver))
+ ('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-1" ('unquote rust-intermediate-1))
+ ("rust-intermediate-2" ('unquote rust-intermediate-2))
+ ("rust-leaf-alice" ('unquote rust-leaf-alice))
+ ("rust-leaf-bob" ('unquote rust-leaf-bob))))))
+ ('home-page "http://example.com")
+ ('synopsis "summary")
+ ('description "summary")
+ ('license ('list 'license:expat 'license:asl2.0))))
+ #t)
+ (x
+ (pk 'fail x #f)))))
+
+(test-equal "licenses: MIT OR Apache-2.0"
+ '(license:expat license:asl2.0)
+ (string->license "MIT OR Apache-2.0"))
+
+(test-equal "licenses: Apache-2.0 / MIT"
+ '(license:asl2.0 license:expat)
+ (string->license "Apache-2.0 / MIT"))
+
+(test-equal "licenses: Apache-2.0 WITH LLVM-exception"
+ '(license:asl2.0 unknown-license!)
+ (string->license "Apache-2.0 WITH LLVM-exception"))
+
+(test-equal "licenses: MIT/Apache-2.0 AND BSD-2-Clause"
+ '(license:expat license:asl2.0 unknown-license!)
+ (string->license "MIT/Apache-2.0 AND BSD-2-Clause"))
+
+(test-equal "licenses: MIT/Apache-2.0"
+ '(license:expat license:asl2.0)
+ (string->license "MIT/Apache-2.0"))
+
(test-end "crate")
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 6a7fad85b5..ef6cec6c76 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -978,6 +978,24 @@
#:mode (build-mode check))
(list drv dep))))))
+(test-assert "derivation-input-fold"
+ (let* ((builder (add-text-to-store %store "my-builder.sh"
+ "echo hello, world > \"$out\"\n"
+ '()))
+ (drv1 (derivation %store "foo"
+ %bash `(,builder)
+ #:sources `(,%bash ,builder)))
+ (drv2 (derivation %store "bar"
+ %bash `(,builder)
+ #:inputs `((,drv1))
+ #:sources `(,%bash ,builder))))
+ (equal? (derivation-input-fold (lambda (input result)
+ (cons (derivation-input-derivation input)
+ result))
+ '()
+ (list (derivation-input drv2)))
+ (list drv1 drv2))))
+
(test-assert "substitution-oracle and #:substitute? #f"
(with-store store
(let* ((dep (build-expression->derivation store "dep"
diff --git a/tests/gem.scm b/tests/gem.scm
index a12edb294c..5158238d18 100644
--- a/tests/gem.scm
+++ b/tests/gem.scm
@@ -24,7 +24,6 @@
#:use-module (gcrypt hash)
#:use-module (guix tests)
#:use-module ((guix build utils) #:select (delete-file-recursively))
- #:use-module (srfi srfi-41)
#:use-module (srfi srfi-64)
#:use-module (ice-9 match))
@@ -121,24 +120,23 @@
(values (open-input-string test-bundler-json)
(string-length test-bundler-json)))
(_ (error "Unexpected URL: " url)))))
- (match (stream->list (gem-recursive-import "foo"))
+ (match (gem-recursive-import "foo")
((('package
- ('name "ruby-foo")
+ ('name "ruby-bar")
('version "1.0.0")
('source
('origin
('method 'url-fetch)
- ('uri ('rubygems-uri "foo" 'version))
+ ('uri ('rubygems-uri "bar" 'version))
('sha256
('base32
"1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
('build-system 'ruby-build-system)
('propagated-inputs
('quasiquote
- (("bundler" ('unquote 'bundler))
- ("ruby-bar" ('unquote 'ruby-bar)))))
- ('synopsis "A cool gem")
- ('description "This package provides a cool gem")
+ (('"bundler" ('unquote 'bundler)))))
+ ('synopsis "Another cool gem")
+ ('description "Another cool gem")
('home-page "https://example.com")
('license ('list 'license:expat 'license:asl2.0)))
('package
@@ -157,21 +155,22 @@
('home-page "https://bundler.io/")
('license 'license:expat))
('package
- ('name "ruby-bar")
+ ('name "ruby-foo")
('version "1.0.0")
('source
('origin
('method 'url-fetch)
- ('uri ('rubygems-uri "bar" 'version))
+ ('uri ('rubygems-uri "foo" 'version))
('sha256
('base32
"1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
('build-system 'ruby-build-system)
('propagated-inputs
('quasiquote
- (('"bundler" ('unquote 'bundler)))))
- ('synopsis "Another cool gem")
- ('description "Another cool gem")
+ (("bundler" ('unquote 'bundler))
+ ("ruby-bar" ('unquote 'ruby-bar)))))
+ ('synopsis "A cool gem")
+ ('description "This package provides a cool gem")
('home-page "https://example.com")
('license ('list 'license:expat 'license:asl2.0))))
#t)
diff --git a/tests/guix-lint.sh b/tests/guix-lint.sh
index 7ddc7c265b..f0df1fda3a 100644
--- a/tests/guix-lint.sh
+++ b/tests/guix-lint.sh
@@ -76,3 +76,14 @@ then true; else false; fi
# Make sure specifying multiple packages works.
guix lint -c inputs-should-be-native dummy dummy@42 dummy
+
+
+# Use --load-path instead.
+unset GUIX_PACKAGE_PATH
+
+out=`guix lint -L $module_dir -c synopsis,description dummy 2>&1`
+if [ `grep_warning "$out"` -ne 3 ]
+then false; else true; fi
+
+# Make sure specifying multiple packages works.
+guix lint -L $module_dir -c inputs-should-be-native dummy dummy@42 dummy
diff --git a/tests/import-utils.scm b/tests/import-utils.scm
index c3ab25d788..87dda3238f 100644
--- a/tests/import-utils.scm
+++ b/tests/import-utils.scm
@@ -24,7 +24,8 @@
#:use-module (guix packages)
#:use-module (guix build-system)
#:use-module (gnu packages)
- #:use-module (srfi srfi-64))
+ #:use-module (srfi srfi-64)
+ #:use-module (ice-9 match))
(test-begin "import-utils")
@@ -41,6 +42,26 @@
'license:lgpl2.0
(license->symbol license:lgpl2.0))
+(test-equal "recursive-import"
+ '((package ;package expressions in topological order
+ (name "bar"))
+ (package
+ (name "foo")
+ (inputs `(("bar" ,bar)))))
+ (recursive-import "foo" 'repo
+ #:repo->guix-package
+ (match-lambda*
+ (("foo" 'repo)
+ (values '(package
+ (name "foo")
+ (inputs `(("bar" ,bar))))
+ '("bar")))
+ (("bar" 'repo)
+ (values '(package
+ (name "bar"))
+ '())))
+ #:guix-name identity))
+
(test-assert "alist->package with simple source"
(let* ((meta '(("name" . "hello")
("version" . "2.10")
diff --git a/tests/processes.scm b/tests/processes.scm
index 40454bcbc7..ba518f2d9e 100644
--- a/tests/processes.scm
+++ b/tests/processes.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -32,15 +33,48 @@
#:use-module (ice-9 match)
#:use-module (ice-9 threads))
+;; When using --system argument, binfmt-misc mechanism may be used. In that
+;; case, (guix script processes) won't work because:
+;;
+;; * ARGV0 is qemu-user and not guix-daemon.
+;; * Guix-daemon won't be able to stuff client PID in ARGV1 of forked
+;; processes.
+;;
+;; See: https://lists.gnu.org/archive/html/bug-guix/2019-12/msg00017.html.
+;;
+;; If we detect that we are running with binfmt emulation, all the following
+;; tests must be skipped.
+
+(define (binfmt-misc?)
+ (let ((pid (getpid))
+ (cmdline (call-with-input-file "/proc/self/cmdline" get-string-all)))
+ (match (primitive-fork)
+ (0 (dynamic-wind
+ (const #t)
+ (lambda ()
+ (exit
+ (not (equal?
+ (call-with-input-file (format #f "/proc/~a/cmdline" pid)
+ get-string-all)
+ cmdline))))
+ (const #t)))
+ (x (zero? (cdr (waitpid x)))))))
+
+(define-syntax-rule (test-assert* description exp)
+ (begin
+ (when (binfmt-misc?)
+ (test-skip 1))
+ (test-assert description exp)))
+
(test-begin "processes")
-(test-assert "not a client"
+(test-assert* "not a client"
(not (find (lambda (session)
(= (getpid)
(process-id (daemon-session-client session))))
(daemon-sessions))))
-(test-assert "client"
+(test-assert* "client"
(with-store store
(let* ((session (find (lambda (session)
(= (getpid)
@@ -50,7 +84,7 @@
(and (kill (process-id daemon) 0)
(string-suffix? "guix-daemon" (first (process-command daemon)))))))
-(test-assert "client + lock"
+(test-assert* "client + lock"
(with-store store
(call-with-temporary-directory
(lambda (directory)
generated by cgit v1.2.3 (git 2.45.2) at 2024-09-11 08:19:26 +0000