summary refs log tree commit diff
path: root/tests
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2017-03-19 18:52:01 -0400
committerMark H Weaver <mhw@netris.org>2017-03-19 18:52:12 -0400
commitf67337e23ec16b1e05fcdcc7953f68f13ed6770a (patch)
tree766e98a6c4695228f0a066accf91f639791dad68 /tests
parentb99eec83b861f6bee7afb7bd6ffcbdddd8f62b65 (diff)
parente05fc441cd5528ba6c83b6371c27c1e87dd393e9 (diff)
downloadguix-f67337e23ec16b1e05fcdcc7953f68f13ed6770a.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/base16.scm34
-rw-r--r--tests/gexp.scm39
-rw-r--r--tests/guix-build.sh4
-rw-r--r--tests/hash.scm2
-rw-r--r--tests/nar.scm12
-rw-r--r--tests/pack.scm3
-rw-r--r--tests/pk-crypto.scm3
-rw-r--r--tests/profiles.scm31
-rw-r--r--tests/utils.scm9
9 files changed, 112 insertions, 25 deletions
diff --git a/tests/base16.scm b/tests/base16.scm
new file mode 100644
index 0000000000..a64b650bec
--- /dev/null
+++ b/tests/base16.scm
@@ -0,0 +1,34 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2017 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-base16)
+  #:use-module (guix base16)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64)
+  #:use-module (rnrs bytevectors))
+
+(test-begin "base16")
+
+(test-assert "bytevector->base16-string->bytevector"
+  (every (lambda (bv)
+           (equal? (base16-string->bytevector
+                    (bytevector->base16-string bv))
+                   bv))
+         (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))))
+
+(test-end "base16")
diff --git a/tests/gexp.scm b/tests/gexp.scm
index baf78837ae..b3f7323984 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -598,6 +598,23 @@
                             get-bytevector-all))))
                 files))))))
 
+(test-assertm "imported-files with file-like objects"
+  (mlet* %store-monad ((plain -> (plain-file "foo" "bar!"))
+                       (q-scm -> (search-path %load-path "ice-9/q.scm"))
+                       (files -> `(("a/b/c" . ,q-scm)
+                                   ("p/q"   . ,plain)))
+                       (drv      (imported-files files)))
+    (mbegin %store-monad
+      (built-derivations (list drv))
+      (mlet %store-monad ((dir -> (derivation->output-path drv))
+                          (plain* (text-file "foo" "bar!"))
+                          (q-scm* (interned-file q-scm "c")))
+        (return
+         (and (string=? (readlink (string-append dir "/a/b/c"))
+                        q-scm*)
+              (string=? (readlink (string-append dir "/p/q"))
+                        plain*)))))))
+
 (test-equal "gexp-modules & ungexp"
   '((bar) (foo))
   ((@@ (guix gexp) gexp-modules)
@@ -668,6 +685,28 @@
                      (equal? '(chdir "/foo")
                              (call-with-input-file b read))))))))
 
+(test-assertm "gexp->derivation & with-imported-module & computed module"
+  (mlet* %store-monad
+      ((module -> (scheme-file "x" #~(begin
+                                       (define-module (foo bar)
+                                         #:export (the-answer))
+
+                                       (define the-answer 42))))
+       (build -> (with-imported-modules `(((foo bar) => ,module)
+                                          (guix build utils))
+                   #~(begin
+                       (use-modules (guix build utils)
+                                    (foo bar))
+                       mkdir-p
+                       (call-with-output-file #$output
+                         (lambda (port)
+                           (write the-answer port))))))
+       (drv      (gexp->derivation "thing" build))
+       (out ->   (derivation->output-path drv)))
+    (mbegin %store-monad
+      (built-derivations (list drv))
+      (return (= 42 (call-with-input-file out read))))))
+
 (test-assertm "gexp->derivation #:references-graphs"
   (mlet* %store-monad
       ((one (text-file "one" (random-text)))
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index e1ec560641..ab911b7210 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -160,7 +160,7 @@ rm -f "$result"
 guix build coreutils --target=mips64el-linux-gnu --dry-run --no-substitutes
 
 # Replacements.
-drv1=`guix build guix --with-input=guile=guile-next -d`
+drv1=`guix build guix --with-input=guile@2.0=guile@2.2 -d`
 drv2=`guix build guix -d`
 test "$drv1" != "$drv2"
 
diff --git a/tests/hash.scm b/tests/hash.scm
index 86501dca2d..b189e435c8 100644
--- a/tests/hash.scm
+++ b/tests/hash.scm
@@ -18,7 +18,7 @@
 
 (define-module (test-hash)
   #:use-module (guix hash)
-  #:use-module (guix utils)
+  #:use-module (guix base16)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-64)
diff --git a/tests/nar.scm b/tests/nar.scm
index 28ead8b783..61646db964 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -35,6 +35,7 @@
   #:use-module (srfi srfi-64)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 regex)
+  #:use-module ((ice-9 control) #:select (let/ec))
   #:use-module (ice-9 match))
 
 ;; Test the (guix nar) module.
@@ -148,17 +149,6 @@
   (string-append (dirname (search-path %load-path "pre-inst-env"))
                  "/test-nar-" (number->string (getpid))))
 
-(define-syntax-rule (let/ec k exp...)
-  ;; This one appeared in Guile 2.0.9, so provide a copy here.
-  (let ((tag (make-prompt-tag)))
-    (call-with-prompt tag
-      (lambda ()
-        (let ((k (lambda args
-                   (apply abort-to-prompt tag args))))
-          exp...))
-      (lambda (_ . args)
-        (apply values args)))))
-
 
 (test-begin "nar")
 
diff --git a/tests/pack.scm b/tests/pack.scm
index de9ef8e6ab..eb643c3229 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -42,7 +42,8 @@
 (define %gzip-compressor
   ;; Compressor that uses the bootstrap 'gzip'.
   ((@ (guix scripts pack) compressor) "gzip"
-   %bootstrap-coreutils&co "gz" '("gzip" "-6n")))
+   "gz"
+   #~(#+(file-append %bootstrap-coreutils&co "/bin/gzip") "-6n")))
 
 (define %tar-bootstrap %bootstrap-coreutils&co)
 
diff --git a/tests/pk-crypto.scm b/tests/pk-crypto.scm
index 5024a15a43..fe33a6f7b5 100644
--- a/tests/pk-crypto.scm
+++ b/tests/pk-crypto.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,6 +19,7 @@
 (define-module (test-pk-crypto)
   #:use-module (guix pk-crypto)
   #:use-module (guix utils)
+  #:use-module (guix base16)
   #:use-module (guix hash)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 5536364889..d0b1e14a86 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 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -212,6 +212,35 @@
                                        #:locales? #f)))
     (return (derivation-inputs drv))))
 
+(test-assertm "profile-derivation, cross-compilation"
+  (mlet* %store-monad
+      ((manifest -> (packages->manifest (list packages:sed packages:grep)))
+       (target ->   "arm-linux-gnueabihf")
+       (grep        (package->cross-derivation packages:grep target))
+       (sed         (package->cross-derivation packages:sed target))
+       (locales     (package->derivation packages:glibc-utf8-locales))
+       (drv         (profile-derivation manifest
+                                        #:hooks '()
+                                        #:locales? #t
+                                        #:target target)))
+    (define (find-input name)
+      (let ((name (string-append name ".drv")))
+        (any (lambda (input)
+               (let ((input (derivation-input-path input)))
+                 (and (string-suffix? name input) input)))
+             (derivation-inputs drv))))
+
+    ;; The inputs for grep and sed should be cross-build derivations, but that
+    ;; for the glibc-utf8-locales should be a native build.
+    (return (and (string=? (derivation-system drv) (%current-system))
+                 (string=? (find-input (package-full-name packages:grep))
+                           (derivation-file-name grep))
+                 (string=? (find-input (package-full-name packages:sed))
+                           (derivation-file-name sed))
+                 (string=? (find-input
+                            (package-full-name packages:glibc-utf8-locales))
+                           (derivation-file-name locales))))))
+
 (test-assert "package->manifest-entry defaults to \"out\""
   (let ((outputs (package-outputs packages:glibc)))
     (equal? (manifest-entry-output
diff --git a/tests/utils.scm b/tests/utils.scm
index bcfaa14faa..035886dd16 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;;
@@ -36,13 +36,6 @@
 
 (test-begin "utils")
 
-(test-assert "bytevector->base16-string->bytevector"
-  (every (lambda (bv)
-           (equal? (base16-string->bytevector
-                    (bytevector->base16-string bv))
-                   bv))
-         (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))))
-
 (test-assert "gnu-triplet->nix-system"
   (let ((samples '(("i586-gnu0.3" "i686-gnu")
                    ("x86_64-unknown-linux-gnu" "x86_64-linux")