Merge branch 'master' into core-updates-frozen

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))