diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/packages.scm | 31 | ||||
| -rw-r--r-- | tests/records.scm | 47 | ||||
| -rw-r--r-- | tests/syscalls.scm | 14 |
3 files changed, 84 insertions, 8 deletions
diff --git a/tests/packages.scm b/tests/packages.scm index bd5ba3ee92..65e5cc3cdd 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -42,6 +42,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-64) #:use-module (rnrs io ports) #:use-module (ice-9 regex) @@ -248,6 +249,36 @@ (string=? (derivation->output-path drv) (package-output %store package "out"))))) +(test-assert "patch not found yields a run-time error" + (guard (c ((condition-has-type? c &message) + (and (string-contains (condition-message c) + "does-not-exist.patch") + (string-contains (condition-message c) + "not found")))) + (let ((p (package + (inherit (dummy-package "p")) + (source (origin + (method (const #f)) + (uri "http://whatever") + (patches + (list (search-patch "does-not-exist.patch"))) + (sha256 + (base32 + "0amn0bbwqvsvvsh6drfwz20ydc2czk374lzw5kksbh6bf78k4ks4"))))))) + (package-derivation %store p) + #f))) + +(test-assert "reference to non-existent output" + ;; See <http://bugs.gnu.org/19630>. + (let* ((dep (dummy-package "dep")) + (p (dummy-package "p" + (inputs `(("dep" ,dep "non-existent")))))) + (guard (c ((derivation-missing-output-error? c) + (and (string=? (derivation-missing-output c) "non-existent") + (equal? (package-derivation %store dep) + (derivation-error-derivation c))))) + (package-derivation %store p)))) + (test-assert "trivial" (let* ((p (package (inherit (dummy-package "trivial")) (build-system trivial-build-system) diff --git a/tests/records.scm b/tests/records.scm index e90d33d15d..a00e38db7d 100644 --- a/tests/records.scm +++ b/tests/records.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -139,6 +139,51 @@ (parameterize ((mark (cons 'a 'b))) (eq? (foo-baz y) (mark)))))))) +(test-assert "define-record-type* & delayed" + (begin + (define-record-type* <foo> foo make-foo + foo? + (bar foo-bar (delayed))) + + (let* ((calls 0) + (x (foo (bar (begin (set! calls (1+ calls)) 3))))) + (and (zero? calls) + (equal? (foo-bar x) 3) (= 1 calls) + (equal? (foo-bar x) 3) (= 1 calls) + (equal? (foo-bar x) 3) (= 1 calls))))) + +(test-assert "define-record-type* & delayed & default" + (let ((mark #f)) + (define-record-type* <foo> foo make-foo + foo? + (bar foo-bar (delayed) (default mark))) + + (let ((x (foo))) + (set! mark 42) + (and (equal? (foo-bar x) 42) + (begin + (set! mark 7) + (equal? (foo-bar x) 42)))))) + +(test-assert "define-record-type* & delayed & inherited" + (begin + (define-record-type* <foo> foo make-foo + foo? + (bar foo-bar (delayed)) + (baz foo-baz (delayed))) + + (let* ((m 1) + (n #f) + (x (foo (bar m) (baz n))) + (y (foo (inherit x) (baz 'b)))) + (set! n 'a) + (and (equal? (foo-bar x) 1) + (eq? (foo-baz x) 'a) + (begin + (set! m 777) + (equal? (foo-bar y) 1)) ;promise was already forced + (eq? (foo-baz y) 'b))))) + (test-assert "define-record-type* & missing initializers" (catch 'syntax-error (lambda () diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 21d6637ff6..f26331e164 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -91,15 +91,15 @@ (system-error-errno args))))) (test-skip (if (zero? (getuid)) 1 0)) -(test-equal "set-network-interface-flags" - EPERM +(test-assert "set-network-interface-flags" (let ((sock (socket AF_INET SOCK_STREAM 0))) (catch 'system-error (lambda () (set-network-interface-flags sock "lo" IFF_UP)) (lambda args (close-port sock) - (system-error-errno args))))) + ;; We get EPERM with Linux 3.18ish and EACCES with 2.6.32. + (memv (system-error-errno args) (list EPERM EACCES)))))) (test-equal "network-interface-address lo" (make-socket-address AF_INET (inet-pton AF_INET "127.0.0.1") 0) @@ -108,8 +108,7 @@ (close-port sock) addr)) -(test-equal "set-network-interface-address" - EPERM +(test-assert "set-network-interface-address" (let ((sock (socket AF_INET SOCK_STREAM 0))) (catch 'system-error (lambda () @@ -120,7 +119,8 @@ 0))) (lambda args (close-port sock) - (system-error-errno args))))) + ;; We get EPERM with Linux 3.18ish and EACCES with 2.6.32. + (memv (system-error-errno args) (list EPERM EACCES)))))) (test-end) |