From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 26 Sep 2009 08:45:29 +0000 (-0700)
Subject: Add some tests; these are mostly old and not automated.
X-Git-Tag: 20100708-Gtk~313
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e0e71f00ddad6cbd8807e7062f1c225b22e9be40;p=mit-scheme.git

Add some tests; these are mostly old and not automated.
---

diff --git a/tests/runtime/test-boyer-moore.scm b/tests/runtime/test-boyer-moore.scm
new file mode 100644
index 000000000..6e8ce6489
--- /dev/null
+++ b/tests/runtime/test-boyer-moore.scm
@@ -0,0 +1,89 @@
+#| -*-Scheme-*-
+
+$Id$
+
+Copyright (c) 1999 Massachusetts Institute of Technology
+
+This program 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 2 of the License, or (at
+your option) any later version.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+|#
+
+;;;; Test code for Boyer-Moore String Search
+
+(declare (usual-integrations))
+
+(define (dice-test text die-length die-skew)
+  (newline)
+  (let ((ok 0)
+	(not-ok 0))
+    (for-each
+     (lambda (entry)
+       (write-char #\+)
+       (let ((fr (string-search-forward text (car entry)))
+	     (br (string-search-backward text (car entry))))
+	 (if (and (eqv? (cadr entry) fr)
+		  (eqv? (fix:+ (car (last-pair entry)) die-length) br))
+	     (begin
+	       (set! ok (fix:+ ok 1))
+	       unspecific)
+	     (begin
+	       (set! not-ok (fix:+ not-ok 1))
+	       (write-line (list (car entry) (cdr entry) fr br))))))
+     (dice-text text die-length die-skew))
+    (write-line (list 'OK= ok 'NOT-OK= not-ok))))
+
+(define (dice-text text die-length die-skew)
+  (let ((end (string-length text))
+	(table (make-string-hash-table)))
+    (define (record! s die)
+      (let ((entry
+	     (or (hash-table/get table die #f)
+		 (let ((entry (list 'ENTRY)))
+		   (hash-table/put! table die entry)
+		   entry))))
+	(set-cdr! entry (cons s (cdr entry)))))
+    (let loop ((s 0))
+      (let ((e (fix:+ s die-length)))
+	(if (fix:<= e end)
+	    (begin
+	      (record! s (substring text s e))
+	      (let ((s (fix:+ s die-skew)))
+		(if (fix:< s end)
+		    (loop s)))))))
+    (map (lambda (entry)
+	   (cons (car entry)
+		 (reverse! (cddr entry))))
+	 (hash-table->alist table))))
+
+(define (file->string filename)
+  (call-with-input-file filename
+    (lambda (port)
+      ((port/operation port 'REST->STRING) port))))
+
+(define (search-speed-test text die-length die-skew procedure n-repeats)
+  (let ((entries (map car (dice-text text die-length die-skew))))
+    (show-time
+     (lambda ()
+       (do ((i 0 (fix:+ i 1)))
+	   ((fix:= i n-repeats))
+	 (do ((entries entries (cdr entries)))
+	     ((null? entries))
+	   (procedure (car entries) text)))))))
+
+(define (dummy-search pattern text)
+  (if (not (string? pattern))
+      (error:wrong-type-argument pattern "string" 'BM-SUBSTRING?))
+  (if (not (string? text))
+      (error:wrong-type-argument text "string" 'BM-SUBSTRING?))
+  #f)
\ No newline at end of file
diff --git a/tests/runtime/test-hash-table.scm b/tests/runtime/test-hash-table.scm
new file mode 100644
index 000000000..d6302381f
--- /dev/null
+++ b/tests/runtime/test-hash-table.scm
@@ -0,0 +1,165 @@
+(declare (usual-integrations))
+
+(define-structure (implementation (conc-name implementation/))
+  (make #f read-only #t)
+  (insert! #f read-only #t)
+  (delete! #f read-only #t)
+  (lookup #f read-only #t)
+  (->alist #f read-only #t))
+
+(define-structure (sequence-specification
+		   (conc-name sequence-specification/))
+  (length #f read-only #t)
+  (key-radix #f read-only #t)
+  (insert-fraction #f read-only #t)
+  (delete-fraction #f read-only #t))
+
+(define (run-test sequence-specification implementation)
+  (run-sequence (sequence-specification->sequence sequence-specification)
+		implementation))
+
+(define (run-sequence s implementation)
+  (let ((start-time (process-time-clock)))
+    (run-test-sequence s implementation)
+    (cons (- (process-time-clock) start-time)
+	  (test-sequence-overhead s))))
+
+(define (make-sequence . arguments)
+  (sequence-specification->sequence
+   (apply make-sequence-specification arguments)))
+
+(define (sequence-specification->sequence sequence-specification)
+  (generate-test-sequence (make-random-state #t)
+			  sequence-specification))
+
+(define (generate-test-sequence state sequence-specification)
+  (let ((state (make-random-state state))
+	(length (sequence-specification/length sequence-specification))
+	(key-radix (sequence-specification/key-radix sequence-specification))
+	(insert-fraction
+	 (exact->inexact
+	  (sequence-specification/insert-fraction sequence-specification)))
+	(delete-fraction
+	 (exact->inexact
+	  (sequence-specification/delete-fraction sequence-specification)))
+	(tree (make-rb-tree fix:= fix:<)))
+    (let ((delete-break (+ insert-fraction delete-fraction)))
+      (let loop ((n 0) (s '()))
+	(if (fix:= n length)
+	    s
+	    (loop (fix:+ n 1)
+		  (cons (cons (let ((x (random 1. state)))
+				(cond ((< x insert-fraction) 'INSERT)
+				      ((< x delete-break) 'DELETE)
+				      (else 'LOOKUP)))
+			      (let ((key (random key-radix state)))
+				(or (rb-tree/lookup tree key #f)
+				    (let ((pointer (cons key '())))
+				      (rb-tree/insert! tree key pointer)
+				      pointer))))
+			s)))))))
+
+(define (run-test-sequence s implementation)
+  (let ((table ((implementation/make implementation)))
+	(insert! (implementation/insert! implementation))
+	(delete! (implementation/delete! implementation))
+	(lookup (implementation/lookup implementation)))
+    (do ((s s (cdr s)))
+	((null? s))
+      (cond ((eq? 'INSERT (caar s))
+	     (insert! table (cdar s) #f))
+	    ((eq? 'DELETE (caar s))
+	     (delete! table (cdar s)))
+	    (else
+	     (lookup table (cdar s) #f))))
+    table))
+
+(define (test-sequence-overhead s)
+  (let ((start-time (process-time-clock)))
+    (run-test-sequence s dummy-implementation)
+    (let ((end-time (process-time-clock)))
+      (- end-time start-time))))
+
+(define dummy-implementation
+  (make-implementation
+   (lambda () unspecific)
+   (lambda (table key datum) table key datum unspecific)
+   (lambda (table key) table key unspecific)
+   (lambda (table key default) table key default unspecific)
+   (lambda (table) table unspecific)))
+
+(load-option 'HASH-TABLE)
+
+(define htq
+  (make-implementation make-eq-hash-table
+		       hash-table/put!
+		       hash-table/remove!
+		       hash-table/get
+		       (lambda (table)
+			 (sort (hash-table->alist table)
+			       (lambda (x y) (fix:< (caar x) (caar y)))))))
+
+(define htv
+  (make-implementation make-eqv-hash-table
+		       hash-table/put!
+		       hash-table/remove!
+		       hash-table/get
+		       (lambda (table)
+			 (sort (hash-table->alist table)
+			       (lambda (x y) (fix:< (caar x) (caar y)))))))
+
+(define ht
+  (make-implementation make-equal-hash-table
+		       hash-table/put!
+		       hash-table/remove!
+		       hash-table/get
+		       (lambda (table)
+			 (sort (hash-table->alist table)
+			       (lambda (x y) (fix:< (caar x) (caar y)))))))
+
+(load-option 'RB-TREE)
+
+(define (make-pointer-tree)
+  (make-rb-tree (lambda (x y) (fix:= (car x) (car y)))
+		(lambda (x y) (fix:< (car x) (car y)))))
+
+(define rbt
+  (make-implementation make-pointer-tree
+		       rb-tree/insert!
+		       rb-tree/delete!
+		       rb-tree/lookup
+		       rb-tree->alist))
+
+(define (test-correctness s implementation)
+  (let ((table ((implementation/make implementation)))
+	(insert! (implementation/insert! implementation))
+	(delete! (implementation/delete! implementation))
+	(lookup (implementation/lookup implementation))
+	(tree (make-pointer-tree)))
+    (do ((s s (cdr s)))
+	((null? s))
+      (let ((operation (caar s))
+	    (key (cdar s)))
+	(cond ((eq? 'INSERT operation)
+	       (rb-tree/insert! tree key #t)
+	       (insert! table key #t))
+	      ((eq? 'DELETE operation)
+	       (rb-tree/delete! tree key)
+	       (delete! table key))
+	      (else
+	       (let ((result (lookup table key #f)))
+		 (if (not (eq? result (rb-tree/lookup tree key #f)))
+		     (error "Incorrect lookup result:" result key)))))))
+    (let loop
+	((alist ((implementation/->alist implementation) table))
+	 (check (rb-tree->alist tree)))
+      (if (null? alist)
+	  (if (not (null? check))
+	      (error "Table has too few elements:" check))
+	  (begin
+	    (if (null? check)
+		(error "Table has too many elements:" alist))
+	    (if (not (and (eq? (caar alist) (caar check))
+			  (eq? (cdar alist) (cdar check))))
+		(error "Alist element incorrect:" (car alist) (car check)))
+	    (loop (cdr alist) (cdr check)))))))
\ No newline at end of file
diff --git a/tests/runtime/test-mime-codec.scm b/tests/runtime/test-mime-codec.scm
new file mode 100644
index 000000000..63c925640
--- /dev/null
+++ b/tests/runtime/test-mime-codec.scm
@@ -0,0 +1,119 @@
+(define (test-encoder n-packets packet-length text? filename
+		      initialize finalize update)
+  (call-with-output-file filename
+    (lambda (port)
+      (let ((context (initialize port text?))
+	    (n-packets (random n-packets)))
+	(do ((i 0 (+ i 1)))
+	    ((= i n-packets))
+	  (let ((packet-length (random packet-length)))
+	    (write i)
+	    (write-char #\space)
+	    (write packet-length)
+	    (write-char #\space)
+	    (let ((packet 
+		   (if text?
+		       (random-text-string packet-length)
+		       (random-byte-vector packet-length))))
+	      (write packet)
+	      (newline)
+	      (update context packet 0 packet-length))))
+	(finalize context)))))
+
+(define (random-text-string length)
+  (let ((string (make-string length))
+	(n-text (string-length text-characters)))
+    (do ((i 0 (fix:+ i 1)))
+	((fix:= i length))
+      (string-set! string i (string-ref text-characters (random n-text))))
+    string))
+
+(define text-characters
+  (list->string
+   (append '(#\tab #\newline)
+	   (char-set-members char-set:graphic))))
+
+(define (test-codec n-packets packet-length text? filename
+		      encode:initialize encode:finalize encode:update
+		      decode:initialize decode:finalize decode:update)
+  (let ((packets (make-test-vector n-packets packet-length text?)))
+    (let ((n-packets (vector-length packets)))
+      (call-with-output-file (pathname-new-type filename "clear1")
+	(lambda (port)
+	  (do ((i 0 (+ i 1)))
+	      ((= i n-packets))
+	    (write-string (vector-ref packets i) port))))
+      (call-with-output-file (pathname-new-type filename "encoded")
+	(lambda (port)
+	  (let ((context (encode:initialize port text?)))
+	    (do ((i 0 (+ i 1)))
+		((= i n-packets))
+	      (let ((packet (vector-ref packets i)))
+		(encode:update context packet 0 (string-length packet))))
+	    (encode:finalize context))))))
+  (retest-decoder text? filename
+		  decode:initialize decode:finalize decode:update))
+
+(define (make-test-vector n-packets packet-length text?)
+  (let ((n-packets (random n-packets)))
+    (let ((packets (make-vector n-packets)))
+      (do ((i 0 (+ i 1)))
+	  ((= i n-packets))
+	(vector-set! packets i
+		     (let ((packet-length (random packet-length)))
+		       (if text?
+			   (random-text-string packet-length)
+			   (random-byte-vector packet-length)))))
+      packets)))
+
+(define (retest-codec text? filename
+		      encode:initialize encode:finalize encode:update
+		      decode:initialize decode:finalize decode:update)
+  (call-with-input-file (pathname-new-type filename "clear1")
+    (lambda (input-port)
+      (call-with-output-file (pathname-new-type filename "encoded")
+	(lambda (output-port)
+	  (let ((context (encode:initialize output-port text?))
+		(buffer (make-string 37)))
+	    (let loop ()
+	      (let ((n-read (read-string! buffer input-port)))
+		(if (fix:> n-read 0)
+		    (begin
+		      (encode:update context buffer 0 n-read)
+		      (loop)))))
+	    (encode:finalize context))))))
+  (retest-decoder text? filename
+		  decode:initialize decode:finalize decode:update))
+
+(define (retest-decoder text? filename
+			decode:initialize decode:finalize decode:update)
+  (let ((pn3 (pathname-new-type filename "clear2")))
+    (call-with-input-file (pathname-new-type filename "encoded")
+      (lambda (input-port)
+	(call-with-output-file pn3
+	  (lambda (output-port)
+	    (let ((context (decode:initialize output-port text?))
+		  (buffer (make-string 41)))
+	      (let loop ()
+		(let ((n-read (read-string! buffer input-port)))
+		  (if (fix:> n-read 0)
+		      (begin
+			(decode:update context buffer 0 n-read)
+			(loop)))))
+	      (decode:finalize context))))))
+    (call-with-input-file (pathname-new-type filename "clear1")
+      (lambda (p1)
+	(call-with-input-file pn3
+	  (lambda (p3)
+	    (let loop ()
+	      (let ((c1 (read-char p1))
+		    (c3 (read-char p3)))
+		(if (eof-object? c1)
+		    (if (eof-object? c3)
+			unspecific
+			(error "Output file longer."))
+		    (if (eof-object? c3)
+			(error "Output file shorter.")
+			(if (char=? c1 c3)
+			    (loop)
+			    (error "Files don't match."))))))))))))
\ No newline at end of file
diff --git a/tests/runtime/test-random.scm b/tests/runtime/test-random.scm
new file mode 100644
index 000000000..36aea8e8e
--- /dev/null
+++ b/tests/runtime/test-random.scm
@@ -0,0 +1,26 @@
+(define (fill-file-with-random-integers n-bits-in-file
+					n-bits-per-integer
+					n-progress-dots
+					filename)
+  (if (not (= 0 (remainder n-bits-in-file n-bits-per-integer)))
+      (error:bad-range-argument n-bits-in-file
+				'FILL-FILE-WITH-RANDOM-INTEGERS))
+  (if (not (= 0 (remainder n-bits-per-integer 8)))
+      (error:bad-range-argument n-bits-per-integer
+				'FILL-FILE-WITH-RANDOM-INTEGERS))
+  (call-with-output-file filename
+    (lambda (port)
+      (let ((modulus (expt 2 n-bits-per-integer))
+	    (j-limit (quotient n-bits-in-file n-bits-per-integer))
+	    (i-limit (quotient n-bits-per-integer 8)))
+	(let ((j-dot (quotient j-limit n-progress-dots))
+	      (buffer (make-string i-limit)))
+	  (do ((j 0 (+ j 1)))
+	      ((= j j-limit))
+	    (if (= 0 (remainder j j-dot))
+		(write-char #\.))
+	    (do ((i 0 (+ i 1))
+		 (n (random modulus) (quotient n #x100)))
+		((= i i-limit))
+	      (vector-8b-set! buffer i (remainder n #x100)))
+	    (write-string buffer port)))))))
\ No newline at end of file
diff --git a/tests/runtime/test-regsexp.scm b/tests/runtime/test-regsexp.scm
new file mode 100644
index 000000000..b6a696a7d
--- /dev/null
+++ b/tests/runtime/test-regsexp.scm
@@ -0,0 +1,142 @@
+(define (test-string pattern string expected)
+  (assert-equal `(match-string ',pattern ,string)
+		 (match-string pattern string)
+		 expected))
+
+(define (match-string pattern string)
+  (regsexp-match-string (compile-regsexp pattern) string))
+
+(define (assert-equal expr value expected)
+  (if (not (equal? value expected))
+      (begin
+	(fluid-let ((*unparse-abbreviate-quotations?* #t))
+	  (write expr))
+	(write-string " => ")
+	(write value)
+	(write-string " but expected ")
+	(write expected)
+	(newline))))
+
+(define (test-strings pattern entries)
+  (for-each (lambda (p)
+	      (test-string pattern (car p) (cadr p)))
+	    entries))
+
+(define (test-no-groups pattern entries)
+  (test-strings pattern
+		(map (lambda (p)
+		       (list (car p)
+			     (and (cadr p)
+				  (list (cadr p)))))
+		     entries)))
+
+(define (no-groups-tester strings)
+  (lambda (pattern indices)
+    (test-no-groups pattern
+		    (map list strings indices))))
+
+(define (run-tests)
+  (test-no-groups '(any-char)
+		  '(("" #f)
+		    ("a" 1)
+		    ("b" 1)
+		    ("\n" #f)))
+
+  (test-no-groups '(* (any-char))
+		  '(("" 0)
+		    ("a" 1)
+		    ("ab" 2)
+		    ("abc" 3)
+		    ("ab\n" 2)
+		    ("a\nb" 1)))
+
+  (test-string '(seq "a" "b") "ab" '(2))
+
+  (let ((test (no-groups-tester '("" "a" "b" "ab" "ba" "aab"))))
+    (let ((equivalents
+	   (lambda (indices . patterns)
+	     (for-each (lambda (pattern)
+			 (test pattern indices))
+		       patterns))))
+
+      (equivalents '(0 0 0 0 0 0)
+		   ""
+		   '(repeat> 0 0 "a")
+		   '(repeat< 0 0 "a")
+		   '(seq "" ""))
+
+      (equivalents '(#f 1 #f 1 #f 1)
+		   "a"
+		   '(repeat> 1 1 "a")
+		   '(repeat< 1 1 "a")
+		   '(seq "a" "")
+		   '(seq "" "a"))
+
+      (equivalents '(#f #f #f #f #f 2)
+		   "aa"
+		   '(repeat> 2 2 "a")
+		   '(repeat< 2 2 "a")
+		   '(seq "a" "a")
+		   '(seq "aa" "")
+		   '(seq "" "aa"))
+
+      (equivalents '(0 1 0 1 0 2)
+		   '(* "a")
+		   '(repeat> 0 #f "a"))
+
+      (equivalents '(0 0 0 0 0 0)
+		   '(*? "a")
+		   '(repeat< 0 #f "a"))
+
+      (equivalents '(#f 1 #f 1 #f 2)
+		   '(+ "a")
+		   '(seq "a" (* "a"))
+		   '(repeat> 1 #f "a"))
+
+      (equivalents '(#f 1 #f 1 #f 1)
+		   '(+? "a")
+		   '(seq "a" (*? "a"))
+		   '(repeat< 1 #f "a"))
+
+      (equivalents '(0 1 0 1 0 1)
+		   '(? "a")
+		   '(repeat> 0 1 "a"))
+
+      (equivalents '(0 0 0 0 0 0)
+		   '(?? "a")
+		   '(repeat< 0 1 "a"))))
+
+  (test-string '(seq (? "a") "a") "aab" '(2))
+  (test-string '(seq (? "a") "ab") "aab" '(3))
+
+  (test-string '(seq (?? "a") "a") "aab" '(1))
+  (test-string '(seq (?? "a") "ab") "aab" '(3))
+
+  (test-string '(repeat> 1 2 "a") "aab" '(2))
+  (test-string '(seq (repeat> 1 2 "a") "b") "aab" '(3))
+
+  (test-string '(repeat< 1 2 "a") "aab" '(1))
+  (test-string '(seq (repeat< 1 2 "a") "b") "aab" '(3))
+
+  (test-string '(repeat> 1 3 "a") "aaab" '(3))
+  (test-string '(seq (repeat> 1 3 "a") "b") "aaab" '(4))
+
+  (test-string '(repeat< 1 3 "a") "aaab" '(1))
+  (test-string '(seq (repeat< 1 3 "a") "b") "aaab" '(4))
+
+  (test-string '(seq (group foo (? "a")) "a") "aab" '(2 (foo 0 1)))
+  (test-string '(seq (group foo (? "a")) "ab") "aab" '(3 (foo 0 1)))
+  (test-string '(seq (group foo (? "a")) "aab") "aab" '(3 (foo 0 0)))
+
+  (test-string '(seq (group foo (?? "a")) "a") "aab" '(1 (foo 0 0)))
+  (test-string '(seq (group foo (?? "a")) "ab") "aab" '(3 (foo 0 1)))
+  (test-string '(seq (group foo (?? "a")) "aab") "aab" '(3 (foo 0 0)))
+
+  (test-string '(seq (group foo (* "a")) "b") "aab" '(3 (foo 0 2)))
+  (test-string '(seq (group foo (* "a")) "ab") "aab" '(3 (foo 0 1)))
+  (test-string '(seq (group foo (* "a")) "aab") "aab" '(3 (foo 0 0)))
+
+  (test-string '(seq (group foo (*? "a")) "b") "aab" '(3 (foo 0 2)))
+  (test-string '(seq (group foo (*? "a")) "ab") "aab" '(3 (foo 0 1)))
+  (test-string '(seq (group foo (*? "a")) "aab") "aab" '(3 (foo 0 0)))
+  )
\ No newline at end of file
diff --git a/tests/runtime/test-srfi-1.scm b/tests/runtime/test-srfi-1.scm
new file mode 100644
index 000000000..a645831cc
--- /dev/null
+++ b/tests/runtime/test-srfi-1.scm
@@ -0,0 +1,605 @@
+;;; xcons
+(xcons (list 1) 2)
+;Value 1: (2 1)
+
+;;; make-list
+(make-list 3)
+;Value 2: (#f #f #f)
+
+(make-list 3 5)
+;Value 3: (5 5 5)
+
+;;; list-tablulate
+(list-tabulate 5 (lambda (x) (+ x 1)))
+;Value 7: (1 2 3 4 5)
+
+(list-tabulate 5 square)
+;Value 6: (0 1 4 9 16)
+
+;;; cons*
+(cons* 'a 'b (iota 3))
+;Value 8: (a b 0 1 2)
+
+;;; list-copy
+(let* ((foo (iota 5))
+       (bar foo)
+       (baz (list-copy foo)))
+  (list (eq? foo bar)
+	(eq? foo baz)))
+;Value 9: (#t #f)
+
+;;; iota, 
+(iota 5)
+;Value 10: (0 1 2 3 4)
+
+(iota 5 10)
+;Value 11: (10 11 12 13 14)
+
+(iota 5 10 2)
+;Value 12: (10 12 14 16 18)
+
+;;; iota-
+(iota- 5)
+;Value 13: (1 2 3 4 5)
+
+(iota- 5 10)
+;Value 14: (6 7 8 9 10)
+
+(iota- 5 10 2)
+;Value 15: (7 9)
+
+;;; -iota
+(-iota 5)
+;Value 16: (0 1 2 3 4)
+
+(-iota 5 10)
+;Value 17: (5 6 7 8 9)
+
+(-iota 5 10 2)
+;Value 18: (5 7 9)
+
+;;; circular-list
+(fourth (circular-list 1 2 3))
+;Value: 1
+
+;;; proper-list?
+(proper-list? (cons 1 (list 2)))
+;Value: #t
+
+(proper-list? (cons 1 2))
+;Value: #f
+
+(proper-list? (circular-list 1 2 3))
+;Value: #f
+
+;;; dotted-list?
+(dotted-list? (cons 1 (list 2)))
+;Value: #f
+
+(dotted-list? (cons 1 2))
+;Value: #t
+
+(dotted-list? (circular-list 1 2 3))
+;Value: #f
+
+;;; circular-list?
+(circular-list? (cons 1 (list 2)))
+;Value: #f
+
+(circular-list? (cons 1 2))
+;Value: #f
+
+(circular-list? (circular-list 1 2 3))
+;Value: #t
+
+;;; not-pair?
+(not-pair? 5)
+;Value: #t
+
+(not-pair? '())
+;Value: #t
+
+(not-pair? (circular-list 1 2 3))
+;Value: #f
+
+;;; list= (altered)
+(list= eq?
+       '(a b c)
+       '(a b c)
+       '(a b c))
+;Value: #t
+
+(list= eq?
+       '("a")
+       '("a"))
+;Value: #f
+
+(list= equal?
+       '("a")
+       '("a"))
+;Value: #t
+
+;;; length+
+(length (circular-list 1 2 3))
+;The object (1 2 3 1 2 3 1 2 3...), passed as an argument to length, is not a list.
+;To continue, call RESTART with an option number:
+; (RESTART 2) => Return to read-eval-print level 2.
+; (RESTART 1) => Return to read-eval-print level 1.
+
+(length+ (circular-list 1 2 3))
+;Value: #f
+
+(length+ (list 1 2 3))
+;Value: 3
+
+;;; zip
+(zip '(1 2 3) '(1 2 3))
+;Value 2: ((1 1) (2 2) (3 3))
+
+
+;;; take-right
+(take-right '(a b c d e) 2)
+;Value 5: (d e)
+
+
+;;; drop-right
+(drop-right '(a b c d e) 2)
+;Value 6: (a b c)
+
+
+;;; drop-right!
+(let ((foo '(a b c d e)))
+  (let ((bar (drop-right! foo 2)))
+    foo))
+;Value 7: (a b c)
+
+
+;;; take
+(take '(a b c d e) 2)
+;Value 8: (a b)
+
+(take '(a b c d e) -2)
+;Value 9: (d e)
+
+
+;;; drop
+(drop '(a b c d e) 2)
+;Value 15: (c d e)
+
+(drop '(a b c d e) -2)
+;Value 16: (a b c)
+
+
+;;; take!
+(let ((foo '(a b c d e)))
+  (let ((bar (take! foo 2)))
+    foo))
+;Value 10: (a b)
+
+;;; drop! (linear updates not guaranteed to modify their arguments)
+(let ((foo '(a b c d e)))
+  (let ((bar (drop! foo 2)))
+    (list foo
+	  bar)))
+;Value 14: ((a b c d e) (c d e))
+
+;;; split-at
+(let ((foo '(a b c d e)))
+  (receive (x y)
+	   (split-at foo 2)
+	   (list x y)))
+;Value 17: ((a b) (c d e))
+
+;;; split-at!
+(let ((foo '(a b c d e)))
+  (receive (x y)
+	   (split-at! foo 2)
+	   (list x y foo)))
+;Value 18: ((a b) (c d e) (a b))
+
+
+;;; last
+(last '(a b c d e))
+;Value: e
+
+
+;;; unzip1-5
+(unzip1 '((a b)
+	  (c d)
+	  (e f)))
+;Value 19: (a c e)
+
+(receive (a b)
+	 (unzip2 (list (iota 10 0)
+		       (iota 10 10)
+		       (iota 10 20)))
+	 (list a b))
+;Value 34: ((0 10 20) (1 11 21))
+
+
+(receive (a b c)
+	 (unzip3 (list (iota 10 0)
+		       (iota 10 10)
+		       (iota 10 20)))
+	 (list a b c))
+;Value 35: ((0 10 20) (1 11 21) (2 12 22))
+
+(receive (a b c d)
+	 (unzip4 (list (iota 10 0)
+		       (iota 10 10)
+		       (iota 10 20)))
+	 (list a b c d))
+;Value 39: ((0 10 20) (1 11 21) (2 12 22) (3 13 23))
+
+(receive (a b c d e)
+	 (unzip5 (list (iota 10 0)
+		       (iota 10 10)
+		       (iota 10 20)))
+	 (list a b c d e))
+;Value 40: ((0 10 20) (1 11 21) (2 12 22) (3 13 23) (4 14 24))
+
+
+;;; append! append-reverse append-reverse! concatenate concatenate!
+(append! '(a b c)
+	 '(d e f)
+	 '(g h i))
+;Value 41: (a b c d e f g h i)
+
+(append-reverse '(a b c)
+		'(d e f))
+;Value 42: (c b a d e f)
+
+(append-reverse! '(a b c)
+		 '(d e f))
+;Value 43: (c b a d e f)
+
+(concatenate '((a b c)
+	       (d e f)
+	       (g h i)))
+;Value 47: (a b c d e f g h i)
+
+(concatenate! '((a b c)
+		(d e f)
+		(g h i)))
+;Value 48: (a b c d e f g h i)
+
+
+;;; fold/map internal utilities
+(%cdrs '((a b c)
+	 (d e f)
+	 (g h i)))
+;Value 49: ((b c) (e f) (h i))
+
+(%cars+ '((a b c)
+	  (d e f)
+	  (g h i))
+	0)
+;Value 51: (a d g 0)
+
+(receive (x y)
+	 (%cars+cdrs '((a b c)
+		       (d e f)
+		       (g h i)))
+	 (list x y))
+;Value 53: ((a d g) ((b c) (e f) (h i)))
+
+(receive (x y)
+	 (%cars+cdrs '((a b c)
+		       (d e f)
+		       ()))
+	 (list x y))
+;Value 5: (() ())
+
+
+(receive (x y)
+	 (%cars+cdrs+ '((a b c)
+			(d e f)
+			(g h i))
+		      0)
+	 (list x y))
+;Value 54: ((a d g 0) ((b c) (e f) (h i)))
+
+(receive (x y)
+	 (%cars+cdrs+ '((a b c)
+			(d e f)
+			())
+		      0)
+	 (list x y))
+;Value 6: (() ())
+
+
+(receive (x y)
+	 (%cars+cdrs/no-test '((a b c)
+			       (d e f)
+			       (g h i)))
+	 (list x y))
+;Value 55: ((a d g) ((b c) (e f) (h i)))
+
+
+(receive (x y)
+	 (%cars+cdrs/no-test '((a b c)
+			       (d e f)
+			       ()))
+	 (list x y))
+
+;The object (), passed as the first argument to cdr, is not the correct type.
+;To continue, call RESTART with an option number:
+; (RESTART 2) => Specify an argument to use in its place.
+; (RESTART 1) => Return to read-eval-print level 1.
+
+;;; count
+(count even? (iota 10))
+;Value: 5
+
+(count (lambda (x y) (even? (+ x y)))
+       (iota 10)
+       (iota 10))
+;Value: 10
+
+;;; fold/unfold
+(unfold-right null-list? car cdr (iota 10))
+;Value 59: (9 8 7 6 5 4 3 2 1 0)
+
+(unfold null-list? car cdr (iota 10) (lambda (x) (cons 'foo x)))
+;Value 60: (0 1 2 3 4 5 6 7 8 9 foo)
+
+
+(fold cons* '() '(a b c) '(1 2 3 4 5))
+;Value 7: (c 3 b 2 a 1)
+
+
+(fold-right + 0 (iota 5 1) (iota 5 6))
+;Value: 55
+
+(fold-right cons* '() (iota 10) (iota 20))
+;Value 69: (0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9)
+
+
+(pair-fold cons* '() '(a b c) '(1 2 3 4 5))
+;Value 8: ((c) (3 4 5) (b c) (2 3 4 5) (a b c) (1 2 3 4 5))
+
+(pair-fold-right cons* '() '(a b c) '(1 2 3 4 5))
+;Value 9: ((a b c) (1 2 3 4 5) (b c) (2 3 4 5) (c) (3 4 5))
+
+(reduce + 'none (iota 10))
+;Value: 45
+
+(reduce + 'none '())
+;Value: none
+
+(reduce-right + 'none (iota 10))
+;Value: 45
+
+(reduce-right + 'none '())
+;Value: none
+
+(append-map (lambda (x) (list x (- x))) '(1 3 8))
+;Value 12: (1 -1 3 -3 8 -8)
+
+(append-map list
+	    (iota 5)
+	    (iota 5 5))
+;Value 15: (0 5 1 6 2 7 3 8 4 9)
+
+(append-map! (lambda (x) (list x (- x))) '(1 3 8))
+;Value 13: (1 -1 3 -3 8 -8)
+
+
+(pair-for-each write-line (iota 3))
+; (0 1 2)
+; (1 2)
+; (2)
+; ;Unspecified return value
+
+(pair-for-each (lambda (x y) (write-line (list x y)))
+	       (iota 3)
+	       (iota 3 3))
+; ((0 1 2) (3 4 5))
+; ((1 2) (4 5))
+; ((2) (5))
+; ;Unspecified return value
+
+(map! +
+      (iota 5)
+      (iota 10))
+;Value 16: (0 2 4 6 8)
+
+(map! +
+      (iota 10)
+      (iota 5))
+;The object (), passed as the first argument to cdr, is not the correct type.
+;To continue, call RESTART with an option number:
+; (RESTART 2) => Specify an argument to use in its place.
+; (RESTART 1) => Return to read-eval-print level 1.
+
+(filter-map (lambda (x) (and (even? x)
+			(square x)))
+	    (iota 10))
+;Value 17: (0 4 16 36 64)
+
+(let ((foo '()))
+  (map-in-order (lambda (x) (set! foo (cons x foo)))
+		(iota 10))
+  foo)
+;Value 19: (9 8 7 6 5 4 3 2 1 0)
+
+
+;;; filter, remove, partition
+
+(filter even? (iota 10))
+;Value 20: (0 2 4 6 8)
+
+(filter! even? (iota 10))
+;Value 22: (0 2 4 6 8)
+
+(remove even? (iota 10))
+;Value 21: (1 3 5 7 9)
+
+(remove! even? (iota 10))
+;Value 23: (1 3 5 7 9)
+
+(receive (x y)
+	 (partition even? (iota 10))
+	 (list x y))
+;Value 24: ((0 2 4 6 8) (1 3 5 7 9))
+
+(receive (x y)
+	 (partition! even? (iota 10))
+	 (list x y))
+;Value 25: ((0 2 4 6 8) (1 3 5 7 9))
+
+
+;;; delete, assoc, member
+(delete 3 (iota 5))
+;Value 26: (0 1 2 4)
+
+(delete 3 (iota 5) eqv?)
+;Value 49: (0 1 2 4)
+
+(delete! 3 (iota 5))
+;Value 27: (0 1 2 4)
+
+(delete! 3 (iota 5) eqv?)
+;Value 50: (0 1 2 4)
+
+
+(member "b" (list "a" "b" "c"))
+;Value 29: ("b" "c")
+
+(member "b" (list "a" "b" "c") eqv?)
+;Value: #f
+
+
+(delete-duplicates '(0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9))
+;Value 52: (0 1 2 3 4 5 6 7 8 9)
+
+(delete-duplicates '(0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9) eqv?)
+;Value 53: (0 1 2 3 4 5 6 7 8 9)
+
+
+;;; alist stuff
+
+(let ((e '((a 1) (b 2) (c 3))))
+  (list (assq 'a e)
+	(assq 'b e)
+	(assq 'd e)))
+;Value 54: ((a 1) (b 2) #f)
+
+
+(assq (list 'a) '(((a)) ((b)) ((c))))
+;Value: #f
+
+(assoc (list 'a) '(((a)) ((b)) ((c))))
+;Value 55: ((a))
+
+
+(assq 5 '((2 3) (5 7) (11 13)))
+;Value 56: (5 7)
+;;; this is R5RS unspecified though
+
+(assv 5 '((2 3) (5 7) (11 13)))
+;Value 57: (5 7)
+;;; but not this
+
+
+;;; find find-tail take-while drop-while span break any every list-index
+
+
+(find even? (iota 10 5))
+;Value: 6
+
+(find-tail even? (iota 10 5))
+;Value 58: (6 7 8 9 10 11 12 13 14)
+
+(drop-while even? '(2 18 3 10 22 9))
+;Value 59: (3 10 22 9)
+
+(take-while even? '(2 18 3 10 22 9))
+;Value 60: (2 18)
+
+(receive (x y)
+	 (span even? '(2 18 3 10 22 9))
+	 (list x y))
+;Value 61: ((2 18) (3 10 22 9))
+
+
+(receive (x y)
+	 (span! even? '(2 18 3 10 22 9))
+	 (list x y))
+;Value 62: ((2 18) (3 10 22 9))
+
+
+(any even? (iota 5 1 2))
+;Value: #f
+
+(any (lambda (x y) (odd? (+ x y)))
+     (iota 10)
+     (iota 10))
+;Value: #f
+
+(every odd? (iota 5 1 2))
+;Value: #t
+
+(every (lambda (x y) (even? (+ x y)))
+       (iota 10)
+       (iota 10))
+;Value: #t
+
+(list-index odd? '(2 18 3 10 22 9))
+;Value: 2
+
+
+;;; reverse!
+
+(reverse! (iota 10))
+;Value 66: (9 8 7 6 5 4 3 2 1 0)
+
+
+;;; lset-*
+
+(lset<= eq? '(a) '(a b a) '(a b c c))
+;Value: #t
+
+(lset= eq? '(b e a) '(a e b) '(e e b a)) => #t
+;Value: #t
+
+
+(lset-adjoin eq? '(a b c d c e) 'a 'e 'i 'o 'u) 
+;Value 67: (u o i a b c d c e)
+
+
+(lset-union eq? '(a a c) '(x a x))
+;Value 68: (x a a c)
+
+
+(lset-union eq? '(a a c) '(x a x))
+;Value 69: (x a a c)
+
+
+(lset-intersection eq? '(a x y a) '(x a x z))
+;Value 70: (a x a)
+
+
+(lset-difference eq? '(a b c d e) '(a e i o u))
+;Value 71: (b c d)
+
+
+(lset-xor eq? '(a b c d e) '(a e i o u))
+;Value 72: (u o i b c d)
+
+
+(receive (x y)
+	 (lset-diff+intersection eq?
+				 '(a b c d)
+				 '(a e)
+				 '(c e))
+	 (list x y))
+;Value 75: ((b d) (a c))
+
+(receive (x y)
+	 (lset-diff+intersection! eq?
+				  '(a b c d)
+				  '(a e)
+				  '(c e))
+	 (list x y))
+;Value 76: ((b d) (a c))
diff --git a/tests/runtime/test-stream.scm b/tests/runtime/test-stream.scm
new file mode 100644
index 000000000..5bd186954
--- /dev/null
+++ b/tests/runtime/test-stream.scm
@@ -0,0 +1,18 @@
+(define (file-stream filename)
+  (let ((port (open-input-file filename)))
+    (let loop ()
+      (let ((char (read-char port)))
+	(if (eof-object? char)
+	    (begin
+	      (close-port port)
+	      '())
+	    (cons-stream char (loop)))))))
+
+(define (run-tests filename)
+  (toggle-gc-notification!)
+  (stream-length (file-stream filename))
+  (stream-length (stream-map (lambda (x) x) (file-stream filename)))
+  (stream-for-each (lambda (x) x) (file-stream filename))
+  (toggle-gc-notification!))
+
+(run-tests "~/gunk/receiver/chip1/receiver/qrm-1.sim")
\ No newline at end of file
diff --git a/tests/runtime/test-string-copy.scm b/tests/runtime/test-string-copy.scm
new file mode 100644
index 000000000..8bd05b94c
--- /dev/null
+++ b/tests/runtime/test-string-copy.scm
@@ -0,0 +1,31 @@
+(declare (usual-integrations))
+
+(define (test-noop length iterations)
+  (let ((from (make-string length))
+	(to (make-string (fix:* 2 length))))
+    (do ((i 0 (fix:+ i 1)))
+	((fix:= i iterations)))))
+
+(define (test-left length iterations)
+  (let ((from (make-string length))
+	(to (make-string (fix:* 2 length))))
+    (do ((i 0 (fix:+ i 1)))
+	((fix:= i iterations))
+      (substring-move-left! from 0 length to length))))
+
+(define (test-right length iterations)
+  (let ((from (make-string length))
+	(to (make-string (fix:* 2 length))))
+    (do ((i 0 (fix:+ i 1)))
+	((fix:= i iterations))
+      (substring-move-right! from 0 length to length))))
+
+(define (test-inline length iterations)
+  (let ((from (make-string length))
+	(to (make-string (fix:* 2 length))))
+    (do ((i 0 (fix:+ i 1)))
+	((fix:= i iterations))
+      (do ((fi 0 (fix:+ fi 1))
+	   (ti length (fix:+ ti 1)))
+	  ((fix:= fi length))
+	(string-set! to ti (string-ref from fi))))))
\ No newline at end of file