Merge branch 'master' into core-updates

7 files changed, 187 insertions, 0 deletions

diff --git a/tests/gexp.scm b/tests/gexp.scm
index 03a64fa6bb..214e7a5302 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -207,6 +207,47 @@
                (e3 `(display ,txt)))
            (equal? `(begin ,e0 ,e1 ,e2 ,e3) (gexp->sexp* exp))))))
 
+(test-assert "file-append"
+  (let* ((drv (package-derivation %store %bootstrap-guile))
+         (fa  (file-append %bootstrap-guile "/bin/guile"))
+         (exp #~(here we go #$fa)))
+    (and (match (gexp->sexp* exp)
+           (('here 'we 'go (? string? result))
+            (string=? result
+                      (string-append (derivation->output-path drv)
+                                     "/bin/guile"))))
+         (match (gexp-inputs exp)
+           (((thing "out"))
+            (eq? thing fa))))))
+
+(test-assert "file-append, output"
+  (let* ((drv (package-derivation %store glibc))
+         (fa  (file-append glibc "/lib" "/debug"))
+         (exp #~(foo #$fa:debug)))
+    (and (match (gexp->sexp* exp)
+           (('foo (? string? result))
+            (string=? result
+                      (string-append (derivation->output-path drv "debug")
+                                     "/lib/debug"))))
+         (match (gexp-inputs exp)
+           (((thing "debug"))
+            (eq? thing fa))))))
+
+(test-assert "file-append, nested"
+  (let* ((drv   (package-derivation %store glibc))
+         (dir   (file-append glibc "/bin"))
+         (slash (file-append dir "/"))
+         (file  (file-append slash "getent"))
+         (exp   #~(foo #$file)))
+    (and (match (gexp->sexp* exp)
+           (('foo (? string? result))
+            (string=? result
+                      (string-append (derivation->output-path drv)
+                                     "/bin/getent"))))
+         (match (gexp-inputs exp)
+           (((thing "out"))
+            (eq? thing file))))))
+
 (test-assert "ungexp + ungexp-native"
   (let* ((exp    (gexp (list (ungexp-native %bootstrap-guile)
                              (ungexp coreutils)
@@ -338,6 +379,18 @@
     (return (and (equal? sexp (call-with-input-file out read))
                  (equal? (list guile) refs)))))
 
+(test-assertm "gexp->file + file-append"
+  (mlet* %store-monad ((exp -> #~#$(file-append %bootstrap-guile
+                                                "/bin/guile"))
+                       (guile  (package-file %bootstrap-guile))
+                       (drv    (gexp->file "foo" exp))
+                       (out -> (derivation->output-path drv))
+                       (done   (built-derivations (list drv)))
+                       (refs   ((store-lift references) out)))
+    (return (and (equal? (string-append guile "/bin/guile")
+                         (call-with-input-file out read))
+                 (equal? (list guile) refs)))))
+
 (test-assertm "gexp->derivation"
   (mlet* %store-monad ((file    (text-file "foo" "Hello, world!"))
                        (exp ->  (gexp
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 6d4f97019a..9e9788bca0 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -93,6 +93,9 @@ cat > "$module_dir/foo.scm"<<EOF
 (define-public baz
   (dummy-package "baz" (replacement foo)))
 
+(define-public superseded
+  (deprecated-package "superseded" bar))
+
 EOF
 
 GUIX_PACKAGE_PATH="$module_dir"
@@ -168,6 +171,9 @@ test "$drv1" = "$drv2"
 if guix build guile --with-input=libunistring=something-really-silly
 then false; else true; fi
 
+# Deprecated/superseded packages.
+test "`guix build superseded -d`" = "`guix build bar -d`"
+
 # Parsing package names and versions.
 guix build -n time		# PASS
 guix build -n time@1.7		# PASS, version found
diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh
index 23df01d417..44213d51af 100644
--- a/tests/guix-hash.sh
+++ b/tests/guix-hash.sh
@@ -1,5 +1,6 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -46,3 +47,18 @@ then false; else true; fi
 # the archive format doesn't support.
 if guix hash -r /dev/null
 then false; else true; fi
+
+# Adding a .git directory
+mkdir "$tmpdir/.git"
+touch "$tmpdir/.git/foo"
+
+# ...changes the hash
+test `guix hash -r $tmpdir` = 0a50z04zyzf7pidwxv0nwbj82pgzbrhdy9562kncnvkcfvb48m59
+
+# ...but remains the same when using `-x'
+test `guix hash -r $tmpdir -x` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
+
+# Without '-r', this should fail.
+if guix hash "$tmpdir"
+then false; else true; fi
+
diff --git a/tests/import-utils.scm b/tests/import-utils.scm
index 3b11875c4a..8d44b9e0e2 100644
--- a/tests/import-utils.scm
+++ b/tests/import-utils.scm
@@ -20,6 +20,7 @@
 (define-module (test-import-utils)
   #:use-module (guix tests)
   #:use-module (guix import utils)
+  #:use-module ((guix licenses) #:prefix license:)
   #:use-module (srfi srfi-64))
 
 (test-begin "import-utils")
@@ -33,4 +34,8 @@
   "This package provides a function to establish world peace"
   (beautify-description "A function to establish world peace"))
 
+(test-equal "license->symbol"
+  'license:lgpl2.0
+  (license->symbol license:lgpl2.0))
+
 (test-end "import-utils")
diff --git a/tests/modules.scm b/tests/modules.scm
new file mode 100644
index 0000000000..04945e531b
--- /dev/null
+++ b/tests/modules.scm
@@ -0,0 +1,45 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-modules)
+  #:use-module (guix modules)
+  #:use-module ((guix build-system gnu) #:select (%gnu-build-system-modules))
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64))
+
+(test-begin "modules")
+
+(test-assert "closure of (guix build gnu-build-system)"
+  (lset= equal?
+         (live-module-closure '((guix build gnu-build-system)))
+         (source-module-closure '((guix build gnu-build-system)))
+         %gnu-build-system-modules
+         (source-module-closure %gnu-build-system-modules)
+         (live-module-closure %gnu-build-system-modules)))
+
+(test-assert "closure of (gnu build install)"
+  (lset= equal?
+         (live-module-closure '((gnu build install)))
+         (source-module-closure '((gnu build install)))))
+
+(test-assert "closure of (gnu build vm)"
+  (lset= equal?
+         (live-module-closure '((gnu build vm)))
+         (source-module-closure '((gnu build vm)))))
+
+(test-end)
diff --git a/tests/packages.scm b/tests/packages.scm
index daceea5d62..b8e1f111cd 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -49,6 +49,7 @@
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-64)
   #:use-module (rnrs io ports)
+  #:use-module (ice-9 vlist)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match))
 
@@ -83,6 +84,64 @@
   (and (hidden-package? (hidden-package (dummy-package "foo")))
        (not (hidden-package? (dummy-package "foo")))))
 
+(test-assert "package-superseded"
+  (let* ((new (dummy-package "bar"))
+         (old (deprecated-package "foo" new)))
+    (and (eq? (package-superseded old) new)
+         (mock ((gnu packages) find-best-packages-by-name (const (list old)))
+               (specification->package "foo")
+               (and (eq? new (specification->package "foo"))
+                    (eq? new (specification->package+output "foo")))))))
+
+(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))
+                    ((@@ (guix scripts package) transaction-upgrade-entry)
+                     (manifest-entry
+                       (inherit (package->manifest-entry old))
+                       (item (string-append (%store-prefix) "/"
+                                            (make-string 32 #\e) "-foo-1")))
+                     (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-newest-available-packages
+                     (const (vhash-cons "foo" (list "2" new) vlist-null)))
+                    ((@@ (guix scripts package) transaction-upgrade-entry)
+                     (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" "2" "out" item))
+            (eq? item new)))
+         (null? (manifest-transaction-remove tx)))))
+
+(test-assert "transaction-upgrade-entry, superseded package"
+  (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)))
+                    ((@@ (guix scripts package) transaction-upgrade-entry)
+                     (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> "bar" "2" "out" item))
+            (eq? item new)))
+         (match (manifest-transaction-remove tx)
+           (((? manifest-pattern? pattern))
+            (and (string=? (manifest-pattern-name pattern) "foo")
+                 (string=? (manifest-pattern-version pattern) "1")
+                 (string=? (manifest-pattern-output pattern) "out")))))))
+
 (test-assert "package-field-location"
   (let ()
     (define (goto port line column)
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 028d7b6fb4..f9c2f5499e 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -187,6 +187,9 @@
       (and (null? remove) (null? install) (null? downgrade)
            (equal? (list (cons guile-2.0.9 guile-2.0.9)) upgrade)))))
 
+(test-assert "manifest-transaction-null?"
+  (manifest-transaction-null? (manifest-transaction)))
+
 (test-assertm "profile-derivation"
   (mlet* %store-monad
       ((entry ->   (package->manifest-entry %bootstrap-guile))