summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/gexp.scm53
-rw-r--r--tests/guix-build.sh6
-rw-r--r--tests/guix-hash.sh16
-rw-r--r--tests/import-utils.scm5
-rw-r--r--tests/modules.scm45
-rw-r--r--tests/packages.scm59
-rw-r--r--tests/profiles.scm3
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))
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-05 08:27:00 +0000