tests, chibi support

1 files changed, 825 insertions, 0 deletions

diff --git a/lib/tests/hascheme/base.sld b/lib/tests/hascheme/base.sld
new file mode 100644
index 0000000..4ce4c79
--- /dev/null
+++ b/lib/tests/hascheme/base.sld
@@ -0,0 +1,825 @@
+(define-library (tests hascheme base)
+  (import (scheme base)
+          (hascheme implementation-support)
+          (hascheme support)
+          (prefix (hascheme base) h:))
+  (cond-expand
+    (chicken (import (srfi 64) (chicken condition)))
+    (chibi (import (except (chibi test) test test-equal)
+                   (rename (only (chibi test) test) (test test-equal))))
+    (else (import (srfi 64))))
+  (export test-base)
+  (begin
+    (define-syntax h:set!
+      (syntax-rules ()
+        ((_ name value) (delay (set! name value)))))
+    (define (test-base)
+      (test-group "SRFI-45" (test-srfi-45))
+      (test-group "preliminaries" (test-preliminaries))
+      (test-group "lambda" (test-lambda))
+      (test-group "if" (test-if))
+      (test-group "cond" (test-cond))
+      (test-group "do" (test-do))
+      (test-group "case" (test-case))
+      (test-group "and" (test-and))
+      (test-group "or" (test-or))
+      (test-group "when and unless" (test-when-and-unless))
+      (test-group "record types" (test-record-types))
+      (test-group "apply" (test-apply))
+      (test-group "floor/" (test-converted-number-function h:floor/
+                                                           -5 2
+                                                           '(-3 1)))
+      (test-group "truncate/" (test-converted-number-function h:truncate/
+                                                              -5 2
+                                                              '(-2 -1)))
+      (test-group "exact-integer-sqrt" (test-exact-integer-sqrt))
+      (test-group "equal?" (my-test-equal?))
+      (test-group "wrappers from strict" (test-wrappers-from-strict))
+      (test-group "constructors" (test-constructors))
+      (test-group "binary wrappers" (test-binary-wrappers))
+      (test-group "vector-map" (test-vector-map))
+      (test-group "list?" (test-list?))
+      (test-group "make-list" (test-make-list))
+      (test-group "length" (test-length))
+      (test-group "append" (test-append))
+      (test-group "reverse" (test-reverse))
+      (test-group "list-tail" (test-list-tail))
+      (test-group "list-ref" (test-list-ref))
+      (test-group "member" (test-member))
+      (test-group "assoc" (test-assoc))
+      (test-group "map" (test-map))
+      (test-group "list->string" (test-list->string))
+      (test-group "make-vector" (test-make-vector))
+      (test-group "list->vector" (test-list->vector))
+      (test-group "list-copy" (test-list-copy))
+      (test-group "other binding constructors" (test-other-binding-constructs)))
+    (define (test-srfi-45)
+      #| These tests are taken from SRFI-45.
+
+Copyright (C) André van Tonder (2003). All Rights Reserved.
+
+Permission is hereby granted, free of charge, to any person obtaining a
+copy of this software and associated documentation files (the "Software"),
+to deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute, sublicense,
+and/or sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+ DEALINGS IN THE SOFTWARE. |#
+      (test-group "memo 1"
+        (let* ((effect 0)
+               (expr (delay (begin (set! effect (+ effect 1)) 10))))
+          (test-equal 10 (force expr))
+          (test-equal 1 effect)
+          (test-equal 10 (force expr))
+          (test-equal 1 effect)))
+      (test-group "memo 2"
+        (let* ((effect 0)
+               (expr (delay (begin (set! effect (+ effect 1)) 2))))
+          (test-equal 4 (+ (force expr) (force expr)))
+          (test-equal 1 effect)))
+      (test-group "memo 3"
+        (let* ((effect 0)
+               (r (delay (begin (set! effect (+ effect 1)) 1)))
+               (s (delay-force r))
+               (t (delay-force s)))
+          (test-equal 1 (force s))
+          (test-equal 1 (force t))
+          (test-equal 1 effect)))
+      (test-group "memo 4"
+        (letrec* ((effect 0)
+                  (stream-drop (lambda (s index)
+                                 (delay-force
+                                  (if (zero? index)
+                                      s
+                                      (stream-drop (cdr (force s))
+                                                   (- index 1))))))
+                  (ones (lambda () (delay (begin
+                                            (set! effect (+ effect 1))
+                                            (cons 1 (ones))))))
+                  (s (ones)))
+          (test-equal 0 effect)
+          (test-equal 1 (car (force (stream-drop s 4))))
+          (test-equal "effect, 1" 5 effect)
+          (test-equal 1 (car (force (stream-drop s 4))))
+          (test-equal "effect, 2" 5 effect)
+          (test-equal 1 (car (force (stream-drop s 4))))
+          (test-equal "effect, 3" 5 effect)))
+      (test-group "reenter 1"
+        (letrec* ((count 0)
+                  (p (delay (begin (set! count (+ count 1))
+                                   (if (> count x)
+                                       count
+                                       (force p)))))
+                  (x 5))
+          (test-equal 6 (force p))
+          (set! x 10)
+          (test-equal 6 (force p))))
+      (test-group "reenter 2"
+        (letrec* ((first? #t)
+                  (f (delay (if first?
+                                (begin
+                                  (set! first? #f)
+                                  (force f))
+                                'second))))
+          (test-equal 'second (force f))))
+      (test-group "reenter 3"
+        (letrec* ((count 5)
+                  (p (delay (if (<= count 0)
+                                count
+                                (begin (set! count (- count 1))
+                                       (force p)
+                                       (set! count (- count 2))
+                                       count)))))
+          (test-assert 5 count)
+          (test-assert 0 (force p))
+          (test-assert 10 count))))
+    (define (test-preliminaries)
+      (test-assert "promises are a distinct type"
+        (let ((x (make-promise #t)))
+          (and (not (or (procedure? x)
+                        (pair? x)
+                        (vector? x)))
+               (promise? x))))
+      (test-assert "forcing a value is valid"
+        (let ((ok (lambda (x) (equal? (force x) x))))
+          (and (ok #t)
+               (ok #\x)
+               (ok 0)
+               (ok "a")
+               (ok 'a)
+               (ok '(1 2 3))
+               (ok '#(1 2 3))
+               (ok (list 1 2 3))
+               (ok (vector 1 2 3))
+               (ok '())
+               (ok #u8(1 2 3))
+               (ok (lambda (x) x)))))
+      (let* ((x 0)
+             (expr (h:set! x (+ x 1))))
+        (test-assert "set! returns a promise"
+          (promise? expr))
+        (test-equal "set! has not run yet"
+                    0
+                    x)
+        (force expr)
+        (test-equal "set! is effectful"
+                    1
+                    x)
+        (force expr)
+        (test-equal "set! does not run more than once"
+                    1
+                    x)))
+    (define (test-lambda)
+      (test-assert "lambda returns a procedure"
+        (procedure? (h:lambda (x) x)))
+      (test-assert "application of lambda returns a promise"
+        (promise? ((h:lambda (x) x) 5)))
+      (test-equal "forcing a promise returns the value"
+                  5
+                  (force ((h:lambda (x) x) 5)))
+      (let ()
+        (h:define (id x) x)
+        (test-assert "internal define is a procedure"
+          (procedure? id)))
+      (let* ((effect 'not-run)
+             (expr (h:lambda (x y) x)))
+        (force (expr (h:set! effect 'run) (h:set! effect 'error)))
+        (test-equal "lambda is not non-strict"
+                    'run
+                    effect)))
+    (define (test-if)
+      (test-assert "if returns a promise"
+        (promise? (h:if #t #t #f)))
+      (test-equal "forcing if runs it"
+                  'true
+                  (force (h:if #t 'true 'false)))
+      (let* ((effect 'not-run)
+             (test-effect 'not-run)
+             (expr (h:if (h:seq (h:set! test-effect 'run)
+                                #f)
+                         (h:set! effect 'true)
+                         (h:set! effect 'false))))
+        (test-equal "creation of if does not run anything"
+                    'not-run
+                    effect)
+        (test-equal "creation of if does not run anything, 2"
+                    'not-run
+                    test-effect)
+        (force expr)
+        (test-equal "if is eager in the predicate"
+                    'run
+                    test-effect)
+        (test-equal "forcing if forces the path"
+                    'false
+                    effect)))
+    (define (test-let)
+      (test-equal "let works as normal"
+                  5
+                  (h:let ((x 5))
+                    x))
+      (let ((loop (h:let loop ((x 0))
+                    (if (< x 10)
+                        (loop (+ x 1))
+                        x))))
+        (test-assert "named let returns a promise"
+          (promise? loop))
+        (test-equal "forcing named let runs the promise"
+                    10
+                    (force loop))))
+    (define (test-do)
+      (let ((loop (h:do ((l '(a b c) (h:cdr l))
+                         (acc 0 (h:+ acc 1)))
+                        ((h:null? l) acc))))
+        (test-assert "do returns a promise"
+          (promise? loop))
+        (test-equal "do runs when forced"
+                    3
+                    (force loop)))
+      (let* ((effect 0)
+             (loop (h:do ((l '(a b c) (h:cdr l)))
+                         ((h:null? l))
+                     (h:set! effect (+ effect 1)))))
+        (test-equal "do has not run yet"
+                    0
+                    effect)
+        (force loop)
+        (test-equal "do runs its body for effects, fresh each time"
+                    3
+                    effect)))
+    (define (test-seq)
+      (test-assert "seq returns a promise"
+        (promise? (h:seq #t #t #t)))
+      (test-equal "seq returns its last argument"
+                  5
+                  (force (h:seq 0 1 2 3 4 5)))
+      (let ((effect1 0)
+            (effect2 0))
+        (test-equal "force has not run yet"
+                    '(0 0)
+                    (list effect1 effect2))
+        (force (h:seq (h:set! effect1 1) (h:set! effect2 2)))
+        (test-equal "seq forces all arguments"
+                    '(1 2)
+                    (list effect1 effect2))))
+    (define (test-cond)
+      ;; TODO: Test on non-CHICKEN systems.
+      (cond-expand
+        (chicken
+         (test-assert "cond returns a promise"
+           (promise? (h:cond (#t #t) (else #f))))
+         (let ((x 1))
+           (test-equal "cond works like cond"
+                       'true
+                       (force (h:cond
+                                ((h:= x 0) 0)
+                                ((h:= x 1) 'true)
+                                (else 'false)))))
+         (let* ((effect 'not-run)
+                (expr (h:cond
+                        ((h:seq (h:set! effect 'run-once)
+                                #t) #t)
+                        (else (h:set! effect 'false) #f))))
+           (test-equal "cond has not run yet"
+                       'not-run
+                       effect)
+           (test-assert "cond works like cond, 2"
+             (force expr))
+           (test-equal "cond has made an effect"
+                       'run-once
+                       effect)))))
+    (define (test-case)
+      (cond-expand
+        (chicken
+         (let ((expr (h:case 5
+                       ((1 2 3 4) 'a)
+                       ((5 6 7 8) 'b)
+                       (else 'c))))
+           (test-assert "case returns a promise"
+             (promise? expr))
+           (test-equal "case runs as normal"
+                       'b
+                       (force expr))))))
+    (define (test-and)
+      (let* ((effect 0)
+             (expr (h:and 1 2 3 (h:seq (h:set! effect 1) #f)
+                          (h:seq (h:set! effect 2) #t))))
+        (test-assert "and returns a promise"
+          (promise? expr))
+        (test-equal "and has not run yet"
+                    0
+                    effect)
+        (test-assert "and runs as normal for falses"
+          (not (force expr)))
+        (test-equal "and is non-strict"
+                    1
+                    effect))
+      (test-equal "and runs as normal for truthy"
+                  5
+                  (force (h:and 1 2 3 4 5)))
+      (test-assert "and run as normal for the zero argument case"
+        (h:and)))
+    (define (test-or)
+      (let* ((effect 0)
+             (expr (h:or #f #f #f (h:seq (h:set! effect 1) #t)
+                         (h:seq (h:set! effect 2) #f))))
+        (test-assert "or returns a promise"
+          (promise? expr))
+        (test-equal "or has not run yet"
+                    0
+                    effect)
+        (test-assert "or runs as normal for truths"
+          (force expr))
+        (test-equal "or is non-strict"
+                    1
+                    effect))
+      (test-assert "or runs as normal for falses"
+        (not (force (h:or #f #f))))
+      (test-assert "or runs as normal for the zero argument case"
+        (not (force (h:or)))))
+    (define (test-when-and-unless)
+      (let* ((effect 0)
+             (expr1 (h:when #f (h:set! effect 1)))
+             (expr2 (h:unless #t (h:set! effect 2))))
+        (test-assert "when returns a promise"
+          (promise? expr1))
+        (test-assert "unless returns a promise"
+          (promise? expr2))
+        (test-equal "neither have run yet"
+                    0
+                    effect)
+        (force expr1)
+        (test-equal "when acts as normal for false cases"
+                    0
+                    effect)
+        (force expr2)
+        (test-equal "unless acts as normal for true cases"
+                    0
+                    effect))
+      (let* ((effect 0)
+             (expr1 (h:when (h:and) (h:set! effect 1)))
+             (expr2 (h:unless (h:or) (h:set! effect 2))))
+        (force expr1)
+        (test-equal "when acts as normal for true cases"
+                    1
+                    effect)
+        (force expr2)
+        (test-equal "unless acts as normal for false cases"
+                    2
+                    effect)))
+    (define (test-record-types)
+      (h:define-record-type <test>
+        (kons kar kdr kbr)
+        kons?
+        (kar kar)
+        (kdr kdr)
+        (kbr kbr))
+      (let* ((effect 0)
+             (expr (kons (h:seq (h:set! effect 1)
+                                10)
+                         (h:seq (h:set! effect 2)
+                                20)
+                         (h:seq (h:set! effect 3)
+                                30))))
+        (test-assert "constructor returns a promise"
+          (promise? expr))
+        (test-assert "forcing returns a value that the predicate accepts"
+          (force (kons? expr)))
+        (test-equal "constructor is not strict in any argument"
+                    0
+                    effect)
+        (test-equal "accessor 2"
+                    20
+                    (force (kdr expr)))
+        (test-equal "accessor is strict in its argument"
+                    2
+                    effect)
+        (test-equal "accessor 3"
+                    30
+                    (force (kbr expr)))
+        (test-equal "accessor 3 is strict in its argument"
+                    3
+                    effect)
+        (test-equal "accessor 1"
+                    10
+                    (force (kar expr)))
+        (test-equal "accessor 1 is strict in its argument"
+                    1
+                    effect)))
+    (define (test-apply)
+      (let* ((effect 0)
+             (effect2 0)
+             (effect3 0)
+             (expr (h:apply (h:seq (h:set! effect 1) (h:lambda (x y) x))
+                            (h:seq (h:set! effect2 1) 1)
+                            (h:list (h:seq (h:set! effect3 1) 2)))))
+        (test-assert "apply returns a promise"
+          (promise? expr))
+        (test-equal "apply has not run yet"
+                    '(0 0 0)
+                    (list effect effect2 effect3))
+        (test-equal "apply runs as expected"
+                    1
+                    (force expr))
+        (test-equal "apply is strict in its first argument"
+                    1
+                    effect)
+        (test-equal "apply is strict as its input function"
+                    1
+                    effect2)
+        (test-equal "apply is not strict where its input is not"
+                    0
+                    effect3)))
+    (define (test-converted-number-function proc in1 in2 out)
+      (let* ((effect1 0)
+             (effect2 0)
+             (expr (proc (h:seq (h:set! effect1 2)
+                                in1)
+                         (h:seq (h:set! effect2 3)
+                                in2))))
+        (test-assert "returns a promise"
+          (promise? expr))
+        (test-equal "not run yet"
+                    '(0 0)
+                    (list effect1 effect2))
+        (test-equal "returns correct values"
+                    out
+                    (recursive-force expr))
+        (test-equal "effects"
+                    '(2 3)
+                    (list effect1 effect2))))
+    (define (test-exact-integer-sqrt)
+      (test-equal "works"
+                  '(2 1)
+                  (recursive-force (h:exact-integer-sqrt 5))))
+    (define (test-wrappers-from-strict)
+      (test-assert "pair?"
+        (force (h:pair? (h:cons 1 2)))))
+    (define (test-constructors)
+      (test-group "cons"
+        (let* ((effect1 0)
+               (effect2 0)
+               (expr (h:cons (h:seq (h:set! effect1 1) 1)
+                             (h:seq (h:set! effect2 1) 2))))
+          (force expr)
+          (test-equal "cons is not strict"
+                      '(0 0)
+                      (list effect1 effect2))
+          (test-equal "accessing car works"
+                      1
+                      (force (h:car expr)))
+          (test-equal "effects after car"
+                      '(1 0)
+                      (list effect1 effect2))
+          (test-equal "accessing cdr works"
+                      2
+                      (force (h:cdr expr)))
+          (test-equal "effects after cdr"
+                      '(1 1)
+                      (list effect1 effect2))
+          (test-equal "recursive force"
+                      '(1 . 2)
+                      (recursive-force expr)))))
+    (define (test-binary-wrappers)
+      (let* ((effect1 0)
+             (effect2 0)
+             (effect3 0)
+             (effect4 0)
+             (expr (h:< (h:seq (h:set! effect1 1) 1)
+                        (h:seq (h:set! effect2 1) 2)
+                        (h:seq (h:set! effect3 1) 0)
+                        (h:seq (h:set! effect4 1) 10))))
+        (test-assert "< returns a promise"
+          (promise? expr))
+        (test-equal "< has not run yet"
+                    '(0 0 0 0)
+                    (list effect1 effect2 effect3 effect4))
+        (test-assert "< works for the false case"
+          (not (force expr)))
+        (test-equal "< is not necessarily strict"
+                    '(1 1 1 0)
+                    (list effect1 effect2 effect3 effect4))))
+    (define (test-vector-map)
+      (let* ((effect1 0)
+             (effect2 0)
+             (expr (h:vector-map (h:lambda (x y) (h:+ x y))
+                                 (h:seq (h:set! effect1 1)
+                                        (h:vector 1 2 3))
+                                 (h:vector 4 5 6 (h:seq (h:set! effect2 1)
+                                                        7)))))
+        (test-assert "vector-map returns a promise"
+          (promise? expr))
+        (test-assert "vector-map forced returns a vector"
+          (vector? (force expr)))
+        (test-equal "vector-map is non-strict"
+                    '(1 0)
+                    (list effect1 effect2))
+        (test-equal "vector-map returns as expected"
+                    '#(5 7 9)
+                    (recursive-force expr))))
+    (define (my-test-equal?)
+      (test-group "equal? on equal lists"
+        (let* ((effect1 0)
+               (effect2 0)
+               (effect3 0)
+               (effect4 0)
+               (expr (h:equal? (h:list (h:seq (h:set! effect1 1) 1)
+                                       (h:seq (h:set! effect2 1) 2))
+                               (h:list (h:seq (h:set! effect3 1) 1)
+                                       (h:seq (h:set! effect4 1) 2)))))
+          (test-assert "equal" (force expr))
+          (test-equal "equal? is strict on equal values"
+                      '(1 1 1 1)
+                      (list effect1 effect2 effect3 effect4))))
+      (test-group "equal? on unequal lists"
+        (let* ((effect1 0)
+               (effect2 0)
+               (effect3 0)
+               (expr (h:equal? (h:list (h:seq (h:set! effect1 1) 1))
+                               (h:list (h:seq (h:set! effect2 1) 1)
+                                       (h:seq (h:set! effect3 1) 2)))))
+          (test-assert "not equal" (not (force expr)))
+          (test-equal "equal? is not strict in all values"
+                      '(1 1 0)
+                      (list effect1 effect2 effect3))))
+      (test-group "equal? on equal vectors"
+        (let* ((effect1 0)
+               (effect2 0)
+               (effect3 0)
+               (effect4 0)
+               (expr (h:equal? (h:vector (h:seq (h:set! effect1 1) 1)
+                                         (h:seq (h:set! effect2 1) 2))
+                               (h:vector (h:seq (h:set! effect3 1) 1)
+                                         (h:seq (h:set! effect4 1) 2)))))
+          (test-assert "equal" (force expr))
+          (test-equal "equal? is strict on equal values"
+                      '(1 1 1 1)
+                      (list effect1 effect2 effect3 effect4))))
+      (test-group "equal? on unequal vectors"
+        (let* ((effect1 0)
+               (effect2 0)
+               (effect3 0)
+               (expr (h:equal? (h:vector (h:seq (h:set! effect1 1) 1))
+                               (h:vector (h:seq (h:set! effect2 1) 1)
+                                         (h:seq (h:set! effect3 1) 2)))))
+          (test-assert "not equal" (not (force expr)))
+          (test-equal "equal? is not strict in all values"
+                      '(0 0 0)
+                      (list effect1 effect2 effect3)))))
+    (define (test-list?)
+      (let* ((effect1 0)
+             (effect2 0)
+             (expr (h:list? (h:cons (h:seq (h:set! effect1 1) 1)
+                                    (h:seq (h:set! effect2 1)
+                                           (h:cons 2 '()))))))
+        (test-equal "expression has not run yet"
+                    '(0 0)
+                    (list effect1 effect2))
+        (test-assert "list? works"
+          (force expr))
+        (test-equal "list? does not force the values of the list"
+                    '(0 1)
+                    (list effect1 effect2))))
+    (define (test-make-list)
+      (let* ((effect 0)
+             (expr (h:make-list (h:seq (h:set! effect (+ effect 1)) 5) 10)))
+        (test-assert "expr makes a list"
+          (force (h:list? expr)))
+        (test-equal "make-list is strict in its first argument"
+                    1
+                    effect)
+        (test-equal "first element"
+                    10
+                    (force (h:car expr)))
+        (test-equal "second element"
+                    10
+                    (force (h:cadr expr)))
+        (test-equal "recursive force"
+                    '(10 10 10 10 10)
+                    (recursive-force expr)))
+      (let* ((expr (h:make-list +inf.0 10)))
+        (test-equal "infinity is OK"
+                    10
+                    (force (h:cadr expr)))))
+    (define (test-length)
+      (let* ((effect1 0)
+             (effect2 0)
+             (effect3 0)
+             (expr (h:length (h:list (h:seq (h:set! effect1 1) 1)
+                                     (h:seq (h:set! effect2 1) 2)
+                                     (h:seq (h:set! effect3 1) 3)))))
+        (test-equal "length works on lists"
+                    3
+                    (force expr))
+        (test-equal "length does not force values in the list"
+                    '(0 0 0)
+                    (list effect1 effect2 effect3))))
+    (define (test-append)
+      (test-equal "zero argument case" '() (force (h:append)))
+      (test-group "single argument case"
+        (let* ((effect 0)
+               (expr (h:append (h:seq (h:set! effect 1) 1))))
+          (test-equal "returns its argument"
+                      1
+                      (force expr))))
+      (test-group "multiple lists"
+        (let* ((effect0 0)
+               (effect1 0)
+               (effect2 0)
+               (expr (h:append (h:seq (h:set! effect0 1)
+                                      (h:list (h:seq (h:set! effect1 1) 1)
+                                              2))
+                               (h:seq (h:set! effect2 1) '(3 4)))))
+          (force expr)
+          (test-equal "strict in all arguments except the last"
+                      '(1 0 0)
+                      (list effect0 effect1 effect2))
+          (test-equal "append works as expected"
+                      '(1 2 3 4)
+                      (recursive-force expr)))))
+    (define (test-reverse)
+      (let* ((effect0 0)
+             (effect1 0)
+             (expr (h:reverse (h:seq (h:set! effect0 1)
+                                     (h:list (h:seq (h:set! effect1 1) 1)
+                                             2
+                                             3)))))
+        (force expr)
+        (test-equal "reverse is strict in the pairs, not the values"
+                    '(1 0)
+                    (list effect0 effect1))
+        (test-equal "reverse works as expected"
+                    '(3 2 1)
+                    (recursive-force expr))))
+    (define (test-list-tail)
+      (let* ((effect0 0)
+             (effect1 0)
+             (effect2 0)
+             (expr (h:list-tail (h:seq (h:set! effect0 1)
+                                       (h:list (h:seq (h:set! effect1 1) 1)
+                                               2
+                                               3
+                                               4))
+                                (h:seq (h:set! effect2 1)
+                                       2))))
+        (force expr)
+        (test-equal "list-tail is strict in both arguments, pairs only"
+                    '(1 0 1)
+                    (list effect0 effect1 effect2))
+        (test-equal "list-tail works as expected"
+                    '(3 4)
+                    (recursive-force expr))
+        (test-equal "list-tail never evaluates discarded values"
+                    0
+                    effect1)))
+    (define (test-list-ref)
+      (let* ((effect0 0)
+             (effect1 0)
+             (effect2 0)
+             (effect3 0)
+             (effect4 0)
+             (expr (h:list-ref (h:seq (h:set! effect0 1)
+                                      (h:list (h:seq (h:set! effect1 1) 1)
+                                              2
+                                              (h:seq (h:set! effect2 1) 3)
+                                              (h:seq (h:set! effect3 1) 4)))
+                               (h:seq (h:set! effect4 1) 2))))
+        (test-equal "evaluated to"
+                    3
+                    (force expr))
+        (test-equal "strictness of forcing the expression"
+                    '(1 0 1 0 1)
+                    (list effect0 effect1 effect2 effect3 effect4))))
+    (define (test-member)
+      (let* ((effect 0)
+             (expr (h:member 10 (h:let loop ((x 0))
+                                  (h:seq (h:set! effect (force x))
+                                         (h:cons x (loop (h:+ x 1))))))))
+        (test-equal "member works as expected"
+                    10
+                    (force (h:car expr)))
+        (test-equal "side effects"
+                    10
+                    effect)))
+    (define (test-assoc)
+      (let* ((effect 0)
+             (expr (h:assoc 10 (h:let loop ((x 0)
+                                            (y 2))
+                                 (h:seq (h:set! effect (force x))
+                                        (h:cons (h:cons x y)
+                                                (loop (h:+ x 1)
+                                                      (h:* y 2))))))))
+        (test-equal "assoc works as expected"
+                    '(10 . 2048)
+                    (recursive-force expr))
+        (test-equal "side effects"
+                    10
+                    effect)))
+    (define (test-map)
+      (let* ((expr (h:map h:+ '(1 2 3 4) '(10 20 30 40))))
+        (test-equal "works"
+                    '(11 22 33 44)
+                    (recursive-force expr))))
+    (define (test-list->string)
+      (let* ((expr1 (h:list->string (h:list #\x #\y #\z)))
+             (expr2 (h:list->string '(#\x #\y #\z))))
+        (test-assert "works"
+          (string=? (force expr1) (force expr2) "xyz"))))
+    (define (test-make-vector)
+      (let* ((effect 0)
+             (expr (h:make-vector (h:seq (h:set! effect (+ effect 1)) 10) 0)))
+        (test-equal "works"
+                    '#(0 0 0 0 0 0 0 0 0 0)
+                    (recursive-force expr))
+        (test-equal "effects" 1 effect)))
+    (define (test-list->vector)
+      (let* ((effect 0)
+             (expr1 (h:list->vector (h:list (h:seq (h:set! effect 1) 1)
+                                            2 3 4)))
+             (expr2 (h:list->vector '(1 2 3 4))))
+        (force expr1)
+        (test-equal "effect" 0 effect)
+        (test-equal "works"
+                    '#(1 2 3 4)
+                    (recursive-force expr1))
+        (test-equal "works with constant"
+                    '#(1 2 3 4)
+                    (recursive-force expr2))))
+    (define (test-list-copy)
+      (test-equal "works"
+                  '(1 2 3 4)
+                  (recursive-force
+                   (h:list-copy (h:list 1 2 3 4)))))
+    (define (test-other-binding-constructs)
+      (test-equal "let*"
+                  1
+                  (force (h:let* ((x 0)
+                                  (x (h:+ x 1)))
+                           x)))
+      (test-assert "letrec"
+        (force (h:letrec ((odd? (h:lambda (x)
+                                  (h:if (h:zero? x)
+                                        #f
+                                        (even? (h:- x 1)))))
+                          (even? (h:lambda (x)
+                                   (h:if (h:zero? x)
+                                         #t
+                                         (odd? (h:- x 1))))))
+                 (even? 88))))
+      (test-equal "letrec*"
+                  5
+                  (force (h:letrec* ((p (h:lambda (x)
+                                          (h:+ 1 (q (h:- x 1)))))
+                                     (q (h:lambda (y)
+                                          (h:if (h:zero? y)
+                                                0
+                                                (h:+ 1 (p (h:- y 1))))))
+                                     (x (p 5))
+                                     (y x))
+                           y))))
+    #;(define (test-misc-wrapped-procedures)
+        (let-syntax ((test-wrapped
+                      (syntax-rules ()
+                        ((_ proc h:proc (args ...) ...)
+                         (test-group (symbol->string 'proc)
+                           (test-equal (proc args ...)
+                                       (force (h:proc args ...)))
+                           ...)))))
+          (test-wrapped eq? h:eq?
+                        (#f #f)
+                        (#t #t)
+                        (#f #t)
+                        ('() '())
+                        ('() 'a)
+                        ('a 'a)
+                        ('a 'b))
+          (test-wrapped eqv? h:eqv?
+                        (#f #f)
+                        (#t #t)
+                        (#f #t)
+                        ('() '())
+                        ('() 'a)
+                        ('a 'a)
+                        ('a 'b)
+                        (1 1)
+                        (1 2))
+          (test-wrapped exact-integer? h:exact-integer?
+                        (1) (2) (0) (0.1))
+          (test-wrapped negative? h:negative?
+                        (-1) (0) (1))
+          (test-wrapped positive? h:positive?
+                        (-1) (0) (1))
+          (test-wrapped zero? h:zero?
+                        (-1) (0) (1))
+          (test-wrapped + h:+
+                        (0) (0 0) (1 0))
+          (test-wrapped)))))
\ No newline at end of file