Merge branch 'master' into staging

6 files changed, 256 insertions, 14 deletions

diff --git a/tests/channels.scm b/tests/channels.scm
index f3fc383ac3..8540aef435 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -18,9 +18,16 @@
 
 (define-module (test-channels)
   #:use-module (guix channels)
+  #:use-module (guix profiles)
   #:use-module ((guix build syscalls) #:select (mkdtemp!))
   #:use-module (guix tests)
+  #:use-module (guix store)
+  #:use-module ((guix grafts) #:select (%graft?))
+  #:use-module (guix derivations)
+  #:use-module (guix sets)
+  #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64)
   #:use-module (ice-9 match))
 
@@ -34,8 +41,9 @@
   (and spec
        (with-output-to-file (string-append instance-dir "/.guix-channel")
          (lambda _ (format #t "~a" spec))))
-  ((@@ (guix channels) channel-instance)
-   name commit instance-dir))
+  (checkout->channel-instance instance-dir
+                              #:commit commit
+                              #:name name))
 
 (define instance--boring (make-instance))
 (define instance--no-deps
@@ -136,4 +144,80 @@
                                    'abc1234)))
                        instances))))))
 
+(test-assert "channel-instances->manifest"
+  ;; Compute the manifest for a graph of instances and make sure we get a
+  ;; derivation graph that mirrors the instance graph.  This test also ensures
+  ;; we don't try to access Git repositores at all at this stage.
+  (let* ((spec      (lambda deps
+                      `(channel (version 0)
+                                (dependencies
+                                 ,@(map (lambda (dep)
+                                          `(channel
+                                            (name ,dep)
+                                            (url "http://example.org")))
+                                        deps)))))
+         (guix      (make-instance #:name 'guix))
+         (instance0 (make-instance #:name 'a))
+         (instance1 (make-instance #:name 'b #:spec (spec 'a)))
+         (instance2 (make-instance #:name 'c #:spec (spec 'b)))
+         (instance3 (make-instance #:name 'd #:spec (spec 'c 'a))))
+    (%graft? #f)                                    ;don't try to build stuff
+
+    ;; Create 'build-self.scm' so that GUIX is recognized as the 'guix' channel.
+    (let ((source (channel-instance-checkout guix)))
+      (mkdir (string-append source "/build-aux"))
+      (call-with-output-file (string-append source
+                                            "/build-aux/build-self.scm")
+        (lambda (port)
+          (write '(begin
+                    (use-modules (guix) (gnu packages bootstrap))
+
+                    (lambda _
+                      (package->derivation %bootstrap-guile)))
+                 port))))
+
+    (with-store store
+      (let ()
+        (define manifest
+          (run-with-store store
+            (channel-instances->manifest (list guix
+                                               instance0 instance1
+                                               instance2 instance3))))
+
+        (define entries
+          (manifest-entries manifest))
+
+        (define (depends? drv in out)
+          ;; Return true if DRV depends (directly or indirectly) on all of IN
+          ;; and none of OUT.
+          (let ((set (list->set
+                      (requisites store
+                                  (list (derivation-file-name drv)))))
+                (in  (map derivation-file-name in))
+                (out (map derivation-file-name out)))
+            (and (every (cut set-contains? set <>) in)
+                 (not (any (cut set-contains? set <>) out)))))
+
+        (define (lookup name)
+          (run-with-store store
+            (lower-object
+             (manifest-entry-item
+              (manifest-lookup manifest
+                               (manifest-pattern (name name)))))))
+
+        (let ((drv-guix (lookup "guix"))
+              (drv0     (lookup "a"))
+              (drv1     (lookup "b"))
+              (drv2     (lookup "c"))
+              (drv3     (lookup "d")))
+          (and (depends? drv-guix '() (list drv0 drv1 drv2 drv3))
+               (depends? drv0
+                         (list) (list drv1 drv2 drv3))
+               (depends? drv1
+                         (list drv0) (list drv2 drv3))
+               (depends? drv2
+                         (list drv1) (list drv3))
+               (depends? drv3
+                         (list drv2 drv0) (list))))))))
+
 (test-end "channels")
diff --git a/tests/guix-package-net.sh b/tests/guix-package-net.sh
index 927c856b23..82c346dd4c 100644
--- a/tests/guix-package-net.sh
+++ b/tests/guix-package-net.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2015, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 #
 # This file is part of GNU Guix.
@@ -167,6 +167,37 @@ then false; fi
 guix package -p "$profile" -p "$profile_alt" --search-paths \
      | grep "LIBRARY_PATH.*$profile/lib.$profile_alt/lib"
 
+# Simulate an upgrade and make sure the package order is preserved.
+module_dir="t-guix-package-net-$$"
+trap 'rm -rf "$module_dir"' EXIT
+
+mkdir "$module_dir"
+cat > "$module_dir/new.scm" <<EOF
+(define-module (new)
+  #:use-module (guix)
+  #:use-module (gnu packages bootstrap))
+
+(define-public new-guile
+  (package (inherit %bootstrap-guile)
+           (version (string-append "42." (getenv "V_MINOR")))))
+(define-public new-gcc
+  (package (inherit %bootstrap-gcc)
+           (version (string-append "77." (getenv "V_MINOR")))))
+EOF
+
+guix package --bootstrap -p "$profile" -i gcc-bootstrap
+installed="`guix package -p "$profile" -I | cut -f1`"
+
+for i in 1 2
+do
+    V_MINOR="$i"
+    export V_MINOR
+
+    guix package -p "$profile" --bootstrap -L "$module_dir" -u .
+    post_upgrade="`guix package -p "$profile" -I | cut -f1`"
+    test "$post_upgrade" = "$installed"
+done
+
 #
 # Try with the default profile.
 #
diff --git a/tests/lint.scm b/tests/lint.scm
index 912a78d111..dc2b17aeec 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -38,7 +38,7 @@
   #:use-module (gnu packages)
   #:use-module (gnu packages glib)
   #:use-module (gnu packages pkg-config)
-  #:use-module (gnu packages python)
+  #:use-module (gnu packages python-xyz)
   #:use-module (web uri)
   #:use-module (web server)
   #:use-module (web server http)
diff --git a/tests/nar.scm b/tests/nar.scm
index 5ffe68c9e2..bfc71c69a8 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 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -334,6 +334,40 @@
       (lambda ()
         (rmdir input)))))
 
+(test-eq "restore-file with non-UTF8 locale"     ;<https://bugs.gnu.org/33603>
+  'encoding-error
+  (let* ((file   (search-path %load-path "guix.scm"))
+         (output (string-append %test-dir "/output"))
+         (locale (setlocale LC_ALL "C")))
+    (dynamic-wind
+      (lambda () #t)
+      (lambda ()
+        (define-values (port get-bytevector)
+          (open-bytevector-output-port))
+
+        (write-file-tree "root" port
+                         #:file-type+size
+                         (match-lambda
+                           ("root"   (values 'directory 0))
+                           ("root/λ" (values 'regular 0)))
+                         #:file-port (const (%make-void-port "r"))
+                         #:symlink-target (const #f)
+                         #:directory-entries (const '("λ")))
+        (close-port port)
+
+        (mkdir %test-dir)
+        (catch 'encoding-error
+          (lambda ()
+            ;; This show throw to 'encoding-error.
+            (restore-file (open-bytevector-input-port (get-bytevector))
+                          output)
+            (scandir output))
+          (lambda args
+            'encoding-error)))
+      (lambda ()
+        (false-if-exception (rm-rf %test-dir))
+        (setlocale LC_ALL locale)))))
+
 (test-assert "restore-file-set (signed, valid)"
   (with-store store
     (let* ((texts (unfold (cut >= <> 10)
diff --git a/tests/packages.scm b/tests/packages.scm
index 237feb7aba..ed635d9011 100644
--- 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 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -96,8 +96,8 @@
 
 (test-assert "transaction-upgrade-entry, zero upgrades"
   (let* ((old (dummy-package "foo" (version "1")))
-         (tx  (mock ((gnu packages) find-newest-available-packages
-                     (const vlist-null))
+         (tx  (mock ((gnu packages) find-best-packages-by-name
+                     (const '()))
                     ((@@ (guix scripts package) transaction-upgrade-entry)
                      (manifest-entry
                        (inherit (package->manifest-entry old))
@@ -109,8 +109,8 @@
 (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-newest-available-packages
-                     (const (vhash-cons "foo" (list "2" new) vlist-null)))
+         (tx  (mock ((gnu packages) find-best-packages-by-name
+                     (const (list new)))
                     ((@@ (guix scripts package) transaction-upgrade-entry)
                      (manifest-entry
                        (inherit (package->manifest-entry old))
@@ -126,8 +126,8 @@
   (let* ((old (dummy-package "foo" (version "1")))
          (new (dummy-package "bar" (version "2")))
          (dep (deprecated-package "foo" new))
-         (tx  (mock ((gnu packages) find-newest-available-packages
-                     (const (vhash-cons "foo" (list "2" dep) vlist-null)))
+         (tx  (mock ((gnu packages) find-best-packages-by-name
+                     (const (list dep)))
                     ((@@ (guix scripts package) transaction-upgrade-entry)
                      (manifest-entry
                        (inherit (package->manifest-entry old))
@@ -995,6 +995,28 @@
     ((one)
      (eq? one guile-2.0))))
 
+(test-assert "fold-available-packages with/without cache"
+  (let ()
+    (define no-cache
+      (fold-available-packages (lambda* (name version result #:rest rest)
+                                 (cons (cons* name version rest)
+                                       result))
+                               '()))
+
+    (define from-cache
+      (call-with-temporary-directory
+       (lambda (cache)
+         (generate-package-cache cache)
+         (mock ((guix describe) current-profile (const cache))
+               (mock ((gnu packages) cache-is-authoritative? (const #t))
+                     (fold-available-packages (lambda* (name version result
+                                                             #:rest rest)
+                                                (cons (cons* name version rest)
+                                                      result))
+                                              '()))))))
+
+    (lset= equal? no-cache from-cache)))
+
 (test-assert "find-packages-by-name"
   (match (find-packages-by-name "hello")
     (((? (cut eq? hello <>))) #t)
@@ -1005,6 +1027,24 @@
     (((? (cut eq? hello <>))) #t)
     (wrong (pk 'find-packages-by-name wrong #f))))
 
+(test-equal "find-packages-by-name with cache"
+  (find-packages-by-name "guile")
+  (call-with-temporary-directory
+   (lambda (cache)
+     (generate-package-cache cache)
+     (mock ((guix describe) current-profile (const cache))
+           (mock ((gnu packages) cache-is-authoritative? (const #t))
+                 (find-packages-by-name "guile"))))))
+
+(test-equal "find-packages-by-name + version, with cache"
+  (find-packages-by-name "guile" "2")
+  (call-with-temporary-directory
+   (lambda (cache)
+     (generate-package-cache cache)
+     (mock ((guix describe) current-profile (const cache))
+           (mock ((gnu packages) cache-is-authoritative? (const #t))
+                 (find-packages-by-name "guile" "2"))))))
+
 (test-assert "--search-paths with pattern"
   ;; Make sure 'guix package --search-paths' correctly reports environment
   ;; variables when file patterns are used (in particular, it must follow
@@ -1113,6 +1153,29 @@
     (lambda (key . args)
       key)))
 
+(test-equal "find-package-locations"
+  (map (lambda (package)
+         (cons (package-version package)
+               (package-location package)))
+       (find-packages-by-name "guile"))
+  (find-package-locations "guile"))
+
+(test-equal "find-package-locations with cache"
+  (map (lambda (package)
+         (cons (package-version package)
+               (package-location package)))
+       (find-packages-by-name "guile"))
+  (call-with-temporary-directory
+   (lambda (cache)
+     (generate-package-cache cache)
+     (mock ((guix describe) current-profile (const cache))
+           (mock ((gnu packages) cache-is-authoritative? (const #t))
+                 (find-package-locations "guile"))))))
+
+(test-equal "specification->location"
+  (package-location (specification->package "guile@2"))
+  (specification->location "guile@2"))
+
 (test-end "packages")
 
 ;;; Local Variables:
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 1f9bbd099d..9a05030aff 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -330,7 +330,7 @@
 
 (test-assert "package->manifest-entry, search paths"
   ;; See <http://bugs.gnu.org/22073>.
-  (let ((mpl (@ (gnu packages python) python2-matplotlib)))
+  (let ((mpl (@ (gnu packages python-xyz) python2-matplotlib)))
     (lset= eq?
            (package-transitive-native-search-paths mpl)
            (manifest-entry-search-paths
@@ -591,6 +591,36 @@
       (built-derivations (list drv))
       (return (readlink (readlink (string-append profile "/dangling")))))))
 
+(test-equalm "profile in profile"
+  '("foo" "0")
+
+  ;; Make sure we can build a profile that has another profile has one of its
+  ;; entries.  The new profile's /manifest and /etc/profile must override the
+  ;; other's.
+  (mlet* %store-monad
+      ((prof0 (profile-derivation
+               (manifest
+                (list (package->manifest-entry %bootstrap-guile)))
+               #:hooks '()
+               #:locales? #f))
+       (prof1 (profile-derivation
+               (manifest (list (manifest-entry
+                                 (name "foo")
+                                 (version "0")
+                                 (item prof0))))
+               #:hooks '()
+               #:locales? #f)))
+    (mbegin %store-monad
+      (built-derivations (list prof1))
+      (let ((out (derivation->output-path prof1)))
+        (return (and (file-exists?
+                      (string-append out "/bin/guile"))
+                     (let ((manifest (profile-manifest out)))
+                       (match (manifest-entries manifest)
+                         ((entry)
+                          (list (manifest-entry-name entry)
+                                (manifest-entry-version entry)))))))))))
+
 (test-end "profiles")
 
 ;;; Local Variables: