Merge branch 'master' into core-updates

[jackhill/guix/guix.git] / tests / packages.scm

diff --git a/tests/packages.scm b/tests/packages.scm
index 423c506..7a8b5e4 100644 (file)
--- a/tests/packages.scm
+++ b/tests/packages.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>
 ;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -100,7 +100,8 @@
   (let* ((old (dummy-package "foo" (version "1")))
          (tx  (mock ((gnu packages) find-best-packages-by-name
                      (const '()))
-                    ((@@ (guix scripts package) transaction-upgrade-entry)
+                    (transaction-upgrade-entry
+                     #f                           ;no store access needed
                      (manifest-entry
                        (inherit (package->manifest-entry old))
                        (item (string-append (%store-prefix) "/"
@@ -108,12 +109,48 @@
                      (manifest-transaction)))))
     (manifest-transaction-null? tx)))
 
+(test-assert "transaction-upgrade-entry, zero upgrades, equivalent package"
+  (let* ((old (dummy-package "foo" (version "1")))
+         (drv (package-derivation %store old))
+         (tx  (mock ((gnu packages) find-best-packages-by-name
+                     (const (list old)))
+                    (transaction-upgrade-entry
+                     %store
+                     (manifest-entry
+                       (inherit (package->manifest-entry old))
+                       (item (derivation->output-path drv)))
+                     (manifest-transaction)))))
+    (manifest-transaction-null? tx)))
+
+(test-assert "transaction-upgrade-entry, zero upgrades, propagated inputs"
+  ;; Properly detect equivalent packages even when they have propagated
+  ;; inputs.  See <https://bugs.gnu.org/35872>.
+  (let* ((dep (dummy-package "dep" (version "2")))
+         (old (dummy-package "foo" (version "1")
+                             (propagated-inputs `(("dep" ,dep)))))
+         (drv (package-derivation %store old))
+         (tx  (mock ((gnu packages) find-best-packages-by-name
+                     (const (list old)))
+                    (transaction-upgrade-entry
+                     %store
+                     (manifest-entry
+                       (inherit (package->manifest-entry old))
+                       (item (derivation->output-path drv))
+                       (dependencies
+                        (list (manifest-entry
+                                (inherit (package->manifest-entry dep))
+                                (item (derivation->output-path
+                                       (package-derivation %store dep)))))))
+                     (manifest-transaction)))))
+    (manifest-transaction-null? tx)))
+
 (test-assert "transaction-upgrade-entry, one upgrade"
   (let* ((old (dummy-package "foo" (version "1")))
          (new (dummy-package "foo" (version "2")))
          (tx  (mock ((gnu packages) find-best-packages-by-name
                      (const (list new)))
-                    ((@@ (guix scripts package) transaction-upgrade-entry)
+                    (transaction-upgrade-entry
+                     #f                           ;no store access needed
                      (manifest-entry
                        (inherit (package->manifest-entry old))
                        (item (string-append (%store-prefix) "/"
@@ -130,7 +167,8 @@
          (dep (deprecated-package "foo" new))
          (tx  (mock ((gnu packages) find-best-packages-by-name
                      (const (list dep)))
-                    ((@@ (guix scripts package) transaction-upgrade-entry)
+                    (transaction-upgrade-entry
+                     #f                           ;no store access needed
                      (manifest-entry
                        (inherit (package->manifest-entry old))
                        (item (string-append (%store-prefix) "/"
@@ -145,6 +183,30 @@
                  (string=? (manifest-pattern-version pattern) "1")
                  (string=? (manifest-pattern-output pattern) "out")))))))
 
+(test-assert "transaction-upgrade-entry, grafts"
+  ;; Ensure that, when grafts are enabled, 'transaction-upgrade-entry' doesn't
+  ;; try to build stuff.
+  (with-build-handler (const 'failed!)
+    (parameterize ((%graft? #t))
+      (let* ((old (dummy-package "foo" (version "1")))
+             (bar (dummy-package "bar" (version "0")
+                                 (replacement old)))
+             (new (dummy-package "foo" (version "1")
+                                 (inputs `(("bar" ,bar)))))
+             (tx  (mock ((gnu packages) find-best-packages-by-name
+                         (const (list new)))
+                        (transaction-upgrade-entry
+                         %store
+                         (manifest-entry
+                           (inherit (package->manifest-entry old))
+                           (item (string-append (%store-prefix) "/"
+                                                (make-string 32 #\e) "-foo-1")))
+                         (manifest-transaction)))))
+        (and (match (manifest-transaction-install tx)
+               ((($ <manifest-entry> "foo" "1" "out" item))
+                (eq? item new)))
+             (null? (manifest-transaction-remove tx)))))))
+
 (test-assert "package-field-location"
   (let ()
     (define (goto port line column)