summaryrefslogtreecommitdiff
path: root/test-suite
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite')
-rw-r--r--test-suite/tests/modules.test4
-rw-r--r--test-suite/tests/reader.test1
-rw-r--r--test-suite/tests/srfi-4.test42
-rw-r--r--test-suite/tests/web-request.test4
4 files changed, 49 insertions, 2 deletions
diff --git a/test-suite/tests/modules.test b/test-suite/tests/modules.test
index 5f34d9e70..79e3c98e9 100644
--- a/test-suite/tests/modules.test
+++ b/test-suite/tests/modules.test
@@ -290,6 +290,10 @@
(import2 (make-module))
(handler-invoked? #f)
(handler (lambda (module name int1 val1 int2 val2 var val)
+ ;; We expect both VAR and VAL to be #f, as there
+ ;; is no previous binding for 'imported in M.
+ (if var (error "unexpected var" var))
+ (if val (error "unexpected val" val))
(set! handler-invoked? #t)
;; Keep the first binding.
(or var (module-local-variable int1 name)))))
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index f350e73a6..437706b00 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -428,6 +428,7 @@
(with-test-prefix "#{}#"
(pass-if (equal? (read-string "#{}#") '#{}#))
+ (pass-if (not (equal? (read-string "(a #{.}# b)") '(a . b))))
(pass-if (equal? (read-string "#{a}#") 'a))
(pass-if (equal? (read-string "#{a b}#") '#{a b}#))
(pass-if-exception "#{" exception:eof-in-symbol
diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test
index 3a0710222..2e7f0d5f5 100644
--- a/test-suite/tests/srfi-4.test
+++ b/test-suite/tests/srfi-4.test
@@ -436,7 +436,26 @@
(make-c32vector 4 7)))
(pass-if "+inf.0, -inf.0, +nan.0 in c32vector"
- (c32vector? #c32(+inf.0 -inf.0 +nan.0))))
+ (c32vector? #c32(+inf.0 -inf.0 +nan.0)))
+
+ (pass-if "generalized-vector-ref"
+ (let ((v (c32vector 1+1i)))
+ (= (c32vector-ref v 0)
+ (generalized-vector-ref v 0))))
+
+ (pass-if "generalized-vector-set!"
+ (let ((x 1+1i)
+ (v (c32vector 0)))
+ (generalized-vector-set! v 0 x)
+ (= x (generalized-vector-ref v 0))))
+
+ (pass-if-exception "generalized-vector-ref, out-of-range"
+ exception:out-of-range
+ (generalized-vector-ref (c32vector 1.0) 1))
+
+ (pass-if-exception "generalized-vector-set!, out-of-range"
+ exception:out-of-range
+ (generalized-vector-set! (c32vector 1.0) 1 2.0)))
(with-test-prefix "c64 vectors"
@@ -476,4 +495,23 @@
(make-c64vector 4 7)))
(pass-if "+inf.0, -inf.0, +nan.0 in c64vector"
- (c64vector? #c64(+inf.0 -inf.0 +nan.0))))
+ (c64vector? #c64(+inf.0 -inf.0 +nan.0)))
+
+ (pass-if "generalized-vector-ref"
+ (let ((v (c64vector 1+1i)))
+ (= (c64vector-ref v 0)
+ (generalized-vector-ref v 0))))
+
+ (pass-if "generalized-vector-set!"
+ (let ((x 1+1i)
+ (v (c64vector 0)))
+ (generalized-vector-set! v 0 x)
+ (= x (generalized-vector-ref v 0))))
+
+ (pass-if-exception "generalized-vector-ref, out-of-range"
+ exception:out-of-range
+ (generalized-vector-ref (c64vector 1.0) 1))
+
+ (pass-if-exception "generalized-vector-set!, out-of-range"
+ exception:out-of-range
+ (generalized-vector-set! (c64vector 1.0) 1 2.0)))
diff --git a/test-suite/tests/web-request.test b/test-suite/tests/web-request.test
index e1eec2f74..8cf1c2e87 100644
--- a/test-suite/tests/web-request.test
+++ b/test-suite/tests/web-request.test
@@ -47,6 +47,10 @@ Accept-Language: en-gb, en;q=0.9\r
(set! r (read-request (open-input-string example-1)))
(request? r)))
+ (pass-if (equal?
+ (request-host (build-request (string->uri "http://www.gnu.org/")))
+ '("www.gnu.org" . #f)))
+
(pass-if (equal? (request-method r) 'GET))
(pass-if (equal? (request-uri r) (build-uri 'http #:path "/qux")))