summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/derivations.scm14
-rw-r--r--tests/egg.scm2
-rw-r--r--tests/gexp.scm11
-rw-r--r--tests/home-import.scm1
-rw-r--r--tests/nar.scm7
-rw-r--r--tests/print.scm84
-rw-r--r--tests/pypi.scm12
-rw-r--r--tests/store-deduplication.scm41
-rw-r--r--tests/store.scm4
9 files changed, 149 insertions, 27 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm
index cd165d1be6..0775719ea3 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -170,11 +170,15 @@
#f))))
(test-assert "identical files are deduplicated"
- (let* ((build1 (add-text-to-store %store "one.sh"
- "echo hello, world > \"$out\"\n"
+ ;; Note: DATA must be longer than %DEDUPLICATION-MINIMUM-SIZE.
+ (let* ((data (make-string 9000 #\a))
+ (build1 (add-text-to-store %store "one.sh"
+ (string-append "echo -n " data
+ " > \"$out\"\n")
'()))
(build2 (add-text-to-store %store "two.sh"
- "# Hey!\necho hello, world > \"$out\"\n"
+ (string-append "# Hey!\necho -n "
+ data " > \"$out\"\n")
'()))
(drv1 (derivation %store "foo"
%bash `(,build1)
@@ -187,7 +191,7 @@
(file2 (derivation->output-path drv2)))
(and (valid-path? %store file1) (valid-path? %store file2)
(string=? (call-with-input-file file1 get-string-all)
- "hello, world\n")
+ data)
(= (stat:ino (lstat file1))
(stat:ino (lstat file2))))))))
diff --git a/tests/egg.scm b/tests/egg.scm
index 9e45a42443..a7d3378dd7 100644
--- a/tests/egg.scm
+++ b/tests/egg.scm
@@ -73,7 +73,7 @@
(call-with-output-file egg-file
(lambda (port)
(write egg-test port)))
- (matcher (egg->guix-package egg-name
+ (matcher (egg->guix-package egg-name #f
#:file egg-file
#:source (plain-file
(string-append egg-name "-egg")
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 28d09f5a6d..b720671735 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
@@ -834,19 +834,14 @@
(files -> `(("a/b/c" . ,q-scm)
("p/q" . ,plain)))
(drv (imported-files files)))
- (define (file=? file1 file2)
- ;; Assume deduplication is in place.
- (= (stat:ino (stat file1))
- (stat:ino (stat file2))))
-
(mbegin %store-monad
(built-derivations (list (pk 'drv drv)))
(mlet %store-monad ((dir -> (derivation->output-path drv))
(plain* (text-file "foo" "bar!"))
(q-scm* (interned-file q-scm "c")))
(return
- (and (file=? (string-append dir "/a/b/c") q-scm*)
- (file=? (string-append dir "/p/q") plain*)))))))
+ (and (file=? (string-append dir "/a/b/c") q-scm* stat)
+ (file=? (string-append dir "/p/q") plain* stat)))))))
(test-equal "gexp-modules & ungexp"
'((bar) (foo))
diff --git a/tests/home-import.scm b/tests/home-import.scm
index abd3cec43d..0bcdf8a469 100644
--- a/tests/home-import.scm
+++ b/tests/home-import.scm
@@ -151,6 +151,7 @@ corresponding file."
('list ('service
'home-bash-service-type
('home-bash-configuration
+ ('aliases ('quote ()))
('bashrc
('list ('local-file "/tmp/guix-config/.bashrc"
"bashrc"))))))))))
diff --git a/tests/nar.scm b/tests/nar.scm
index ba4881caaa..98752f2088 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, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -486,8 +486,9 @@
;; their mtime and permissions were not reset. Ensure that this bug is
;; gone.
(with-store store
- (let* ((text1 (random-text))
- (text2 (random-text))
+ ;; Note: TEXT1 and TEXT2 must be longer than %DEDUPLICATION-MINIMUM-SIZE.
+ (let* ((text1 (string-concatenate (make-list 200 (random-text))))
+ (text2 (string-concatenate (make-list 200 (random-text))))
(tree `("tree" directory
("a" regular (data ,text1))
("b" directory
diff --git a/tests/print.scm b/tests/print.scm
index 1b24e12f2e..d9710d1ed3 100644
--- a/tests/print.scm
+++ b/tests/print.scm
@@ -22,6 +22,7 @@
#:use-module (guix download)
#:use-module (guix packages)
#:use-module ((guix licenses) #:prefix license:)
+ #:use-module ((gnu packages) #:select (search-patches))
#:use-module (srfi srfi-64))
(define-syntax-rule (define-with-source object source expr)
@@ -67,6 +68,77 @@
(description "This is a dummy package.")
(license license:gpl3+)))
+(define-with-source pkg-with-origin-input pkg-with-origin-input-source
+ (package
+ (name "test")
+ (version "1.2.3")
+ (source (origin
+ (method url-fetch)
+ (uri (list (string-append "file:///tmp/test-"
+ version ".tar.gz")
+ (string-append "http://example.org/test-"
+ version ".tar.gz")))
+ (sha256
+ (base32
+ "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))
+ (patches (search-patches "guile-linux-syscalls.patch"
+ "guile-relocatable.patch"))))
+ (build-system (@ (guix build-system gnu) gnu-build-system))
+ (inputs
+ `(("o" ,(origin
+ (method url-fetch)
+ (uri "http://example.org/somefile.txt")
+ (sha256
+ (base32
+ "0000000000000000000000000000000000000000000000000000"))))))
+ (home-page "http://gnu.org")
+ (synopsis "Dummy")
+ (description "This is a dummy package.")
+ (license license:gpl3+)))
+
+(define-with-source pkg-with-origin-patch pkg-with-origin-patch-source
+ (package
+ (name "test")
+ (version "1.2.3")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "file:///tmp/test-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))
+ (patches
+ (list (origin
+ (method url-fetch)
+ (uri "http://example.org/x.patch")
+ (sha256
+ (base32
+ "0000000000000000000000000000000000000000000000000000")))))))
+ (build-system (@ (guix build-system gnu) gnu-build-system))
+ (home-page "http://gnu.org")
+ (synopsis "Dummy")
+ (description "This is a dummy package.")
+ (license license:gpl3+)))
+
+(define-with-source pkg-with-arguments pkg-with-arguments-source
+ (package
+ (name "test")
+ (version "1.2.3")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "file:///tmp/test-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
+ (build-system (@ (guix build-system gnu) gnu-build-system))
+ (arguments
+ `(#:disallowed-references (,(@ (gnu packages base) coreutils))))
+ (home-page "http://gnu.org")
+ (synopsis "Dummy")
+ (description "This is a dummy package.")
+ (license license:gpl3+)))
+
(test-equal "simple package"
`(define-public test ,pkg-source)
(package->code pkg))
@@ -75,4 +147,16 @@
`(define-public test ,pkg-with-inputs-source)
(package->code pkg-with-inputs))
+(test-equal "package with origin input"
+ `(define-public test ,pkg-with-origin-input-source)
+ (package->code pkg-with-origin-input))
+
+(test-equal "package with origin patch"
+ `(define-public test ,pkg-with-origin-patch-source)
+ (package->code pkg-with-origin-patch))
+
+(test-equal "package with arguments"
+ `(define-public test ,pkg-with-arguments-source)
+ (package->code pkg-with-arguments))
+
(test-end "print")
diff --git a/tests/pypi.scm b/tests/pypi.scm
index 43fb1d8628..debe4ce82d 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -255,9 +255,15 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
('synopsis "summary")
('description "summary")
('license 'license:lgpl2.0))
- (string=? (bytevector->nix-base32-string
- test-source-hash)
- hash))
+ (and (string=? (bytevector->nix-base32-string
+ test-source-hash)
+ hash)
+ (equal? (pypi->guix-package "foo" #:version "1.0.0")
+ (pypi->guix-package "foo"))
+ (catch 'quit
+ (lambda ()
+ (pypi->guix-package "foo" #:version "42"))
+ (const #t))))
(x
(pk 'fail x #f))))))
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
index b1c2d93bbd..2950fbc1a3 100644
--- a/tests/store-deduplication.scm
+++ b/tests/store-deduplication.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2020-2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -30,13 +30,40 @@
(test-begin "store-deduplication")
+(test-equal "deduplicate, below %deduplication-minimum-size"
+ (list #t (make-list 5 1))
+
+ (call-with-temporary-directory
+ (lambda (store)
+ ;; Note: DATA must be longer than %DEDUPLICATION-MINIMUM-SIZE.
+ (let ((data "Hello, world!")
+ (identical (map (lambda (n)
+ (string-append store "/" (number->string n)
+ "/a/b/c"))
+ (iota 5))))
+ (for-each (lambda (file)
+ (mkdir-p (dirname file))
+ (call-with-output-file file
+ (lambda (port)
+ (put-bytevector port (string->utf8 data)))))
+ identical)
+
+ (deduplicate store (nar-sha256 store) #:store store)
+
+ ;; (system (string-append "ls -lRia " store))
+ (list (= (length (delete-duplicates
+ (map (compose stat:ino stat) identical)))
+ (length identical))
+ (map (compose stat:nlink stat) identical))))))
+
(test-equal "deduplicate"
(cons* #t #f ;inode comparisons
2 (make-list 5 6)) ;'nlink' values
(call-with-temporary-directory
(lambda (store)
- (let ((data (string->utf8 "Hello, world!"))
+ ;; Note: DATA must be longer than %DEDUPLICATION-MINIMUM-SIZE.
+ (let ((data (string-concatenate (make-list 1000 "Hello, world!")))
(identical (map (lambda (n)
(string-append store "/" (number->string n)
"/a/b/c"))
@@ -46,7 +73,7 @@
(mkdir-p (dirname file))
(call-with-output-file file
(lambda (port)
- (put-bytevector port data))))
+ (put-bytevector port (string->utf8 data)))))
identical)
;; Make the parent of IDENTICAL read-only. This should not prevent
;; deduplication from inserting its hard link.
@@ -54,7 +81,7 @@
(call-with-output-file unique
(lambda (port)
- (put-bytevector port (string->utf8 "This is unique."))))
+ (put-bytevector port (string->utf8 (string-reverse data)))))
(deduplicate store (nar-sha256 store) #:store store)
@@ -77,8 +104,10 @@
(lambda (store)
(let ((true-link link)
(links 0)
- (data1 (string->utf8 "Hello, world!"))
- (data2 (string->utf8 "Hi, world!"))
+ (data1 (string->utf8
+ (string-concatenate (make-list 1000 "Hello, world!"))))
+ (data2 (string->utf8
+ (string-concatenate (make-list 1000 "Hi, world!"))))
(identical (map (lambda (n)
(string-append store "/" (number->string n)
"/a/b/c"))
diff --git a/tests/store.scm b/tests/store.scm
index 7fc2988476..d5edd110dd 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -760,7 +760,9 @@
(test-assert "substitute, deduplication"
(with-store s
- (let* ((c (random-text)) ; contents of the output
+ ;; Note: C must be longer than %DEDUPLICATION-MINIMUM-SIZE.
+ (let* ((c (string-concatenate
+ (make-list 200 (random-text)))) ; contents of the output
(g (package-derivation s %bootstrap-guile))
(d1 (build-expression->derivation s "substitute-me"
`(begin ,c (exit 1))
generated by cgit v1.2.3 (git 2.46.2) at 2024-11-10 07:03:39 +0000