From 283553f0f118cef1dbcfbf5e86a43575a610d27f Mon Sep 17 00:00:00 2001
From: Keith Packard <keithp@keithp.com>
Date: Sun, 7 Jan 2018 23:04:22 -0800
Subject: [PATCH] altos/scheme: Split tests out from build sources

Run tests on both tiny and full scheme test programs.

Signed-off-by: Keith Packard <keithp@keithp.com>
---
 src/scheme/ao_scheme_advanced_syntax.scheme   |  86 ++++-----
 src/scheme/ao_scheme_basic_syntax.scheme      |  61 ++----
 src/scheme/ao_scheme_char.scheme              |  64 +++----
 src/scheme/ao_scheme_port.scheme              |   4 +
 src/scheme/ao_scheme_string.scheme            |  22 +--
 src/scheme/ao_scheme_vector.scheme            |  14 +-
 src/scheme/test/Makefile                      |   1 +
 src/scheme/test/ao_scheme_test.c              |   4 +
 src/scheme/test/ao_scheme_test.scheme         | 175 ++++++++++++++++++
 src/scheme/tiny-test/Makefile                 |   2 +
 src/scheme/tiny-test/ao_scheme_test.c         | 116 ------------
 .../tiny-test/ao_scheme_tiny_test.scheme      |  56 ++++++
 12 files changed, 347 insertions(+), 258 deletions(-)
 create mode 100644 src/scheme/test/ao_scheme_test.scheme
 delete mode 100644 src/scheme/tiny-test/ao_scheme_test.c
 create mode 100644 src/scheme/tiny-test/ao_scheme_tiny_test.scheme

diff --git a/src/scheme/ao_scheme_advanced_syntax.scheme b/src/scheme/ao_scheme_advanced_syntax.scheme
index 79d4ba65..4cddc803 100644
--- a/src/scheme/ao_scheme_advanced_syntax.scheme
+++ b/src/scheme/ao_scheme_advanced_syntax.scheme
@@ -40,20 +40,10 @@
   'equal?
   )
 
-(_?_ (equal? '(a b c) '(a b c)) #t)
-(_?_ (equal? '(a b c) '(a b b)) #f)
-(_?_ (equal? #(1 2 3) #(1 2 3)) #t)
-(_?_ (equal? #(1 2 3) #(4 5 6)) #f)
-
-(define (_??_ a b)
-  (cond ((equal? a b)
-	 a
-	 )
-	(else
-	 (exit 1)
-	 )
-	)
-  )
+(equal? '(a b c) '(a b c))
+(equal? '(a b c) '(a b b))
+(equal? #(1 2 3) #(1 2 3))
+(equal? #(1 2 3) #(4 5 6))
 
 (define quasiquote
   (macro (x)
@@ -175,7 +165,7 @@
 					; `(a ,@(list 1 2 3) -> (append (quote (a)) (list 1 2 3))
 
 
-(_??_ `(hello ,(+ 1 2) ,@(list 1 2 3) `foo) '(hello 3 1 2 3 (quasiquote foo)))
+`(hello ,(+ 1 2) ,@(list 1 2 3) `foo)
 
 					; define a set of local
 					; variables all at once and
@@ -229,29 +219,33 @@
      )
 		   
 
-(_??_ (let ((x 1) (y)) (set! y 2) (+ x y)) 3)
+(let ((x 1) (y)) (set! y 2) (+ x y))
+
+(define assv assq)
+
+(assv 'b '((a 1) (b 2) (c 3)))
 
 (define when (macro (test . l) `(cond (,test ,@l))))
 
-(_??_ (when #t (+ 1 2)) 3)
-(_??_ (when #f (+ 1 2)) #f)
+(when #t (+ 1 2))
+(when #f (+ 1 2))
 
 (define unless (macro (test . l) `(cond ((not ,test) ,@l))))
 
-(_??_ (unless #f (+ 2 3)) 5)
-(_??_ (unless #t (+ 2 3)) #f)
+(unless #f (+ 2 3))
+(unless #t (+ 2 3))
 
 (define (cdar l) (cdr (car l)))
 
-(_??_ (cdar '((1 2) (3 4))) '(2))
+(cdar '((1 2) (3 4)))
 
 (define (cddr l) (cdr (cdr l)))
 
-(_??_ (cddr '(1 2 3)) '(3))
+(cddr '(1 2 3))
 
 (define (caddr l) (car (cdr (cdr l))))
 
-(_??_ (caddr '(1 2 3 4)) 3)
+(caddr '(1 2 3 4))
 
 (define (reverse list)
   (define (_r old new)
@@ -263,7 +257,7 @@
   (_r list ())
   )
 
-(_??_ (reverse '(1 2 3)) '(3 2 1))
+(reverse '(1 2 3))
 
 (define make-list
   (lambda (a . b)
@@ -281,9 +275,9 @@
     )
   )
     
-(_??_ (make-list 10 'a) '(a a a a a a a a a a))
+(make-list 10 'a)
 
-(_??_ (make-list 10) '(#f #f #f #f #f #f #f #f #f #f))
+(make-list 10)
 
 (define for-each
   (lambda (proc . lists)
@@ -299,20 +293,18 @@
     )
   )
 
-(_??_ (let ((a 0))
-	(for-each (lambda (b) (set! a (+ a b))) '(1 2 3))
-	a
-	)
-      6)
+(let ((a 0))
+  (for-each (lambda (b) (set! a (+ a b))) '(1 2 3))
+  a
+  )
       
-(_??_ (call-with-current-continuation
+(call-with-current-continuation
        (lambda (exit)
 	 (for-each (lambda (x)
 		     (if (negative? x)
 			 (exit x)))
 		   '(54 0 37 -3 245 19))
 	 #t))
-      -3)
 
 (define case
   (macro (test . l)
@@ -359,11 +351,11 @@
 	 )
   )
 
-(_??_ (case 1 (1 "one") (2 "two") (3 => (lambda (x) (write (list "the value is" x)))) (12 "twelve") (else "else")) "one")
-(_??_ (case 2 (1 "one") (2 "two") (3 => (lambda (x) (write (list "the value is" x)))) (12 "twelve") (else "else")) "two")
-(_??_ (case 3 (1 "one") (2 "two") (3 => (lambda (x) (write (list "the value is" x)) "three")) (12 "twelve") (else "else")) "three")
-(_??_ (case 4 (1 "one") (2 "two") (3 => (lambda (x) (write (list "the value is" x)))) (12 "twelve") (else "else")) "else")
-(_??_ (case 12 (1 "one") (2 "two") (3 => (lambda (x) (write (list "the value is" x)))) (12 "twelve") (else "else")) "twelve")
+(case 1 (1 "one") (2 "two") (3 => (lambda (x) (write (list "the value is" x)))) (12 "twelve") (else "else"))
+(case 2 (1 "one") (2 "two") (3 => (lambda (x) (write (list "the value is" x)))) (12 "twelve") (else "else"))
+(case 3 (1 "one") (2 "two") (3 => (lambda (x) (write (list "the value is" x)) "three")) (12 "twelve") (else "else"))
+(case 4 (1 "one") (2 "two") (3 => (lambda (x) (write (list "the value is" x)))) (12 "twelve") (else "else"))
+(case 12 (1 "one") (2 "two") (3 => (lambda (x) (write (list "the value is" x)))) (12 "twelve") (else "else"))
 
 (define do
   (macro (vars test . cmds)
@@ -388,15 +380,9 @@
     )
   )
 
-(_??_ (do ((x 1 (+ x 1))
-	   (y 0)
-	   )
-	  ((= x 10) y)
-	(set! y (+ y x))
-	)
-      45)
-
-(_??_ (do ((vec (make-vector 5))
-	   (i 0 (+ i 1)))
-	  ((= i 5) vec)
-	(vector-set! vec i i)) #(0 1 2 3 4))
+(do ((x 1 (+ x 1))
+     (y 0)
+     )
+    ((= x 10) y)
+  (set! y (+ y x))
+  )
diff --git a/src/scheme/ao_scheme_basic_syntax.scheme b/src/scheme/ao_scheme_basic_syntax.scheme
index 563364a9..4cd3e167 100644
--- a/src/scheme/ao_scheme_basic_syntax.scheme
+++ b/src/scheme/ao_scheme_basic_syntax.scheme
@@ -13,8 +13,6 @@
 ;
 ; Basic syntax placed in ROM
 
-(def (quote _?_) (lambda (a b) (cond ((eq? a b) a) (else (exit 1)))))
-
 (def (quote list) (lambda l l))
 
 (def (quote def!)
@@ -28,7 +26,7 @@
 
 (begin
  (def! append
-   (lambda args
+   (lambda a
 	  (def! _a
 	    (lambda (a b)
 	      (cond ((null? a) b)
@@ -45,7 +43,7 @@
 		    )
 	      )
 	    )
-	  (_b args)
+	  (_b a)
 	  )
    )
  'append)
@@ -122,7 +120,7 @@
 
 					; execute to resolve macros
 
-(_?_ (or #f #t) #t)
+(or #f #t)
 
 (define and
   (macro a
@@ -149,7 +147,7 @@
 
 					; execute to resolve macros
 
-(_?_ (and #t #f) #f)
+(and #t #f)
 
 					; (if <condition> <if-true>)
 					; (if <condition> <if-true> <if-false)
@@ -169,10 +167,10 @@
     )
   )
 
-(_?_ (if (> 3 2) 'yes) 'yes)
-(_?_ (if (> 3 2) 'yes 'no) 'yes)
-(_?_ (if (> 2 3) 'no 'yes) 'yes)
-(_?_ (if (> 2 3) 'no) #f)
+(if (> 3 2) 'yes)
+(if (> 3 2) 'yes 'no)
+(if (> 2 3) 'no 'yes)
+(if (> 2 3) 'no)
 
 (define letrec
   (macro (a . b)
@@ -230,7 +228,7 @@
 	 )
      )
 
-(_?_ (letrec ((a 1) (b a)) (+ a b)) 2)
+(letrec ((a 1) (b a)) (+ a b))
 
 					; letrec is sufficient for let*
 
@@ -259,10 +257,7 @@
 	)
   )
 
-(_?_ (equal? '(a b c) '(a b c)) #t)
-(_?_ (equal? '(a b c) '(a b b)) #f)
-
-(def (quote _??_) (lambda (a b) (cond ((equal? a b) a) (else (exit 1)))))
+(equal? '(a b c) '(a b c))
 
 					; basic list accessors
 
@@ -270,18 +265,6 @@
 
 (define (cadr a) (car (cdr a)))
 
-(define (cdar l) (cdr (car l)))
-
-(_??_ (cdar '((1 2) (3 4))) '(2))
-
-(define (cddr l) (cdr (cdr l)))
-
-(_??_ (cddr '(1 2 3)) '(3))
-
-(define (caddr l) (car (cdr (cdr l))))
-
-(_??_ (caddr '(1 2 3 4)) 3)
-
 (define (list-ref a b)
   (car (list-tail a b))
   )
@@ -301,14 +284,14 @@
 	)
   )
 
-(_??_ (member '(2) '((1) (2) (3)))  '((2) (3)))
-(_??_ (member '(4) '((1) (2) (3))) #f)
+(member '(2) '((1) (2) (3)))
+(member '(4) '((1) (2) (3)))
 
 (define (memq a b) (member a b eq?))
 
-(_??_ (memq 2 '(1 2 3)) '(2 3))
-(_??_ (memq 4 '(1 2 3)) #f)
-(_??_ (memq '(2) '((1) (2) (3))) #f)
+(memq 2 '(1 2 3))
+(memq 4 '(1 2 3))
+(memq '(2) '((1) (2) (3)))
 
 (define (assoc a b . t?)
   (if (null? t?)
@@ -324,12 +307,11 @@
     )
   )
 
+(assoc '(c) '((a 1) (b 2) ((c) 3)))
+
 (define (assq a b) (assoc a b eq?))
-(define assv assq)
 
-(_??_ (assq 'a '((a 1) (b 2) (c 3))) '(a 1))
-(_??_ (assv 'b '((a 1) (b 2) (c 3))) '(b 2))
-(_??_ (assoc '(c) '((a 1) (b 2) ((c) 3))) '((c) 3))
+(assq 'a '((a 1) (b 2) (c 3)))
 
 (define map
   (lambda (proc . lists)
@@ -358,7 +340,7 @@
 	 )
   )
 
-(_??_ (map cadr '((a b) (d e) (g h))) '(b e h))
+(map cadr '((a b) (d e) (g h)))
 
 					; use map as for-each in basic
 					; mode
@@ -430,8 +412,3 @@
 (define (newline) (write-char #\newline))
 
 (newline)
-
-(define (eof-object? a)
-  (equal? a 'eof)
-  )
-
diff --git a/src/scheme/ao_scheme_char.scheme b/src/scheme/ao_scheme_char.scheme
index c0353834..fdb7fa64 100644
--- a/src/scheme/ao_scheme_char.scheme
+++ b/src/scheme/ao_scheme_char.scheme
@@ -15,60 +15,60 @@
 
 (define char? integer?)
 
-(_??_ (char? #\q) #t)
-(_??_ (char? "h") #f)
+(char? #\q)
+(char? "h")
 
 (define (char-upper-case? c) (<= #\A c #\Z))
 
-(_??_ (char-upper-case? #\a) #f)
-(_??_ (char-upper-case? #\B) #t)
-(_??_ (char-upper-case? #\0) #f)
-(_??_ (char-upper-case? #\space) #f)
+(char-upper-case? #\a)
+(char-upper-case? #\B)
+(char-upper-case? #\0)
+(char-upper-case? #\space)
 
 (define (char-lower-case? c) (<= #\a c #\a))
 
-(_??_ (char-lower-case? #\a) #t)
-(_??_ (char-lower-case? #\B) #f)
-(_??_ (char-lower-case? #\0) #f)
-(_??_ (char-lower-case? #\space) #f)
+(char-lower-case? #\a)
+(char-lower-case? #\B)
+(char-lower-case? #\0)
+(char-lower-case? #\space)
 
 (define (char-alphabetic? c) (or (char-upper-case? c) (char-lower-case? c)))
 
-(_??_ (char-alphabetic? #\a) #t)
-(_??_ (char-alphabetic? #\B) #t)
-(_??_ (char-alphabetic? #\0) #f)
-(_??_ (char-alphabetic? #\space) #f)
+(char-alphabetic? #\a)
+(char-alphabetic? #\B)
+(char-alphabetic? #\0)
+(char-alphabetic? #\space)
 
 (define (char-numeric? c) (<= #\0 c #\9))
 
-(_??_ (char-numeric? #\a) #f)
-(_??_ (char-numeric? #\B) #f)
-(_??_ (char-numeric? #\0) #t)
-(_??_ (char-numeric? #\space) #f)
+(char-numeric? #\a)
+(char-numeric? #\B)
+(char-numeric? #\0)
+(char-numeric? #\space)
 
 (define (char-whitespace? c) (or (<= #\tab c #\return) (= #\space c)))
 
-(_??_ (char-whitespace? #\a) #f)
-(_??_ (char-whitespace? #\B) #f)
-(_??_ (char-whitespace? #\0) #f)
-(_??_ (char-whitespace? #\space) #t)
+(char-whitespace? #\a)
+(char-whitespace? #\B)
+(char-whitespace? #\0)
+(char-whitespace? #\space)
 
 (define char->integer (macro (v) v))
 (define integer->char char->integer)
 
 (define (char-upcase c) (if (char-lower-case? c) (+ c (- #\A #\a)) c))
 
-(_??_ (char-upcase #\a) #\A)
-(_??_ (char-upcase #\B) #\B)
-(_??_ (char-upcase #\0) #\0)
-(_??_ (char-upcase #\space) #\space)
+(char-upcase #\a)
+(char-upcase #\B)
+(char-upcase #\0)
+(char-upcase #\space)
 
 (define (char-downcase c) (if (char-upper-case? c) (+ c (- #\a #\A)) c))
 
-(_??_ (char-downcase #\a) #\a)
-(_??_ (char-downcase #\B) #\b)
-(_??_ (char-downcase #\0) #\0)
-(_??_ (char-downcase #\space) #\space)
+(char-downcase #\a)
+(char-downcase #\B)
+(char-downcase #\0)
+(char-downcase #\space)
 
 (define (digit-value c)
   (if (char-numeric? c)
@@ -76,5 +76,5 @@
       #f)
   )
 
-(_??_ (digit-value #\1) 1)
-(_??_ (digit-value #\a) #f)
+(digit-value #\1)
+(digit-value #\a)
diff --git a/src/scheme/ao_scheme_port.scheme b/src/scheme/ao_scheme_port.scheme
index e4fa06cc..886aed25 100644
--- a/src/scheme/ao_scheme_port.scheme
+++ b/src/scheme/ao_scheme_port.scheme
@@ -26,6 +26,10 @@
 (newline)
 (newline (open-output-file "/dev/null"))
 
+(define (eof-object? a)
+  (equal? a 'eof)
+  )
+
 (define (load name)
   (let ((p (open-input-file name))
 	(e))
diff --git a/src/scheme/ao_scheme_string.scheme b/src/scheme/ao_scheme_string.scheme
index feeca37b..99f16fab 100644
--- a/src/scheme/ao_scheme_string.scheme
+++ b/src/scheme/ao_scheme_string.scheme
@@ -15,7 +15,7 @@
 
 (define string (lambda chars (list->string chars)))
 
-(_??_ (string #\a #\b #\c) "abc")
+(string #\a #\b #\c)
 
 (define string-map
   (lambda (proc . strings)
@@ -38,7 +38,7 @@
     )
   )
 
-(_??_ (string-map (lambda (x) (+ 1 x)) "HAL") "IBM")
+(string-map (lambda (x) (+ 1 x)) "HAL")
 
 (define string-copy!
   (lambda (t a f . args)
@@ -76,9 +76,9 @@
     )
   )
 
-(_??_ (string-copy! (make-string 10) 0 "hello" 0 5) "hello     ")
-(_??_ (string-copy! (make-string 10) 1 "hello" 0 5) " hello    ")
-(_??_ (string-copy! (make-string 10) 0 "hello" 0 5) "hello     ")
+(string-copy! (make-string 10) 0 "hello" 0 5)
+(string-copy! (make-string 10) 1 "hello" 0 5)
+(string-copy! (make-string 10) 0 "hello" 0 5)
 
 (define (string-upcase s) (string-map char-upcase s))
 (define (string-downcase s) (string-map char-downcase s))
@@ -100,9 +100,9 @@
     )
   )
 
-(_??_ (string-copy "hello" 0 1) "h")
-(_??_ (string-copy "hello" 1) "ello")
-(_??_ (string-copy "hello") "hello")
+(string-copy "hello" 0 1)
+(string-copy "hello" 1)
+(string-copy "hello")
 
 (define substring string-copy)
 
@@ -130,8 +130,8 @@
     )
   )
 
-(_??_ (string-fill! (make-string 10) #\a) "aaaaaaaaaa")
-(_??_ (string-fill! (make-string 10) #\a 1 2) " a        ")
+(string-fill! (make-string 10) #\a)
+(string-fill! (make-string 10) #\a 1 2)
 
 (define string-for-each
   (lambda (proc . strings)
@@ -153,4 +153,4 @@
     )
   )
 
-(_??_ (string-for-each write-char "IBM\n") #t)
+(string-for-each write-char "IBM\n")
diff --git a/src/scheme/ao_scheme_vector.scheme b/src/scheme/ao_scheme_vector.scheme
index bf40204b..6c25aae5 100644
--- a/src/scheme/ao_scheme_vector.scheme
+++ b/src/scheme/ao_scheme_vector.scheme
@@ -35,7 +35,7 @@
     )
   )
 
-(_??_ (vector->string #(#\a #\b #\c) 0 2) "ab")
+(vector->string #(#\a #\b #\c) 0 2)
 
 (define string->vector
   (lambda (s . args)
@@ -58,7 +58,7 @@
     )
   )
 
-(_??_ (string->vector "hello" 0 2) #(#\h #\e))
+(string->vector "hello" 0 2)
     
 (define vector-copy!
   (lambda (t a f . args)
@@ -98,7 +98,7 @@
 
 					; simple vector-copy test
 
-(_??_ (vector-copy! (make-vector 10 "t") 0 (make-vector 5 "f") 0 5) #("f" "f" "f" "f" "f" "t" "t" "t" "t" "t"))
+(vector-copy! (make-vector 10 "t") 0 (make-vector 5 "f") 0 5)
 
 (let ((v (vector 1 2 3 4 5 6 7 8 9 0)))
   (vector-copy! v 1 v 0 2)
@@ -121,7 +121,7 @@
     )
   )
 
-(_??_ (vector-copy #(1 2 3) 0 3) #(1 2 3))
+(vector-copy #(1 2 3) 0 3)
 
 (define vector-append
   (lambda a
@@ -138,7 +138,7 @@
     )
   )
 
-(_??_ (vector-append #(1 2 3) #(4 5 6) #(7 8 9)) #(1 2 3 4 5 6 7 8 9))
+(vector-append #(1 2 3) #(4 5 6) #(7 8 9))
 
 (define vector-fill!
   (lambda (v a . args)
@@ -164,7 +164,7 @@
     )
   )
 
-(_??_ (vector-fill! (make-vector 3) #t 1 2) #(#f #t #f))
+(vector-fill! (make-vector 3) #t 1 2)
 
 					; like 'map', but for vectors
 
@@ -189,4 +189,4 @@
     )
   )
     
-(_??_ (vector-map + #(1 2 3) #(4 5 6)) #(5 7 9))
+(vector-map + #(1 2 3) #(4 5 6))
diff --git a/src/scheme/test/Makefile b/src/scheme/test/Makefile
index 686d809b..a8129217 100644
--- a/src/scheme/test/Makefile
+++ b/src/scheme/test/Makefile
@@ -19,6 +19,7 @@ CFLAGS=$(DFLAGS) $(OFLAGS) $(PGFLAGS) -g -Wall -Wextra -I. -I.. -Wpointer-arith
 
 ao-scheme: $(OBJS)
 	cc $(CFLAGS) -o $@ $(OBJS) -lm
+	./ao-scheme ao_scheme_test.scheme
 
 $(OBJS): $(HDRS)
 
diff --git a/src/scheme/test/ao_scheme_test.c b/src/scheme/test/ao_scheme_test.c
index ed10d3be..195b8b46 100644
--- a/src/scheme/test/ao_scheme_test.c
+++ b/src/scheme/test/ao_scheme_test.c
@@ -131,7 +131,9 @@ main (int argc, char **argv)
 			usage(argv[0]);
 			exit(0);
 		case 'l':
+#ifdef AO_SCHEME_FEATURE_POSIX
 			ao_scheme_set_argv(&argv[argc]);
+#endif
 			run_file(optarg);
 			break;
 		default:
@@ -139,7 +141,9 @@ main (int argc, char **argv)
 			exit(1);
 		}
 	}
+#ifdef AO_SCHEME_FEATURE_POSIX
 	ao_scheme_set_argv(argv + optind);
+#endif
 	if (argv[optind]) {
 		run_file(argv[optind]);
 	} else {
diff --git a/src/scheme/test/ao_scheme_test.scheme b/src/scheme/test/ao_scheme_test.scheme
new file mode 100644
index 00000000..41aaeda1
--- /dev/null
+++ b/src/scheme/test/ao_scheme_test.scheme
@@ -0,0 +1,175 @@
+					; Basic syntax tests
+
+(define _assert-eq_
+  (macro (a b)
+	   (list cond
+		 (list (list eq? a b)
+		       )
+		 (list 'else
+		       (list display "failed: ")
+		       (list write (list quote a))
+		       (list newline)
+		       (list exit 1)
+		       )
+		 )
+	   )
+  )
+
+(define _assert-equal_
+  (macro (a b)
+    (list cond
+	  (list (list equal? a b)
+		)
+	  (list 'else
+		(list display "failed: ")
+		(list write (list quote a))
+		(list newline)
+		(list exit 1)
+		)
+	  )
+    )
+  )
+
+(_assert-eq_ (or #f #t) #t)
+(_assert-eq_ (and #t #f) #f)
+(_assert-eq_ (if (> 3 2) 'yes) 'yes)
+(_assert-eq_ (if (> 3 2) 'yes 'no) 'yes)
+(_assert-eq_ (if (> 2 3) 'no 'yes) 'yes)
+(_assert-eq_ (if (> 2 3) 'no) #f)
+
+(_assert-eq_ (letrec ((a 1) (b a)) (+ a b)) 2)
+
+(_assert-eq_ (equal? '(a b c) '(a b c)) #t)
+(_assert-eq_ (equal? '(a b c) '(a b b)) #f)
+
+(_assert-equal_ (cdar '((1 2) (3 4))) '(2))
+
+(_assert-equal_ (cddr '(1 2 3)) '(3))
+
+(_assert-equal_ (caddr '(1 2 3 4)) 3)
+
+(_assert-equal_ (member '(2) '((1) (2) (3)))  '((2) (3)))
+(_assert-equal_ (member '(4) '((1) (2) (3))) #f)
+
+(_assert-equal_ (memq 2 '(1 2 3)) '(2 3))
+(_assert-equal_ (memq 4 '(1 2 3)) #f)
+(_assert-equal_ (memq '(2) '((1) (2) (3))) #f)
+
+(_assert-equal_ (assq 'a '((a 1) (b 2) (c 3))) '(a 1))
+(_assert-equal_ (assv 'b '((a 1) (b 2) (c 3))) '(b 2))
+(_assert-equal_ (assoc '(c) '((a 1) (b 2) ((c) 3))) '((c) 3))
+
+(_assert-equal_ (map cadr '((a b) (d e) (g h))) '(b e h))
+
+(_assert-equal_ `(hello ,(+ 1 2) ,@(list 1 2 3) `foo) '(hello 3 1 2 3 (quasiquote foo)))
+
+					; Advanced syntax tests
+
+(_assert-eq_ (equal? '(a b c) '(a b c)) #t)
+(_assert-eq_ (equal? '(a b c) '(a b b)) #f)
+(_assert-eq_ (equal? #(1 2 3) #(1 2 3)) #t)
+(_assert-eq_ (equal? #(1 2 3) #(4 5 6)) #f)
+(_assert-equal_ `(hello ,(+ 1 2) ,@(list 1 2 3) `foo) '(hello 3 1 2 3 (quasiquote foo)))
+(_assert-equal_ (let ((x 1) (y)) (set! y 2) (+ x y)) 3)
+(_assert-equal_ (when #t (+ 1 2)) 3)
+(_assert-equal_ (when #f (+ 1 2)) #f)
+(_assert-equal_ (unless #f (+ 2 3)) 5)
+(_assert-equal_ (unless #t (+ 2 3)) #f)
+(_assert-equal_ (cdar '((1 2) (3 4))) '(2))
+(_assert-equal_ (cddr '(1 2 3)) '(3))
+(_assert-equal_ (caddr '(1 2 3 4)) 3)
+(_assert-equal_ (reverse '(1 2 3)) '(3 2 1))
+(_assert-equal_ (make-list 10 'a) '(a a a a a a a a a a))
+(_assert-equal_ (make-list 10) '(#f #f #f #f #f #f #f #f #f #f))
+(_assert-equal_ (let ((a 0))
+		  (for-each (lambda (b) (set! a (+ a b))) '(1 2 3))
+		  a
+		  )
+		6)
+(_assert-equal_ (call-with-current-continuation
+		 (lambda (exit)
+		   (for-each (lambda (x)
+			       (if (negative? x)
+				   (exit x)))
+			     '(54 0 37 -3 245 19))
+		   )
+		 )
+		-3)
+(_assert-equal_ (case 1 (1 "one") (2 "two") (3 => (lambda (x) "three")) (12 "twelve") (else "else")) "one")
+(_assert-equal_ (case 2 (1 "one") (2 "two") (3 => (lambda (x) "three")) (12 "twelve") (else "else")) "two")
+(_assert-equal_ (case 3 (1 "one") (2 "two") (3 => (lambda (x) "three")) (12 "twelve") (else "else")) "three")
+(_assert-equal_ (case 4 (1 "one") (2 "two") (3 => (lambda (x) "three")) (12 "twelve") (else "else")) "else")
+(_assert-equal_ (case 12 (1 "one") (2 "two") (3 => (lambda (x) "three")) (12 "twelve") (else "else")) "twelve")
+(_assert-equal_ (do ((x 1 (+ x 1))
+	   (y 0)
+	   )
+	  ((= x 10) y)
+	(set! y (+ y x))
+	)
+      45)
+
+(_assert-equal_ (do ((vec (make-vector 5))
+		     (i 0 (+ i 1)))
+		    ((= i 5) vec)
+		  (vector-set! vec i i))
+		#(0 1 2 3 4))
+
+					; vector tests
+
+(_assert-equal_ (vector->string #(#\a #\b #\c) 0 2) "ab")
+(_assert-equal_ (string->vector "hello" 0 2) #(#\h #\e))
+(_assert-equal_ (vector-copy! (make-vector 10 "t") 0 (make-vector 5 "f") 0 5) #("f" "f" "f" "f" "f" "t" "t" "t" "t" "t"))
+(_assert-equal_ (vector-copy #(1 2 3) 0 3) #(1 2 3))
+(_assert-equal_ (vector-append #(1 2 3) #(4 5 6) #(7 8 9)) #(1 2 3 4 5 6 7 8 9))
+(_assert-equal_ (vector-fill! (make-vector 3) #t 1 2) #(#f #t #f))
+(_assert-equal_ (vector-map + #(1 2 3) #(4 5 6)) #(5 7 9))
+
+					; string tests
+
+(_assert-equal_ (string #\a #\b #\c) "abc")
+(_assert-equal_ (string-map (lambda (x) (+ 1 x)) "HAL") "IBM")
+(_assert-equal_ (string-copy! (make-string 10) 0 "hello" 0 5) "hello     ")
+(_assert-equal_ (string-copy! (make-string 10) 1 "hello" 0 5) " hello    ")
+(_assert-equal_ (string-copy! (make-string 10) 0 "hello" 0 5) "hello     ")
+(_assert-equal_ (string-copy "hello" 0 1) "h")
+(_assert-equal_ (string-copy "hello" 1) "ello")
+(_assert-equal_ (string-copy "hello") "hello")
+(_assert-equal_ (string-fill! (make-string 10) #\a) "aaaaaaaaaa")
+(_assert-equal_ (string-fill! (make-string 10) #\a 1 2) " a        ")
+;(_assert-equal_ (string-for-each write-char "IBM\n") #t)
+
+					; char tests
+
+(_assert-equal_ (char? #\q) #t)
+(_assert-equal_ (char? "h") #f)
+(_assert-equal_ (char-upper-case? #\a) #f)
+(_assert-equal_ (char-upper-case? #\B) #t)
+(_assert-equal_ (char-upper-case? #\0) #f)
+(_assert-equal_ (char-upper-case? #\space) #f)
+(_assert-equal_ (char-lower-case? #\a) #t)
+(_assert-equal_ (char-lower-case? #\B) #f)
+(_assert-equal_ (char-lower-case? #\0) #f)
+(_assert-equal_ (char-lower-case? #\space) #f)
+(_assert-equal_ (char-alphabetic? #\a) #t)
+(_assert-equal_ (char-alphabetic? #\B) #t)
+(_assert-equal_ (char-alphabetic? #\0) #f)
+(_assert-equal_ (char-alphabetic? #\space) #f)
+(_assert-equal_ (char-numeric? #\a) #f)
+(_assert-equal_ (char-numeric? #\B) #f)
+(_assert-equal_ (char-numeric? #\0) #t)
+(_assert-equal_ (char-numeric? #\space) #f)
+(_assert-equal_ (char-whitespace? #\a) #f)
+(_assert-equal_ (char-whitespace? #\B) #f)
+(_assert-equal_ (char-whitespace? #\0) #f)
+(_assert-equal_ (char-whitespace? #\space) #t)
+(_assert-equal_ (char-upcase #\a) #\A)
+(_assert-equal_ (char-upcase #\B) #\B)
+(_assert-equal_ (char-upcase #\0) #\0)
+(_assert-equal_ (char-upcase #\space) #\space)
+(_assert-equal_ (char-downcase #\a) #\a)
+(_assert-equal_ (char-downcase #\B) #\b)
+(_assert-equal_ (char-downcase #\0) #\0)
+(_assert-equal_ (char-downcase #\space) #\space)
+(_assert-equal_ (digit-value #\1) 1)
+(_assert-equal_ (digit-value #\a) #f)
+
diff --git a/src/scheme/tiny-test/Makefile b/src/scheme/tiny-test/Makefile
index ca71a665..61ef687a 100644
--- a/src/scheme/tiny-test/Makefile
+++ b/src/scheme/tiny-test/Makefile
@@ -2,6 +2,7 @@ include ../Makefile-inc
 
 vpath %.o .
 vpath %.c ..
+vpath ao_scheme_test.c ../test
 vpath %.h ..
 vpath %.scheme ..
 vpath ao_scheme_make_const ../make-const
@@ -17,6 +18,7 @@ CFLAGS=-O0 -g -Wall -Wextra -I. -I.. -Wpointer-arith -Wmissing-declarations -Wfo
 
 ao-scheme-tiny: $(OBJS)
 	cc $(CFLAGS) -o $@ $(OBJS) -lm
+	./ao-scheme-tiny ao_scheme_tiny_test.scheme
 
 $(OBJS): $(HDRS)
 
diff --git a/src/scheme/tiny-test/ao_scheme_test.c b/src/scheme/tiny-test/ao_scheme_test.c
deleted file mode 100644
index 89b8e5fa..00000000
--- a/src/scheme/tiny-test/ao_scheme_test.c
+++ /dev/null
@@ -1,116 +0,0 @@
-/*
- * Copyright © 2016 Keith Packard <keithp@keithp.com>
- *
- * 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.
- */
-
-#include "ao_scheme.h"
-#include <stdio.h>
-
-static char save_file[] = "scheme.image";
-
-int
-ao_scheme_os_save(void)
-{
-	FILE	*save = fopen(save_file, "w");
-
-	if (!save) {
-		perror(save_file);
-		return 0;
-	}
-	fwrite(ao_scheme_pool, 1, AO_SCHEME_POOL_TOTAL, save);
-	fclose(save);
-	return 1;
-}
-
-int
-ao_scheme_os_restore_save(struct ao_scheme_os_save *save, int offset)
-{
-	FILE	*restore = fopen(save_file, "r");
-	size_t	ret;
-
-	if (!restore) {
-		perror(save_file);
-		return 0;
-	}
-	fseek(restore, offset, SEEK_SET);
-	ret = fread(save, sizeof (struct ao_scheme_os_save), 1, restore);
-	fclose(restore);
-	if (ret != 1)
-		return 0;
-	return 1;
-}
-
-int
-ao_scheme_os_restore(void)
-{
-	FILE	*restore = fopen(save_file, "r");
-	size_t	ret;
-
-	if (!restore) {
-		perror(save_file);
-		return 0;
-	}
-	ret = fread(ao_scheme_pool, 1, AO_SCHEME_POOL_TOTAL, restore);
-	fclose(restore);
-	if (ret != AO_SCHEME_POOL_TOTAL)
-		return 0;
-	return 1;
-}
-
-int
-main (int argc, char **argv)
-{
-	(void) argc;
-
-	while (*++argv) {
-		FILE *in = fopen(*argv, "r");
-		if (!in) {
-			perror(*argv);
-			exit(1);
-		}
-		ao_scheme_read_eval_print(in, stdout, false);
-		fclose(in);
-	}
-	ao_scheme_read_eval_print(stdin, stdout, true);
-
-#ifdef DBG_MEM_STATS
-	printf ("collects: full: %lu incremental %lu\n",
-		ao_scheme_collects[AO_SCHEME_COLLECT_FULL],
-		ao_scheme_collects[AO_SCHEME_COLLECT_INCREMENTAL]);
-
-	printf ("freed: full %lu incremental %lu\n",
-		ao_scheme_freed[AO_SCHEME_COLLECT_FULL],
-		ao_scheme_freed[AO_SCHEME_COLLECT_INCREMENTAL]);
-
-	printf("loops: full %lu incremental %lu\n",
-		ao_scheme_loops[AO_SCHEME_COLLECT_FULL],
-		ao_scheme_loops[AO_SCHEME_COLLECT_INCREMENTAL]);
-
-	printf("loops per collect: full %f incremental %f\n",
-	       (double) ao_scheme_loops[AO_SCHEME_COLLECT_FULL] /
-	       (double) ao_scheme_collects[AO_SCHEME_COLLECT_FULL],
-	       (double) ao_scheme_loops[AO_SCHEME_COLLECT_INCREMENTAL] /
-	       (double) ao_scheme_collects[AO_SCHEME_COLLECT_INCREMENTAL]);
-
-	printf("freed per collect: full %f incremental %f\n",
-	       (double) ao_scheme_freed[AO_SCHEME_COLLECT_FULL] /
-	       (double) ao_scheme_collects[AO_SCHEME_COLLECT_FULL],
-	       (double) ao_scheme_freed[AO_SCHEME_COLLECT_INCREMENTAL] /
-	       (double) ao_scheme_collects[AO_SCHEME_COLLECT_INCREMENTAL]);
-
-	printf("freed per loop: full %f incremental %f\n",
-	       (double) ao_scheme_freed[AO_SCHEME_COLLECT_FULL] /
-	       (double) ao_scheme_loops[AO_SCHEME_COLLECT_FULL],
-	       (double) ao_scheme_freed[AO_SCHEME_COLLECT_INCREMENTAL] /
-	       (double) ao_scheme_loops[AO_SCHEME_COLLECT_INCREMENTAL]);
-#endif
-}
diff --git a/src/scheme/tiny-test/ao_scheme_tiny_test.scheme b/src/scheme/tiny-test/ao_scheme_tiny_test.scheme
new file mode 100644
index 00000000..94c90ffe
--- /dev/null
+++ b/src/scheme/tiny-test/ao_scheme_tiny_test.scheme
@@ -0,0 +1,56 @@
+					; Basic syntax tests
+
+(define _assert-eq_
+  (macro (a b)
+	   (list cond
+		 (list (list eq? a b)
+		       )
+		 (list 'else
+		       (list display "failed: ")
+		       (list write (list quote a))
+		       (list newline)
+		       (list exit 1)
+		       )
+		 )
+	   )
+  )
+
+(define _assert-equal_
+  (macro (a b)
+	   (list cond
+		 (list (list equal? a b)
+		       )
+		 (list 'else
+		       (list display "failed: ")
+		       (list write (list quote a))
+		       (list newline)
+		       (list exit 1)
+		       )
+		 )
+	   )
+  )
+
+(_assert-eq_ (or #f #t) #t)
+(_assert-eq_ (and #t #f) #f)
+(_assert-eq_ (if (> 3 2) 'yes) 'yes)
+(_assert-eq_ (if (> 3 2) 'yes 'no) 'yes)
+(_assert-eq_ (if (> 2 3) 'no 'yes) 'yes)
+(_assert-eq_ (if (> 2 3) 'no) #f)
+
+(_assert-eq_ (letrec ((a 1) (b a)) (+ a b)) 2)
+
+(_assert-eq_ (equal? '(a b c) '(a b c)) #t)
+(_assert-eq_ (equal? '(a b c) '(a b b)) #f)
+
+(_assert-equal_ (member '(2) '((1) (2) (3)))  '((2) (3)))
+(_assert-equal_ (member '(4) '((1) (2) (3))) #f)
+
+(_assert-equal_ (memq 2 '(1 2 3)) '(2 3))
+(_assert-equal_ (memq 4 '(1 2 3)) #f)
+(_assert-equal_ (memq '(2) '((1) (2) (3))) #f)
+
+(_assert-equal_ (assq 'a '((a 1) (b 2) (c 3))) '(a 1))
+(_assert-equal_ (assoc '(c) '((a 1) (b 2) ((c) 3))) '((c) 3))
+
+(_assert-equal_ (map cadr '((a b) (d e) (g h))) '(b e h))
+
-- 
2.30.2