aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/boot-parameters.scm30
-rw-r--r--tests/crate.scm589
-rw-r--r--tests/cve-sample.json2
-rw-r--r--tests/elpa.scm3
-rw-r--r--tests/gexp.scm20
-rw-r--r--tests/glob.scm8
-rw-r--r--tests/guix-archive.sh4
-rw-r--r--tests/guix-hash.sh3
-rw-r--r--tests/guix-pack-relocatable.sh2
-rw-r--r--tests/import-utils.scm40
-rw-r--r--tests/lint.scm33
-rw-r--r--tests/nar.scm21
-rw-r--r--tests/opam.scm67
-rw-r--r--tests/profiles.scm38
-rw-r--r--tests/store-database.scm18
-rw-r--r--tests/store-deduplication.scm20
-rw-r--r--tests/store.scm82
-rw-r--r--tests/substitute.scm154
-rw-r--r--tests/swh.scm2
-rw-r--r--tests/transformations.scm31
20 files changed, 862 insertions, 305 deletions
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index a00b227551..3deae564c4 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -50,6 +50,9 @@
(define %default-store-directory-prefix
(string-append "/" %default-btrfs-subvolume))
(define %default-store-mount-point (%store-prefix))
+(define %default-store-crypto-devices
+ (list (uuid "00000000-1111-2222-3333-444444444444")
+ (uuid "55555555-6666-7777-8888-999999999999")))
(define %default-multiboot-modules '())
(define %default-locale "es_ES.utf8")
(define %root-path "/")
@@ -67,6 +70,7 @@
(locale %default-locale)
(store-device %default-store-device)
(store-directory-prefix %default-store-directory-prefix)
+ (store-crypto-devices %default-store-crypto-devices)
(store-mount-point %default-store-mount-point)))
(define %default-operating-system
@@ -110,6 +114,8 @@
(with-store #t)
(store-device
(quote-uuid %default-store-device))
+ (store-crypto-devices
+ (map quote-uuid %default-store-crypto-devices))
(store-directory-prefix %default-store-directory-prefix)
(store-mount-point %default-store-mount-point))
(define (generate-boot-parameters)
@@ -125,12 +131,14 @@
(sexp-or-nothing " (kernel-arguments ~S)" kernel-arguments)
(sexp-or-nothing " (initrd ~S)" initrd)
(if with-store
- (format #false " (store~a~a~a)"
+ (format #false " (store~a~a~a~a)"
(sexp-or-nothing " (device ~S)" store-device)
(sexp-or-nothing " (mount-point ~S)"
store-mount-point)
(sexp-or-nothing " (directory-prefix ~S)"
- store-directory-prefix))
+ store-directory-prefix)
+ (sexp-or-nothing " (crypto-devices ~S)"
+ store-crypto-devices))
"")
(sexp-or-nothing " (locale ~S)" locale)
(sexp-or-nothing " (bootloader-name ~a)" bootloader-name)
@@ -158,6 +166,7 @@
(test-read-boot-parameters #:with-store #false)
(test-read-boot-parameters #:store-device #false)
(test-read-boot-parameters #:store-device 'false)
+ (test-read-boot-parameters #:store-crypto-devices #false)
(test-read-boot-parameters #:store-mount-point #false)
(test-read-boot-parameters #:store-directory-prefix #false)
(test-read-boot-parameters #:multiboot-modules #false)
@@ -254,6 +263,23 @@
(boot-parameters-store-mount-point
(test-read-boot-parameters #:with-store #false)))
+(test-equal "read, store-crypto-devices, default"
+ '()
+ (boot-parameters-store-crypto-devices
+ (test-read-boot-parameters #:store-crypto-devices #false)))
+
+;; XXX: <warning: unrecognized crypto-devices #f at '#f'>
+(test-equal "read, store-crypto-devices, false"
+ '()
+ (boot-parameters-store-crypto-devices
+ (test-read-boot-parameters #:store-crypto-devices 'false)))
+
+;; XXX: <warning: unrecognized crypto-device "bad" at '#f'>
+(test-equal "read, store-crypto-devices, string"
+ '()
+ (boot-parameters-store-crypto-devices
+ (test-read-boot-parameters #:store-crypto-devices "bad")))
+
;; For whitebox testing
(define operating-system-boot-parameters
(@@ (gnu system) operating-system-boot-parameters))
diff --git a/tests/crate.scm b/tests/crate.scm
index 61a04f986b..bb7032c344 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,27 +25,72 @@
#:use-module (guix build-system cargo)
#:use-module (gcrypt hash)
#:use-module (guix tests)
+ #:use-module (gnu packages)
#:use-module (ice-9 iconv)
#:use-module (ice-9 match)
#:use-module (srfi srfi-64))
+
+;; crate versions and dependencies used here
+;; foo-0.8.1
+;; foo-1.0.0
+;; foo-1.0.3
+;; leaf-alice 0.7.5
+;;
+;; root-1.0.0
+;; root-1.0.4
+;; intermediate-a 1.0.42
+;; intermeidate-b ^1.0.0
+;; leaf-alice ^0.7
+;; leaf-bob ^3
+;;
+;; intermediate-a-1.0.40
+;; intermediate-a-1.0.42
+;; intermediate-a-1.1.0-alpha.1
+;; intermediate-a 1.2.3
+;; leaf-alice 0.7.5
+;; leaf-bob ^3
+;;
+;; intermediate-b-1.2.3
+;; leaf-bob 3.0.1
+;;
+;; leaf-alice-0.7.3
+;; leaf-alice-0.7.5
+;;
+;; leaf-bob-3.0.1
+
+
(define test-foo-crate
"{
\"crate\": {
- \"max_version\": \"1.0.0\",
+ \"max_version\": \"1.0.3\",
\"name\": \"foo\",
\"description\": \"summary\",
\"homepage\": \"http://example.com\",
\"repository\": \"http://example.com\",
- \"keywords\": [\"dummy\" \"test\"],
- \"categories\": [\"test\"]
+ \"keywords\": [\"dummy\", \"test\"],
+ \"categories\": [\"test\"],
\"actual_versions\": [
- { \"id\": \"foo\",
+ { \"id\": 234210,
+ \"num\": \"0.8.1\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/foo/0.8.1/dependencies\"
+ }
+ },
+ { \"id\": 234212,
\"num\": \"1.0.0\",
\"license\": \"MIT OR Apache-2.0\",
\"links\": {
\"dependencies\": \"/api/v1/crates/foo/1.0.0/dependencies\"
}
+ },
+ { \"id\": 234214,
+ \"num\": \"1.0.3\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/foo/1.0.3/dependencies\"
+ }
}
]
}
@@ -54,8 +100,9 @@
"{
\"dependencies\": [
{
- \"crate_id\": \"bar\",
- \"kind\": \"normal\"
+ \"crate_id\": \"leaf-alice\",
+ \"kind\": \"normal\",
+ \"req\": \"0.7.5\"
}
]
}")
@@ -63,20 +110,27 @@
(define test-root-crate
"{
\"crate\": {
- \"max_version\": \"1.0.0\",
+ \"max_version\": \"1.0.4\",
\"name\": \"root\",
\"description\": \"summary\",
\"homepage\": \"http://example.com\",
\"repository\": \"http://example.com\",
- \"keywords\": [\"dummy\" \"test\"],
- \"categories\": [\"test\"]
+ \"keywords\": [\"dummy\", \"test\"],
+ \"categories\": [\"test\"],
\"actual_versions\": [
- { \"id\": \"foo\",
+ { \"id\": 234240,
\"num\": \"1.0.0\",
\"license\": \"MIT OR Apache-2.0\",
\"links\": {
\"dependencies\": \"/api/v1/crates/root/1.0.0/dependencies\"
}
+ },
+ { \"id\": 234242,
+ \"num\": \"1.0.4\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/root/1.0.4/dependencies\"
+ }
}
]
}
@@ -86,92 +140,114 @@
"{
\"dependencies\": [
{
- \"crate_id\": \"intermediate-1\",
- \"kind\": \"normal\"
+ \"crate_id\": \"intermediate-a\",
+ \"kind\": \"normal\",
+ \"req\": \"1.0.42\"
},
{
- \"crate_id\": \"intermediate-2\",
- \"kind\": \"normal\"
+ \"crate_id\": \"intermediate-b\",
+ \"kind\": \"normal\",
+ \"req\": \"^1.0.0\"
}
{
\"crate_id\": \"leaf-alice\",
- \"kind\": \"normal\"
+ \"kind\": \"normal\",
+ \"req\": \"^0.7\"
},
{
\"crate_id\": \"leaf-bob\",
- \"kind\": \"normal\"
+ \"kind\": \"normal\",
+ \"req\": \"^3\"
}
]
}")
-(define test-intermediate-1-crate
+(define test-intermediate-a-crate
"{
\"crate\": {
- \"max_version\": \"1.0.0\",
- \"name\": \"intermediate-1\",
+ \"max_version\": \"1.1.0-alpha.1\",
+ \"name\": \"intermediate-a\",
\"description\": \"summary\",
\"homepage\": \"http://example.com\",
\"repository\": \"http://example.com\",
- \"keywords\": [\"dummy\" \"test\"],
- \"categories\": [\"test\"]
+ \"keywords\": [\"dummy\", \"test\"],
+ \"categories\": [\"test\"],
\"actual_versions\": [
- { \"id\": \"intermediate-1\",
- \"num\": \"1.0.0\",
+ { \"id\": 234251,
+ \"num\": \"1.0.40\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/intermediate-a/1.0.40/dependencies\"
+ }
+ },
+ { \"id\": 234250,
+ \"num\": \"1.0.42\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/intermediate-a/1.0.42/dependencies\"
+ }
+ },
+ { \"id\": 234252,
+ \"num\": \"1.1.0-alpha.1\",
\"license\": \"MIT OR Apache-2.0\",
\"links\": {
- \"dependencies\": \"/api/v1/crates/intermediate-1/1.0.0/dependencies\"
+ \"dependencies\": \"/api/v1/crates/intermediate-a/1.1.0-alpha.1/dependencies\"
}
}
]
}
}")
-(define test-intermediate-1-dependencies
+(define test-intermediate-a-dependencies
"{
\"dependencies\": [
{
- \"crate_id\": \"intermediate-2\",
- \"kind\": \"normal\"
+ \"crate_id\": \"intermediate-b\",
+ \"kind\": \"normal\",
+ \"req\": \"1.2.3\"
},
{
\"crate_id\": \"leaf-alice\",
- \"kind\": \"normal\"
+ \"kind\": \"normal\",
+ \"req\": \"0.7.5\"
},
{
\"crate_id\": \"leaf-bob\",
- \"kind\": \"normal\"
+ \"kind\": \"normal\",
+ \"req\": \"^3\"
}
]
}")
-(define test-intermediate-2-crate
+(define test-intermediate-b-crate
"{
\"crate\": {
- \"max_version\": \"1.0.0\",
- \"name\": \"intermediate-2\",
+ \"max_version\": \"1.2.3\",
+ \"name\": \"intermediate-b\",
\"description\": \"summary\",
\"homepage\": \"http://example.com\",
\"repository\": \"http://example.com\",
- \"keywords\": [\"dummy\" \"test\"],
- \"categories\": [\"test\"]
+ \"keywords\": [\"dummy\", \"test\"],
+ \"categories\": [\"test\"],
\"actual_versions\": [
- { \"id\": \"intermediate-2\",
- \"num\": \"1.0.0\",
+ { \"id\": 234260,
+ \"num\": \"1.2.3\",
\"license\": \"MIT OR Apache-2.0\",
\"links\": {
- \"dependencies\": \"/api/v1/crates/intermediate-2/1.0.0/dependencies\"
+ \"dependencies\": \"/api/v1/crates/intermediate-b/1.2.3/dependencies\"
}
}
]
}
}")
-(define test-intermediate-2-dependencies
+(define test-intermediate-b-dependencies
"{
\"dependencies\": [
{
\"crate_id\": \"leaf-bob\",
- \"kind\": \"normal\"
+ \"kind\": \"normal\",
+ \"req\": \"3.0.1\"
}
]
}")
@@ -179,19 +255,26 @@
(define test-leaf-alice-crate
"{
\"crate\": {
- \"max_version\": \"1.0.0\",
+ \"max_version\": \"0.7.5\",
\"name\": \"leaf-alice\",
\"description\": \"summary\",
\"homepage\": \"http://example.com\",
\"repository\": \"http://example.com\",
- \"keywords\": [\"dummy\" \"test\"],
- \"categories\": [\"test\"]
+ \"keywords\": [\"dummy\", \"test\"],
+ \"categories\": [\"test\"],
\"actual_versions\": [
- { \"id\": \"leaf-alice\",
- \"num\": \"1.0.0\",
+ { \"id\": 234270,
+ \"num\": \"0.7.3\",
\"license\": \"MIT OR Apache-2.0\",
\"links\": {
- \"dependencies\": \"/api/v1/crates/leaf-alice/1.0.0/dependencies\"
+ \"dependencies\": \"/api/v1/crates/leaf-alice/0.7.3/dependencies\"
+ }
+ },
+ { \"id\": 234272,
+ \"num\": \"0.7.5\",
+ \"license\": \"MIT OR Apache-2.0\",
+ \"links\": {
+ \"dependencies\": \"/api/v1/crates/leaf-alice/0.7.5/dependencies\"
}
}
]
@@ -206,19 +289,19 @@
(define test-leaf-bob-crate
"{
\"crate\": {
- \"max_version\": \"1.0.0\",
+ \"max_version\": \"3.0.1\",
\"name\": \"leaf-bob\",
\"description\": \"summary\",
\"homepage\": \"http://example.com\",
\"repository\": \"http://example.com\",
- \"keywords\": [\"dummy\" \"test\"],
+ \"keywords\": [\"dummy\", \"test\"],
\"categories\": [\"test\"]
\"actual_versions\": [
- { \"id\": \"leaf-bob\",
- \"num\": \"1.0.0\",
+ { \"id\": 234280,
+ \"num\": \"3.0.1\",
\"license\": \"MIT OR Apache-2.0\",
\"links\": {
- \"dependencies\": \"/api/v1/crates/leaf-bob/1.0.0/dependencies\"
+ \"dependencies\": \"/api/v1/crates/leaf-bob/3.0.1/dependencies\"
}
}
]
@@ -230,9 +313,13 @@
\"dependencies\": []
}")
+
(define test-source-hash
"")
+(define have-guile-semver?
+ (false-if-exception (resolve-interface '(semver))))
+
(test-begin "crate")
@@ -242,8 +329,9 @@
(dummy-package
"rust-rustc-serialize"
(source (dummy-origin
- (uri (crate-uri "rustc-serialize" "1.0")))))))
+ (uri (crate-uri "rustc-serialize" "1.0")))))))
+(unless have-guile-semver? (test-skip 1))
(test-assert "crate->guix-package"
;; Replace network resources with sample data.
(mock ((guix http-client) http-fetch
@@ -251,37 +339,52 @@
(match url
("https://crates.io/api/v1/crates/foo"
(open-input-string test-foo-crate))
- ("https://crates.io/api/v1/crates/foo/1.0.0/download"
+ ("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"))))
+ (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"
+ ("https://crates.io/api/v1/crates/foo/1.0.3/dependencies"
(open-input-string test-foo-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"))))
+ (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))
(_ (error "Unexpected URL: " url)))))
- (match (crate->guix-package "foo")
- (('package
- ('name "rust-foo")
- ('version "1.0.0")
- ('source ('origin
- ('method 'url-fetch)
- ('uri ('crate-uri "foo" 'version))
- ('file-name ('string-append 'name "-" 'version ".tar.gz"))
- ('sha256
- ('base32
- (? string? hash)))))
- ('build-system 'cargo-build-system)
- ('arguments
- ('quasiquote
- ('#:cargo-inputs (("rust-bar" ('unquote rust-bar))))))
- ('home-page "http://example.com")
- ('synopsis "summary")
- ('description "summary")
- ('license ('list 'license:expat 'license:asl2.0)))
- (string=? test-source-hash hash))
- (x
- (pk 'fail x #f)))))
+ (match (crate->guix-package "foo")
+ ((define-public 'rust-foo-1
+ (package (name "rust-foo")
+ (version "1.0.3")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (crate-uri "foo" 'version))
+ (file-name (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ (? string? hash)))))
+ (build-system 'cargo-build-system)
+ (arguments
+ ('quasiquote
+ (#:skip-build? #t
+ #:cargo-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))))
+
+ (string=? test-source-hash hash))
+ (x
+ (pk 'fail x #f)))))
+
+(unless have-guile-semver? (test-skip 1))
(test-assert "cargo-recursive-import"
;; Replace network resources with sample data.
(mock ((guix http-client) http-fetch
@@ -289,151 +392,169 @@
(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"
+ ("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"))))
(open-input-string "empty file\n"))
- ("https://crates.io/api/v1/crates/root/1.0.0/dependencies"
+ ("https://crates.io/api/v1/crates/root/1.0.4/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"
+ ("https://crates.io/api/v1/crates/intermediate-a"
+ (open-input-string test-intermediate-a-crate))
+ ("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"))))
(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"
+ ("https://crates.io/api/v1/crates/intermediate-a/1.0.42/dependencies"
+ (open-input-string test-intermediate-a-dependencies))
+ ("https://crates.io/api/v1/crates/intermediate-b"
+ (open-input-string test-intermediate-b-crate))
+ ("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"))))
(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/intermediate-b/1.2.3/dependencies"
+ (open-input-string test-intermediate-b-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"
+ ("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"))))
(open-input-string "empty file\n"))
- ("https://crates.io/api/v1/crates/leaf-alice/1.0.0/dependencies"
+ ("https://crates.io/api/v1/crates/leaf-alice/0.7.5/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"
+ ("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"))))
(open-input-string "empty file\n"))
- ("https://crates.io/api/v1/crates/leaf-bob/1.0.0/dependencies"
+ ("https://crates.io/api/v1/crates/leaf-bob/3.0.1/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))))
+ ;; 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
+ (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)
+ (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-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)
+ (arguments ('quasiquote (#:skip-build? #t)))
+ (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 (#:skip-build? #t
+ #: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 (#:skip-build? #t
+ #: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))))))
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license (list license:expat license:asl2.0)))))
#t)
(x
(pk 'fail x #f)))))
@@ -458,4 +579,86 @@
'(license:expat license:asl2.0)
(string->license "MIT/Apache-2.0"))
+
+
+(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\"
+ }
+ }
+ ]
+ }
+}")
+
+;; FIXME: This test depends on some existing packages
+(define test-doctool-dependencies
+ "{
+ \"dependencies\": [
+ {
+ \"crate_id\": \"docopt\",
+ \"kind\": \"normal\",
+ \"req\": \"^0.8.1\"
+ }
+ ]
+}")
+
+
+(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 "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
+ (package
+ (name "rust-doctool")
+ (version "2.2.2")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (crate-uri "doctool" version))
+ (file-name
+ (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ (? string? hash)))))
+ (build-system cargo-build-system)
+ (arguments
+ ('quasiquote (#:cargo-inputs
+ (("rust-docopt"
+ ('unquote 'rust-docopt-0.8))))))
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license (list license:expat license:asl2.0)))))
+ #t)
+ (x
+ (pk 'fail x #f)))))
+
(test-end "crate")
diff --git a/tests/cve-sample.json b/tests/cve-sample.json
index 39816f9dd4..11b71817bb 100644
--- a/tests/cve-sample.json
+++ b/tests/cve-sample.json
@@ -49,7 +49,7 @@
"vulnerable" : true,
"cpe23Uri" : "cpe:2.3:o:juniper:junos:16.1:*:*:*:*:*:*:*"
} ]
- } {
+ }, {
"operator" : "OR",
"cpe_match" : [ {
"vulnerable" : true,
diff --git a/tests/elpa.scm b/tests/elpa.scm
index b70539bda6..a008cf993c 100644
--- a/tests/elpa.scm
+++ b/tests/elpa.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -51,7 +52,7 @@
(200 "This is the description.")
(200 "fake tarball contents"))
(parameterize ((current-http-proxy (%local-url)))
- (match (elpa->guix-package pkg 'gnu/http)
+ (match (elpa->guix-package pkg #:repo 'gnu/http)
(('package
('name "emacs-auctex")
('version "11.88.6")
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 686334af61..6e92f0e4b3 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -723,10 +723,26 @@
(lambda (port)
(display "This is the second one." port))))))
(build-drv #~(begin
- (use-modules (guix build store-copy))
+ (use-modules (guix build store-copy)
+ (guix build utils)
+ (srfi srfi-1))
+
+ (define (canonical-file? file)
+ ;; Copied from (guix tests).
+ (let ((st (lstat file)))
+ (or (not (string-prefix? (%store-directory) file))
+ (eq? 'symlink (stat:type st))
+ (and (= 1 (stat:mtime st))
+ (zero? (logand #o222 (stat:mode st)))))))
(mkdir #$output)
- (populate-store '("graph") #$output))))
+ (populate-store '("graph") #$output
+ #:deduplicate? #f)
+
+ ;; Check whether 'populate-store' canonicalizes
+ ;; permissions and timestamps.
+ (unless (every canonical-file? (find-files #$output))
+ (error "not canonical!" #$output)))))
(mlet* %store-monad ((one (gexp->derivation "one" build-one))
(two (gexp->derivation "two" (build-two one)))
(drv (gexp->derivation "store-copy" build-drv
diff --git a/tests/glob.scm b/tests/glob.scm
index 3134069789..2a5a40c3c6 100644
--- a/tests/glob.scm
+++ b/tests/glob.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -53,7 +54,8 @@
"foo[abc]bar" => '("foo" (set #\a #\b #\c) "bar")
"foo[a[b]c]bar" => '("foo" (set #\a #\[ #\b #\] #\c) "bar")
"[123]x" => '((set #\1 #\2 #\3) "x")
- "[a-z]" => '((range #\a #\z)))
+ "[a-z]" => '((range #\a #\z))
+ "**/*.scm" => '(**/ * ".scm"))
(test-glob-match
("foo" matches "foo" (and not "foobar" "barfoo"))
@@ -64,6 +66,8 @@
("ab[0-9]c" matches "ab0c" "ab7c" "ab9c"
(and not "ab-c" "ab00c" "ab3"))
("ab[cdefg]" matches "abc" "abd" "abg"
- (and not "abh" "abcd" "ab[")))
+ (and not "abh" "abcd" "ab["))
+ ("foo/**/*.scm" matches "foo/bar/baz.scm" "foo/bar.scm" "foo/bar/baz/zab.scm"
+ (and not "foo/bar/baz.java" "foo/bar.smc")))
(test-end "glob")
diff --git a/tests/guix-archive.sh b/tests/guix-archive.sh
index e796c62f9a..00b87ff0ac 100644
--- a/tests/guix-archive.sh
+++ b/tests/guix-archive.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2013, 2014, 2015, 2019 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2013, 2014, 2015, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@@ -28,7 +28,7 @@ tmpdir="t-archive-dir-$$"
rm -f "$archive" "$archive_alt"
rm -rf "$tmpdir"
-trap 'rm -f "$archive" "$archive_alt"; rm -rf "$tmpdir"' EXIT
+trap 'rm -f "$archive" "$archive_alt"; chmod -R +w "$tmpdir"; rm -rf "$tmpdir"' EXIT
guix archive --export guile-bootstrap > "$archive"
guix archive --export guile-bootstrap:out > "$archive_alt"
diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh
index 346355539f..c4461fa955 100644
--- a/tests/guix-hash.sh
+++ b/tests/guix-hash.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2013, 2014, 2016, 2020 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2013, 2014, 2016, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
#
# This file is part of GNU Guix.
@@ -43,6 +43,7 @@ chmod +x "$tmpdir/exe"
mkdir "$tmpdir/subdir"
test `guix hash -r "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
+test `guix hash -r "$tmpdir" -H sha512` = 301ra58c2vahczzxiyfin41mpyb0ljh4dh9zn3ijvwviaw1j40sfzw5skh9x945da88n3785ggifzig7acd6k72h0mpsc20m1f66m9n
# Without '-r', this should fail.
! guix hash "$tmpdir"
diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh
index 2beb1b1eb6..b90bc7f891 100644
--- a/tests/guix-pack-relocatable.sh
+++ b/tests/guix-pack-relocatable.sh
@@ -55,7 +55,7 @@ run_without_store ()
# Run the relocatable program in the current namespaces. This is a
# weak test because we're going to access store items from the host
# store.
- $*
+ sh -c "$*"
fi
}
diff --git a/tests/import-utils.scm b/tests/import-utils.scm
index 87dda3238f..874816442e 100644
--- a/tests/import-utils.scm
+++ b/tests/import-utils.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
+;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -48,15 +49,16 @@
(package
(name "foo")
(inputs `(("bar" ,bar)))))
- (recursive-import "foo" 'repo
+ (recursive-import "foo"
+ #:repo 'repo
#:repo->guix-package
(match-lambda*
- (("foo" 'repo)
+ (("foo" #:version #f #:repo 'repo)
(values '(package
(name "foo")
(inputs `(("bar" ,bar))))
'("bar")))
- (("bar" 'repo)
+ (("bar" #:version #f #:repo 'repo)
(values '(package
(name "bar"))
'())))
@@ -120,6 +122,38 @@
(or (package-license (alist->package meta))
'license-is-false)))
+(test-equal "alist->package with SPDX license name 1/2" ;<https://bugs.gnu.org/45453>
+ license:expat
+ (let* ((meta '(("name" . "hello")
+ ("version" . "2.10")
+ ("source" . (("method" . "url-fetch")
+ ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz")
+ ("sha256" .
+ (("base32" .
+ "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
+ ("build-system" . "gnu")
+ ("home-page" . "https://gnu.org")
+ ("synopsis" . "Say hi")
+ ("description" . "This package says hi.")
+ ("license" . "expat"))))
+ (package-license (alist->package meta))))
+
+(test-equal "alist->package with SPDX license name 2/2" ;<https://bugs.gnu.org/45453>
+ license:expat
+ (let* ((meta '(("name" . "hello")
+ ("version" . "2.10")
+ ("source" . (("method" . "url-fetch")
+ ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz")
+ ("sha256" .
+ (("base32" .
+ "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
+ ("build-system" . "gnu")
+ ("home-page" . "https://gnu.org")
+ ("synopsis" . "Say hi")
+ ("description" . "This package says hi.")
+ ("license" . "MIT"))))
+ (package-license (alist->package meta))))
+
(test-equal "alist->package with dependencies"
`(("gettext" ,(specification->package "gettext")))
(let* ((meta '(("name" . "hello")
diff --git a/tests/lint.scm b/tests/lint.scm
index 9b230814a5..7c24611934 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -315,7 +315,7 @@
`(("python-setuptools" ,python-setuptools))))))
(check-inputs-should-not-be-an-input-at-all pkg))))
-(test-equal "patches: file names"
+(test-equal "file patches: different file name -> warning"
"file names of patches should start with the package name"
(single-lint-warning-message
(let ((pkg (dummy-package "x"
@@ -324,6 +324,37 @@
(patches (list "/path/to/y.patch")))))))
(check-patch-file-names pkg))))
+(test-equal "file patches: same file name -> no warnings"
+ '()
+ (let ((pkg (dummy-package "x"
+ (source
+ (dummy-origin
+ (patches (list "/path/to/x.patch")))))))
+ (check-patch-file-names pkg)))
+
+(test-equal "<origin> patches: different file name -> warning"
+ "file names of patches should start with the package name"
+ (single-lint-warning-message
+ (let ((pkg (dummy-package "x"
+ (source
+ (dummy-origin
+ (patches
+ (list
+ (dummy-origin
+ (file-name "y.patch")))))))))
+ (check-patch-file-names pkg))))
+
+(test-equal "<origin> patches: same file name -> no warnings"
+ '()
+ (let ((pkg (dummy-package "x"
+ (source
+ (dummy-origin
+ (patches
+ (list
+ (dummy-origin
+ (file-name "x.patch")))))))))
+ (check-patch-file-names pkg)))
+
(test-equal "patches: file name too long"
(string-append "x-"
(make-string 100 #\a)
diff --git a/tests/nar.scm b/tests/nar.scm
index aeff3d3330..ba4881caaa 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -136,8 +136,11 @@
(define (rm-rf dir)
(file-system-fold (const #t) ; enter?
(lambda (file stat result) ; leaf
+ (unless (eq? 'symlink (stat:type stat))
+ (chmod file #o644))
(delete-file file))
- (const #t) ; down
+ (lambda (dir stat result) ; down
+ (chmod dir #o755))
(lambda (dir stat result) ; up
(rmdir dir))
(const #t) ; skip
@@ -218,8 +221,10 @@
'(("R" directory #f)
("R/dir" directory #f)
("R/dir/exe" executable "1234")
+ ("R/dir" directory-complete #f)
("R/foo" regular "abcdefg")
- ("R/lnk" symlink "foo"))
+ ("R/lnk" symlink "foo")
+ ("R" directory-complete #f))
(let ()
(define-values (port get-bytevector)
@@ -361,7 +366,12 @@
(cut write-file input <>))
(call-with-input-file nar
(cut restore-file <> output))
- (file-tree-equal? input output))
+
+ (and (file-tree-equal? input output)
+ (every (lambda (file)
+ (canonical-file?
+ (string-append output "/" file)))
+ '("root" "root/reg" "root/exe"))))
(lambda ()
(false-if-exception (delete-file nar))
(false-if-exception (rm-rf output)))))))
@@ -442,6 +452,9 @@
(false-if-exception (rm-rf %test-dir))
(setlocale LC_ALL locale)))))
+;; XXX: Tell the 'deduplicate' procedure what store we're actually using.
+(setenv "NIX_STORE" (%store-prefix))
+
(test-assert "restore-file-set (signed, valid)"
(with-store store
(let* ((texts (unfold (cut >= <> 10)
diff --git a/tests/opam.scm b/tests/opam.scm
index ec2a668307..11984b56a6 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -80,38 +80,41 @@ url {
(set! test-source-hash
(call-with-input-file file-name port-sha256))))
(_ (error "Unexpected URL: " url)))))
- (let ((my-package (string-append test-repo "/packages/foo/foo.1.0.0")))
- (mkdir-p my-package)
- (with-output-to-file (string-append my-package "/opam")
- (lambda _
- (format #t "~a" test-opam-file))))
- (match (opam->guix-package "foo" #:repository test-repo)
- (('package
- ('name "ocaml-foo")
- ('version "1.0.0")
- ('source ('origin
- ('method 'url-fetch)
- ('uri "https://example.org/foo-1.0.0.tar.gz")
- ('sha256
- ('base32
- (? string? hash)))))
- ('build-system 'ocaml-build-system)
- ('propagated-inputs
- ('quasiquote
- (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
- ('native-inputs
- ('quasiquote
- (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
- ("ocamlbuild" ('unquote 'ocamlbuild)))))
- ('home-page "https://example.org/")
- ('synopsis "Some example package")
- ('description "This package is just an example.")
- ('license #f))
- (string=? (bytevector->nix-base32-string
- test-source-hash)
- hash))
- (x
- (pk 'fail x #f)))))
+ (mock ((guix import opam) get-opam-repository
+ (const test-repo))
+ (let ((my-package (string-append test-repo
+ "/packages/foo/foo.1.0.0")))
+ (mkdir-p my-package)
+ (with-output-to-file (string-append my-package "/opam")
+ (lambda _
+ (format #t "~a" test-opam-file))))
+ (match (opam->guix-package "foo" #:repo test-repo)
+ (('package
+ ('name "ocaml-foo")
+ ('version "1.0.0")
+ ('source ('origin
+ ('method 'url-fetch)
+ ('uri "https://example.org/foo-1.0.0.tar.gz")
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('build-system 'ocaml-build-system)
+ ('propagated-inputs
+ ('quasiquote
+ (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
+ ('native-inputs
+ ('quasiquote
+ (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
+ ("ocamlbuild" ('unquote 'ocamlbuild)))))
+ ('home-page "https://example.org/")
+ ('synopsis "Some example package")
+ ('description "This package is just an example.")
+ ('license #f))
+ (string=? (bytevector->nix-base32-string
+ test-source-hash)
+ hash))
+ (x
+ (pk 'fail x #f))))))
;; Test the opam file parser
;; We fold over some test cases. Each case is a pair of the string to parse and the
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 055924ba3e..2dec42bec1 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -183,6 +183,16 @@
(equal? (list glibc) install)
(equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade)))))
+(test-assert "manifest-transaction-effects no double install or upgrades"
+ (let* ((m0 (manifest (list guile-1.8.8)))
+ (t (manifest-transaction
+ (install (list guile-2.0.9 glibc glibc)))))
+ (let-values (((remove install upgrade downgrade)
+ (manifest-transaction-effects m0 t)))
+ (and (null? remove) (null? downgrade)
+ (equal? (list glibc) install)
+ (equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade)))))
+
(test-assert "manifest-transaction-effects and downgrades"
(let* ((m0 (manifest (list guile-2.0.9)))
(t (manifest-transaction (install (list guile-1.8.8)))))
@@ -191,6 +201,14 @@
(and (null? remove) (null? install) (null? upgrade)
(equal? (list (cons guile-2.0.9 guile-1.8.8)) downgrade)))))
+(test-assert "manifest-transaction-effects no double downgrade"
+ (let* ((m0 (manifest (list guile-2.0.9)))
+ (t (manifest-transaction (install (list guile-1.8.8 guile-1.8.8)))))
+ (let-values (((remove install upgrade downgrade)
+ (manifest-transaction-effects m0 t)))
+ (and (null? remove) (null? install) (null? upgrade)
+ (equal? (list (cons guile-2.0.9 guile-1.8.8)) downgrade)))))
+
(test-assert "manifest-transaction-effects and pseudo-upgrades"
(let* ((m0 (manifest (list guile-2.0.9)))
(t (manifest-transaction (install (list guile-2.0.9)))))
@@ -209,6 +227,16 @@
(and (manifest-transaction-removal-candidate? guile-2.0.9 t)
(not (manifest-transaction-removal-candidate? glibc t)))))
+(test-assert "manifest-transaction-effects no double removal"
+ (let* ((m0 (manifest (list guile-2.0.9)))
+ (t (manifest-transaction
+ (remove (list (manifest-pattern (name "guile")))))))
+ (let-values (((remove install upgrade downgrade)
+ (manifest-transaction-effects m0 t)))
+ (and (= 1 (length remove))
+ (manifest-transaction-removal-candidate? guile-2.0.9 t)
+ (null? install) (null? downgrade) (null? upgrade)))))
+
(test-assertm "profile-derivation"
(mlet* %store-monad
((entry -> (package->manifest-entry %bootstrap-guile))
@@ -356,6 +384,16 @@
(manifest-entry-search-paths
(package->manifest-entry mpl)))))
+(test-assert "packages->manifest, no duplicates"
+ (let ((expected
+ (manifest
+ (list
+ (package->manifest-entry packages:guile-2.2))))
+ (manifest (packages->manifest
+ (list packages:guile-2.2 packages:guile-2.2))))
+ (every manifest-entry=? (manifest-entries expected)
+ (manifest-entries manifest))))
+
(test-equal "packages->manifest, propagated inputs"
(map (match-lambda
((label package)
diff --git a/tests/store-database.scm b/tests/store-database.scm
index 3b4ef43f6d..17eea38c63 100644
--- a/tests/store-database.scm
+++ b/tests/store-database.scm
@@ -20,6 +20,7 @@
#:use-module (guix tests)
#:use-module (guix store)
#:use-module (guix store database)
+ #:use-module (guix build store-copy)
#:use-module ((guix utils) #:select (call-with-temporary-output-file))
#:use-module ((guix build utils)
#:select (mkdir-p delete-file-recursively))
@@ -34,8 +35,7 @@
(test-begin "store-database")
-(test-equal "register-path"
- '(1 1)
+(test-assert "register-items"
(let ((file (string-append (%store-prefix) "/" (make-string 32 #\f)
"-fake")))
(when (valid-path? %store file)
@@ -46,9 +46,9 @@
(drv (string-append file ".drv")))
(call-with-output-file file
(cut display "This is a fake store item.\n" <>))
- (register-path file
- #:references (list ref)
- #:deriver drv)
+ (reset-timestamps file)
+ (with-database (store-database-file) db
+ (register-items db (list (store-info file drv (list ref)))))
(and (valid-path? %store file)
(equal? (references %store file) (list ref))
@@ -57,7 +57,7 @@
(list (stat:mtime (lstat file))
(stat:mtime (lstat ref)))))))
-(test-equal "register-path, directory"
+(test-equal "register-items, directory"
'(1 1 1)
(let ((file (string-append (%store-prefix) "/" (make-string 32 #\f)
"-fake-directory")))
@@ -69,7 +69,9 @@
(mkdir-p (string-append file "/a"))
(call-with-output-file (string-append file "/a/b")
(const #t))
- (register-path file #:deriver drv)
+ (reset-timestamps file)
+ (with-database (store-database-file) db
+ (register-items db (list (store-info file drv '()))))
(and (valid-path? %store file)
(null? (references %store file))
@@ -101,7 +103,7 @@
(list (path-id db "/gnu/foo")
(path-id db "/gnu/bar")))))))
-(test-assert "register-path with unregistered references"
+(test-assert "sqlite-register with unregistered references"
;; Make sure we get a "NOT NULL constraint failed: Refs.reference" error
;; when we try to add references that are not registered yet. Better safe
;; than sorry.
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
index e2870a363d..b1c2d93bbd 100644
--- a/tests/store-deduplication.scm
+++ b/tests/store-deduplication.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -25,6 +25,7 @@
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-64))
(test-begin "store-deduplication")
@@ -94,7 +95,7 @@
(lambda ()
(set! link (lambda (old new)
(set! links (+ links 1))
- (if (<= links 3)
+ (if (<= links 4)
(true-link old new)
(throw 'system-error "link" "~A" '("Whaaat?!")
(list ENOSPC))))))
@@ -106,4 +107,19 @@
(cons (apply = (map (compose stat:ino stat) identical))
(map (compose stat:nlink stat) identical))))))
+(test-assert "copy-file/deduplicate"
+ (call-with-temporary-directory
+ (lambda (store)
+ (let ((source (search-path %load-path "gnu/packages/emacs-xyz.scm")))
+ (for-each (lambda (target)
+ (copy-file/deduplicate source
+ (string-append store target)
+ #:store store))
+ '("/a" "/b" "/c"))
+ (and (directory-exists? (string-append store "/.links"))
+ (file=? source (string-append store "/a"))
+ (apply = (map (compose stat:ino stat
+ (cut string-append store <>))
+ '("/a" "/b" "/c"))))))))
+
(test-end "store-deduplication")
diff --git a/tests/store.scm b/tests/store.scm
index 38051bf5e5..c9a08ac690 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -715,8 +715,33 @@
#:substitute-urls (%test-substitute-urls))
(and (has-substitutes? s o)
(build-derivations s (list d))
+ (canonical-file? o)
(equal? c (call-with-input-file o get-string-all)))))))
+(test-assert "substitute, deduplication"
+ (with-store s
+ (let* ((c (random-text)) ; contents of the output
+ (g (package-derivation s %bootstrap-guile))
+ (d1 (build-expression->derivation s "substitute-me"
+ `(begin ,c (exit 1))
+ #:guile-for-build g))
+ (d2 (build-expression->derivation s "build-me"
+ `(call-with-output-file %output
+ (lambda (p)
+ (display ,c p)))
+ #:guile-for-build g))
+ (o1 (derivation->output-path d1))
+ (o2 (derivation->output-path d2)))
+ (with-derivation-substitute d1 c
+ (set-build-options s #:use-substitutes? #t
+ #:substitute-urls (%test-substitute-urls))
+ (and (has-substitutes? s o1)
+ (build-derivations s (list d2)) ;build
+ (build-derivations s (list d1)) ;substitute
+ (canonical-file? o1)
+ (equal? c (call-with-input-file o1 get-string-all))
+ (= (stat:ino (stat o1)) (stat:ino (stat o2))))))))
+
(test-assert "substitute + build-things with output path"
(with-store s
(let* ((c (random-text)) ;contents of the output
@@ -735,6 +760,7 @@
(and (has-substitutes? s o)
(build-things s (list o)) ;give the output path
(valid-path? s o)
+ (canonical-file? o)
(equal? c (call-with-input-file o get-string-all)))))))
(test-assert "substitute + build-things with specific output"
@@ -755,6 +781,7 @@
(build-things s `((,(derivation-file-name d) . "out")))
(valid-path? s o)
+ (canonical-file? o)
(equal? c (call-with-input-file o get-string-all)))))))
(test-assert "substitute, corrupt output hash"
@@ -787,6 +814,61 @@
(build-derivations s (list d))
#f))))))
+(test-assert "substitute, corrupt output hash, build trace"
+ ;; Likewise, and check the build trace.
+ (with-store s
+ (let* ((c "hello, world") ; contents of the output
+ (d (build-expression->derivation
+ s "corrupt-substitute"
+ `(mkdir %output)
+ #:guile-for-build
+ (package-derivation s %bootstrap-guile (%current-system))))
+ (o (derivation->output-path d)))
+ ;; Make sure we use 'guix substitute'.
+ (set-build-options s
+ #:print-build-trace #t
+ #:use-substitutes? #t
+ #:fallback? #f
+ #:substitute-urls (%test-substitute-urls))
+
+ (with-derivation-substitute d c
+ (sha256 => (make-bytevector 32 0)) ;select a hash that doesn't match C
+
+ (define output
+ (call-with-output-string
+ (lambda (port)
+ (parameterize ((current-build-output-port port))
+ (guard (c ((store-protocol-error? c) #t))
+ (build-derivations s (list d))
+ #f)))))
+
+ (define actual-hash
+ (let-values (((port get-hash)
+ (gcrypt:open-hash-port
+ (gcrypt:hash-algorithm gcrypt:sha256))))
+ (write-file-tree "foo" port
+ #:file-type+size
+ (lambda _
+ (values 'regular (string-length c)))
+ #:file-port
+ (lambda _
+ (open-input-string c)))
+ (close-port port)
+ (bytevector->nix-base32-string (get-hash))))
+
+ (define expected-hash
+ (bytevector->nix-base32-string (make-bytevector 32 0)))
+
+ (define mismatch
+ (string-append "@ hash-mismatch " o " sha256 "
+ expected-hash " " actual-hash "\n"))
+
+ (define failure
+ (string-append "@ substituter-failed " o))
+
+ (and (string-contains output mismatch)
+ (string-contains output failure))))))
+
(test-assert "substitute --fallback"
(with-store s
(let* ((t (random-text)) ; contents of the output
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 6560612c40..542aaf603f 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -28,7 +28,9 @@
#:use-module (guix base32)
#:use-module ((guix store) #:select (%store-prefix))
#:use-module ((guix ui) #:select (guix-warning-port))
- #:use-module ((guix utils) #:select (call-with-compressed-output-port))
+ #:use-module ((guix utils)
+ #:select (call-with-temporary-directory
+ call-with-compressed-output-port))
#:use-module ((guix build utils)
#:select (mkdir-p delete-file-recursively dump-port))
#:use-module (guix tests http)
@@ -36,6 +38,7 @@
#:use-module (rnrs io ports)
#:use-module (web uri)
#:use-module (ice-9 regex)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
@@ -47,7 +50,8 @@ it writes to GUIX-WARNING-PORT a messages that matches ERROR-RX."
(test-equal name
'(1 #t)
(let ((error-output (open-output-string)))
- (parameterize ((guix-warning-port error-output))
+ (parameterize ((current-error-port error-output)
+ (guix-warning-port error-output))
(catch 'quit
(lambda ()
exp
@@ -57,6 +61,14 @@ it writes to GUIX-WARNING-PORT a messages that matches ERROR-RX."
(let ((message (get-output-string error-output)))
(->bool (string-match error-rx message))))))))))
+(define (request-substitution item destination)
+ "Run 'guix substitute --substitute' to fetch ITEM to DESTINATION."
+ (parameterize ((guix-warning-port (current-error-port)))
+ (with-input-from-string (string-append "substitute " item " "
+ destination "\n")
+ (lambda ()
+ (guix-substitute "--substitute")))))
+
(define %public-key
;; This key is known to be in the ACL by default.
(call-with-input-file (string-append %config-directory "/signing-key.pub")
@@ -183,6 +195,11 @@ a file for NARINFO."
;; Transmit these options to 'guix substitute'.
(substitute-urls (list (getenv "GUIX_BINARY_SUBSTITUTE_URL")))
+;; Never use file descriptor 4, unlike what happens when invoked by the
+;; daemon.
+(%error-to-file-descriptor-4? #f)
+
+
(test-equal "query narinfo without signature"
"" ; not substitutable
@@ -283,21 +300,68 @@ System: mips64el-linux\n")
(test-quit "substitute, no signature"
"no valid substitute"
(with-narinfo %narinfo
- (guix-substitute "--substitute"
- (string-append (%store-prefix)
- "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
- "foo")))
+ (with-input-from-string (string-append "substitute "
+ (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+ " foo\n")
+ (lambda ()
+ (guix-substitute "--substitute")))))
-(test-quit "substitute, invalid hash"
+(test-quit "substitute, invalid narinfo hash"
"no valid substitute"
;; The hash in the signature differs from the hash of %NARINFO.
(with-narinfo (string-append %narinfo "Signature: "
(signature-field "different body")
"\n")
- (guix-substitute "--substitute"
- (string-append (%store-prefix)
- "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
- "foo")))
+ (with-input-from-string (string-append "substitute "
+ (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+ " foo\n")
+ (lambda ()
+ (guix-substitute "--substitute")))))
+
+(test-equal "substitute, invalid hash"
+ (string-append "hash-mismatch sha256 "
+ (bytevector->nix-base32-string (sha256 #vu8())) " "
+ (let-values (((port get-hash)
+ (open-hash-port (hash-algorithm sha256)))
+ ((content)
+ "Substitutable data."))
+ (write-file-tree "foo" port
+ #:file-type+size
+ (lambda _
+ (values 'regular
+ (string-length content)))
+ #:file-port
+ (lambda _
+ (open-input-string content)))
+ (close-port port)
+ (bytevector->nix-base32-string (get-hash)))
+ "\n")
+
+ ;; Arrange so the actual data hash does not match the 'NarHash' field in the
+ ;; narinfo.
+ (with-output-to-string
+ (lambda ()
+ (let ((narinfo (string-append "StorePath: " (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-wrong-hash
+URL: example.nar
+Compression: none
+NarHash: sha256:" (bytevector->nix-base32-string (sha256 #vu8())) "
+NarSize: 42
+References:
+Deriver: " (%store-prefix) "/foo.drv
+System: mips64el-linux\n")))
+ (with-narinfo (string-append narinfo "Signature: "
+ (signature-field narinfo) "\n")
+ (call-with-temporary-directory
+ (lambda (directory)
+ (with-input-from-string (string-append
+ "substitute " (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-wrong-hash "
+ directory "/wrong-hash\n")
+ (lambda ()
+ (guix-substitute "--substitute"))))))))))
(test-quit "substitute, unauthorized key"
"no valid substitute"
@@ -306,23 +370,26 @@ System: mips64el-linux\n")
%narinfo
#:public-key %wrong-public-key)
"\n")
- (guix-substitute "--substitute"
- (string-append (%store-prefix)
- "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
- "foo")))
+ (with-input-from-string (string-append "substitute "
+ (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+ " foo\n")
+ (lambda ()
+ (guix-substitute "--substitute")))))
(test-equal "substitute, authorized key"
- "Substitutable data."
+ '("Substitutable data." 1 #o444)
(with-narinfo (string-append %narinfo "Signature: "
(signature-field %narinfo))
(dynamic-wind
(const #t)
(lambda ()
- (guix-substitute "--substitute"
- (string-append (%store-prefix)
- "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
- "substitute-retrieved")
- (call-with-input-file "substitute-retrieved" get-string-all))
+ (request-substitution (string-append (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ "substitute-retrieved")
+ (list (call-with-input-file "substitute-retrieved" get-string-all)
+ (stat:mtime (lstat "substitute-retrieved"))
+ (stat:perms (lstat "substitute-retrieved"))))
(lambda ()
(false-if-exception (delete-file "substitute-retrieved"))))))
@@ -351,10 +418,9 @@ System: mips64el-linux\n")
(map (cut string-append "file://" <>)
(list %alternate-substitute-directory
%main-substitute-directory))))
- (guix-substitute "--substitute"
- (string-append (%store-prefix)
- "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
- "substitute-retrieved"))
+ (request-substitution (string-append (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ "substitute-retrieved"))
(call-with-input-file "substitute-retrieved" get-string-all))
(lambda ()
(false-if-exception (delete-file "substitute-retrieved")))))))
@@ -380,10 +446,9 @@ System: mips64el-linux\n")
(map (cut string-append "file://" <>)
(list %alternate-substitute-directory
%main-substitute-directory))))
- (guix-substitute "--substitute"
- (string-append (%store-prefix)
- "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
- "substitute-retrieved"))
+ (request-substitution (string-append (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ "substitute-retrieved"))
(call-with-input-file "substitute-retrieved" get-string-all))
(lambda ()
(false-if-exception (delete-file "substitute-retrieved")))))))
@@ -416,10 +481,9 @@ System: mips64el-linux\n")
(map (cut string-append "file://" <>)
(list %alternate-substitute-directory
%main-substitute-directory))))
- (guix-substitute "--substitute"
- (string-append (%store-prefix)
- "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
- "substitute-retrieved"))
+ (request-substitution (string-append (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ "substitute-retrieved"))
(call-with-input-file "substitute-retrieved" get-string-all))
(lambda ()
(false-if-exception (delete-file "substitute-retrieved")))))))
@@ -450,10 +514,9 @@ System: mips64el-linux\n")
(map (cut string-append "file://" <>)
(list %alternate-substitute-directory
%main-substitute-directory))))
- (guix-substitute "--substitute"
- (string-append (%store-prefix)
- "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
- "substitute-retrieved"))
+ (request-substitution (string-append (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ "substitute-retrieved"))
(call-with-input-file "substitute-retrieved" get-string-all))
(lambda ()
(false-if-exception (delete-file "substitute-retrieved")))))))
@@ -469,10 +532,12 @@ System: mips64el-linux\n")
#:public-key %wrong-public-key))
%main-substitute-directory
- (guix-substitute "--substitute"
- (string-append (%store-prefix)
- "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
- "substitute-retrieved"))))
+ (with-input-from-string (string-append "substitute "
+ (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"
+ " substitute-retrieved\n")
+ (lambda ()
+ (guix-substitute "--substitute"))))))
(test-equal "substitute, narinfo with several URLs"
"Substitutable data."
@@ -512,10 +577,9 @@ System: mips64el-linux\n")))
(parameterize ((substitute-urls
(list (string-append "file://"
%main-substitute-directory))))
- (guix-substitute "--substitute"
- (string-append (%store-prefix)
- "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
- "substitute-retrieved"))
+ (request-substitution (string-append (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ "substitute-retrieved"))
(call-with-input-file "substitute-retrieved" get-string-all))
(lambda ()
(false-if-exception (delete-file "substitute-retrieved")))))))
diff --git a/tests/swh.scm b/tests/swh.scm
index aef68acbe7..06984b2a80 100644
--- a/tests/swh.scm
+++ b/tests/swh.scm
@@ -33,7 +33,7 @@
"[ { \"name\": \"one\",
\"type\": \"regular\",
\"length\": 123,
- \"dir_id\": 1 }
+ \"dir_id\": 1 },
{ \"name\": \"two\",
\"type\": \"regular\",
\"length\": 456,
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 07ed8b1234..9053deba41 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -26,6 +26,7 @@
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
#:use-module (guix transformations)
+ #:use-module ((guix gexp) #:select (local-file? local-file-file))
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix git)
@@ -368,10 +369,32 @@
(let ((new (t p)))
(match (bag-direct-inputs (package->bag new))
((("dep" dep) ("tar" tar) _ ...)
- ;; TODO: Check whether TAR has #:tests? #f when transformations
- ;; apply to implicit inputs.
- (equal? (package-arguments dep)
- '(#:tests? #f)))))))
+ (and (equal? (package-arguments dep) '(#:tests? #f))
+ (match (memq #:tests? (package-arguments tar))
+ ((#:tests? #f _ ...) #t))))))))
+
+(test-equal "options->transformation, with-patch"
+ (search-patches "glibc-locales.patch" "guile-relocatable.patch")
+ (let* ((dep (dummy-package "dep"
+ (source (dummy-origin))))
+ (p (dummy-package "foo"
+ (inputs `(("dep" ,dep)))))
+ (patch1 (search-patch "glibc-locales.patch"))
+ (patch2 (search-patch "guile-relocatable.patch"))
+ (t (options->transformation
+ `((with-patch . ,(string-append "dep=" patch1))
+ (with-patch . ,(string-append "dep=" patch2))
+ (with-patch . ,(string-append "tar=" patch1))))))
+ (let ((new (t p)))
+ (match (bag-direct-inputs (package->bag new))
+ ((("dep" dep) ("tar" tar) _ ...)
+ (and (member patch1
+ (filter-map (lambda (patch)
+ (and (local-file? patch)
+ (local-file-file patch)))
+ (origin-patches (package-source tar))))
+ (map local-file-file
+ (origin-patches (package-source dep)))))))))
(test-end)
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-19 02:31:38 +0000