#! /bin/sh
exec ../src/sizzle -qs $0 $*
!#
;; test/basic.scm -- basic tests
;;
;; Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
;;
;; This 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, or (at your option)
;; any later version.
;; 
;; This software 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 package; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.  

;; Load the test framework.

(load "test-suite.scm")

;; Actual tests.

(define num 35.4)
(define twelve 'dozen)

(begin-section "equality predicates")

(begin-sub-section "eq?")
(pass-if (eq? '() '()) #t eq?)
(pass-if (eq? '() '(1)) #f eq?)
(pass-if (eq? #t #t) #t eq?)
(pass-if (eq? #t #f) #f eq?)
(pass-if (eq? #f #f) #t eq?)
(pass-if (eq? 'foo 'foo) #t eq?)
(pass-if (eq? 'foo 'bar) #f eq?)

(begin-sub-section "eqv?")
(pass-if (eqv? '() '()) #t eq?)
(pass-if (eqv? '() '(1)) #f eq?)
(pass-if (eqv? #t #t) #t eq?)
(pass-if (eqv? #t #f) #f eq?)
(pass-if (eqv? #f #f) #t eq?)
(pass-if (eqv? 'foo 'foo) #t eq?)
(pass-if (eqv? 'foo 'bar) #f eq?)
(pass-if (eqv? 1 1) #t eq?)
(pass-if (eqv? 1 0) #f eq?)
(pass-if (eqv? 1.1 1.1) #t eq?)
(pass-if (eqv? 1.1 0.1) #f eq?)

(begin-sub-section "equal?")
(pass-if (equal? '() '()) #t eq?)
(pass-if (equal? '() '(1)) #f eq?)
(pass-if (equal? #t #t) #t eq?)
(pass-if (equal? #t #f) #f eq?)
(pass-if (equal? #f #f) #t eq?)
(pass-if (equal? 'foo 'foo) #t eq?)
(pass-if (equal? 'foo 'bar) #f eq?)
(pass-if (equal? 1 1) #t eq?)
(pass-if (equal? 1 0) #f eq?)
(pass-if (equal? 1.1 1.1) #t eq?)
(pass-if (equal? 1.1 0.1) #f eq?)
(pass-if (equal? "foo" "foo") #t eq?)
(pass-if (equal? '#(1 2) '#(1 2)) #t eq?)
(pass-if (equal? '(1 2) '(1 2)) #t eq?)
(pass-if (equal? '#("Hallo" (foo bar)) '#("Hallo" (foo bar))) #t eq?)

(begin-section "symbol functions")

(begin-sub-section "symbol?")
(pass-if (symbol? "foo") #f eq?)
(pass-if (symbol? 'bar) #t eq?)
(pass-if (symbol? 23.0) #f eq?)
(pass-if (symbol? -42) #f eq?)
(pass-if (symbol? 15) #f eq?)
(pass-if (symbol? num) #f eq?)
(pass-if (symbol? 'num) #t eq?)
(pass-if (symbol? twelve) #t eq?)
(pass-if (symbol? 'twelve) #t eq?)
(pass-if (symbol? #t) #f eq?)
(pass-if (symbol? (car '(banana cream))) #t eq?)
(pass-if (symbol? (cdr '(banana cream))) #f eq?)


(begin-sub-section "string->symbol")
(pass-if (symbol? (string->symbol "q3")) #t eq?)
(pass-if (string->symbol "bla") 'bla eq?)

(begin-sub-section "symbol->string")
(pass-if (string? (symbol->string 'foo-foo)) #t eq?)
(pass-if (symbol->string 'bar-bar) "bar-bar" equal?)

(begin-section "boolean functions")

(begin-sub-section "boolean?")
(pass-if (boolean? #t) #t eq?)
(pass-if (boolean? #f) #t eq?)
(pass-if (boolean? (eq? 'foo 'foo)) #t eq?)
(pass-if (boolean? 12) #f eq?)
(pass-if (boolean? 'as) #f eq?)
(pass-if (boolean? #t) #t eq?)
(pass-if (boolean? (number? 'a)) #t eq?)
(pass-if (boolean? (cons 'a '())) #f eq?)

(begin-sub-section "not")
(pass-if (not #t) #f eq?)
(pass-if (not #f) #t eq?)
(pass-if (not 'frob) #f eq?)
(pass-if (not 42) #f eq?)
(pass-if (not -23.2323) #f eq?)

(begin-section "character functions")

(begin-sub-section "char?")
(pass-if (char? #\H) #t eq?)
(pass-if (char? #\ ) #t eq?)

(begin-sub-section "char=?")
(pass-if (char=? #\o #\o) #t eq?)
(pass-if (char=? #\! #\!) #t eq?)

(begin-sub-section "char<?")
(pass-if (char<? #\o #\p) #t eq?)
(pass-if (char<? #\  #\!) #t eq?)

(begin-sub-section "char<=?")
(pass-if (char<=? #\o #\p) #t eq?)
(pass-if (char<=? #\! #\!) #t eq?)

(begin-sub-section "char>?")
(pass-if (char>? #\p #\o) #t eq?)
(pass-if (char>? #\! #\ ) #t eq?)

(begin-sub-section "char>=?")
(pass-if (char>=? #\p #\o) #t eq?)
(pass-if (char>=? #\! #\!) #t eq?)

(begin-sub-section "char-ci=?")
(pass-if (char-ci=? #\O #\o) #t eq?)
(pass-if (char-ci=? #\! #\!) #t eq?)
(pass-if (char-ci=? #\O #\a) #f eq?)

(begin-sub-section "char-ci<?")
(pass-if (char-ci<? #\O #\p) #t eq?)
(pass-if (char-ci<? #\  #\!) #t eq?)
(pass-if (char-ci<? #\P #\o) #f eq?)

(begin-sub-section "char-ci<=?")
(pass-if (char-ci<=? #\o #\P) #t eq?)
(pass-if (char-ci<=? #\! #\!) #t eq?)
(pass-if (char-ci<=? #\p #\O) #f eq?)

(begin-sub-section "char-ci>?")
(pass-if (char-ci>? #\p #\O) #t eq?)
(pass-if (char-ci>? #\! #\ ) #t eq?)
(pass-if (char-ci>? #\o #\P) #f eq?)

(begin-sub-section "char-ci>=?")
(pass-if (char-ci>=? #\P #\o) #t eq?)
(pass-if (char-ci>=? #\! #\!) #t eq?)
(pass-if (char-ci>=? #\O #\p) #f eq?)

(begin-sub-section "char-alphabetic?")
(pass-if (char-alphabetic? #\a) #t eq?)
(pass-if (char-alphabetic? #\z) #t eq?)
(pass-if (char-alphabetic? #\A) #t eq?)
(pass-if (char-alphabetic? #\Z) #t eq?)
(pass-if (char-alphabetic? #\0) #f eq?)

(begin-sub-section "char-numeric?")
(pass-if (char-numeric? #\0) #t eq?)
(pass-if (char-numeric? #\0) #t eq?)
(pass-if (char-numeric? #\1) #t eq?)
(pass-if (char-numeric? #\2) #t eq?)
(pass-if (char-numeric? #\3) #t eq?)
(pass-if (char-numeric? #\4) #t eq?)
(pass-if (char-numeric? #\5) #t eq?)
(pass-if (char-numeric? #\6) #t eq?)
(pass-if (char-numeric? #\7) #t eq?)
(pass-if (char-numeric? #\8) #t eq?)
(pass-if (char-numeric? #\9) #t eq?)
(pass-if (char-numeric? #\_) #f eq?)

(begin-sub-section "char-whitespace?")
(pass-if (char-whitespace? #\ ) #t eq?)
;; Keep the newline in the following test!
(pass-if (char-whitespace? #\
) #t eq?)
;; Keep the tab in the following test!
(pass-if (char-whitespace? #\	) #t eq?)

(begin-sub-section "char-upper-case?")
(pass-if (char-upper-case? #\A) #t eq?)
(pass-if (char-upper-case? #\a) #f eq?)
(pass-if (char-upper-case? #\Z) #t eq?)
(pass-if (char-upper-case? #\z) #f eq?)
(pass-if (char-upper-case? #\!) #f eq?)

(begin-sub-section "char-lower-case?")
(pass-if (char-lower-case? #\a) #t eq?)
(pass-if (char-lower-case? #\A) #f eq?)
(pass-if (char-lower-case? #\z) #t eq?)
(pass-if (char-lower-case? #\Z) #f eq?)
(pass-if (char-lower-case? #\!) #f eq?)

(begin-sub-section "char-upcase")
(pass-if (char-upcase #\a) #\A char=?)
(pass-if (char-upcase #\A) #\A char=?)
(pass-if (char-upcase #\_) #\_ char=?)

(begin-sub-section "char-downcase")
(pass-if (char-downcase #\A) #\a char=?)
(pass-if (char-downcase #\a) #\a char=?)
(pass-if (char-downcase #\_) #\_ char=?)

(begin-section "vector functions")

(begin-sub-section "vector?")
(pass-if (vector? '#()) #t eq?)
(pass-if (vector? '#(1 2 3)) #t eq?)

(begin-sub-section "make-vector")
(pass-if (make-vector 0) '#() equal?)
(pass-if (vector-length (make-vector 10)) 10 =)
(pass-if (make-vector 2 3) '#(3 3) equal?)

(begin-sub-section "vector")
(pass-if (vector 1 2 3) '#(1 2 3) equal?)

(begin-sub-section "vector-length")
(pass-if (vector-length '#()) 0 =)
(pass-if (vector-length '#(foo bar frob knob)) 4 =)

(begin-sub-section "vector-ref")
(pass-if (vector-ref '#(1 '() 'foo) 0) 1 =)
(pass-if (vector-ref '#(1 () foo) 1) '() eq?)
(pass-if (vector-ref '#(1 () foo) 2) 'foo eq?)

(begin-sub-section "vector-set!")
(define a-test-vector (make-vector 4 'foo))
(vector-set! a-test-vector 0 #\a)
(pass-if a-test-vector '#(#\a foo foo foo) equal?)
(vector-set! a-test-vector 3 #\a)
(pass-if a-test-vector '#(#\a foo foo #\a) equal?)

(begin-sub-section "vector->list")
(pass-if (vector->list '#()) '() equal?)
(pass-if (vector->list '#(1 2 3)) '(1 2 3) equal?)

(begin-sub-section "list->vector")
(pass-if (list->vector '()) '#() equal?)
(pass-if (list->vector '(#\p #\u #\p #\p #\y)) '#(#\p #\u #\p #\p #\y) equal?)

(begin-sub-section "vector-fill!")
(define vector-fill-s (make-vector 4 'foo))
(define vector-fill-a (make-vector 0))
(vector-fill! vector-fill-s 'bar)
(pass-if vector-fill-s '#(bar bar bar bar) equal?)
(vector-fill! vector-fill-s 1)
(pass-if vector-fill-s '#(1 1 1 1) equal?)
(vector-fill! vector-fill-a #\!)
(pass-if vector-fill-a '#() equal?)

(begin-section "numerical operations")

(begin-sub-section "number?")
(pass-if (number? -45.67) #t eq?)
(pass-if (number? '3) #t eq?)
(pass-if (number? num) #t eq?)
(pass-if (number? twelve) #f eq?)
(pass-if (number? 'twelve) #f eq?)
(pass-if (number? (+ 2 3)) #t eq?)
(pass-if (number? #t) #f eq?)
(pass-if (number? (car '(15.3 -31.7))) #t eq?)
(pass-if (number? (cdr '(15.3 -31.7))) #f eq?)

(begin-sub-section "complex?")
(pass-if (complex? -45.67) #t eq?)
(pass-if (complex? '3) #t eq?)
(pass-if (complex? num) #t eq?)
(pass-if (complex? twelve) #f eq?)
(pass-if (complex? 'twelve) #f eq?)
(pass-if (complex? (+ 2 3)) #t eq?)
(pass-if (complex? #t) #f eq?)
(pass-if (complex? (car '(15.3 -31.7))) #t eq?)
(pass-if (complex? (cdr '(15.3 -31.7))) #f eq?)

(begin-sub-section "real?")
(pass-if (real? -45.67) #t eq?)
(pass-if (real? '3) #t eq?)
(pass-if (real? num) #t eq?)
(pass-if (real? twelve) #f eq?)
(pass-if (real? 'twelve) #f eq?)
(pass-if (real? (+ 2 3)) #t eq?)
(pass-if (real? #t) #f eq?)
(pass-if (real? (car '(15.3 -31.7))) #t eq?)
(pass-if (real? (cdr '(15.3 -31.7))) #f eq?)

(begin-sub-section "rational?")
;;(pass-if (rational? -45.67) #f eq?)	;this should evaluate to #t...
(pass-if (rational? '3) #t eq?)
;;(pass-if (rational? num) #f eq?)	;this should evaluate to #t...
(pass-if (rational? twelve) #f eq?)
(pass-if (rational? 'twelve) #f eq?)
(pass-if (rational? (+ 2 3)) #t eq?)
(pass-if (rational? #t) #f eq?)
(pass-if (rational? (car '(15 -31))) #t eq?)
(pass-if (rational? (cdr '(15 -31))) #f eq?)

(begin-sub-section "integer?")
(pass-if (integer? -45.67) #f eq?)
(pass-if (integer? '3) #t eq?)
(pass-if (integer? num) #f eq?)
(pass-if (integer? twelve) #f eq?)
(pass-if (integer? 'twelve) #f eq?)
(pass-if (integer? (+ 2 3)) #t eq?)
(pass-if (integer? #t) #f eq?)
(pass-if (integer? (car '(15 -31))) #t eq?)
(pass-if (integer? (cdr '(15 -31))) #f eq?)

(begin-sub-section "exact?")
(pass-if (exact? -45.67) #f eq?)
(pass-if (exact? '3) #t eq?)
(pass-if (exact? num) #f eq?)
(pass-if (exact? twelve) #f eq?)
(pass-if (exact? 'twelve) #f eq?)
(pass-if (exact? (+ 2 3)) #t eq?)
(pass-if (exact? #t) #f eq?)
(pass-if (exact? (car '(15.3 -31.7))) #f eq?)
(pass-if (exact? (cdr '(15.3 -31.7))) #f eq?)

(begin-sub-section "inexact?")
(pass-if (inexact? -45.67) #t eq?)
(pass-if (inexact? '3) #f eq?)
(pass-if (inexact? num) #t eq?)
(pass-if (inexact? twelve) #f eq?)
(pass-if (inexact? 'twelve) #f eq?)
(pass-if (inexact? (+ 2 3)) #f eq?)
(pass-if (inexact? #t) #f eq?)
(pass-if (inexact? (car '(15.3 -31.7))) #t eq?)
(pass-if (inexact? (cdr '(15.3 -31.7))) #f eq?)

(begin-sub-section "zero?")
(pass-if (zero? 0) #t eq?)
(pass-if (zero? 42) #f eq?)
(pass-if (zero? -23) #f eq?)
(pass-if (zero? 0.0) #t eq?)
(pass-if (zero? 42.1) #f eq?)
(pass-if (zero? -23.1) #f eq?)

(begin-sub-section "positive?")
(pass-if (positive? 0) #f eq?)
(pass-if (positive? 42) #t eq?)
(pass-if (positive? -23) #f eq?)
(pass-if (positive? 0.0) #f eq?)
(pass-if (positive? 42.1) #t eq?)
(pass-if (positive? -23.1) #f eq?)

(begin-sub-section "negative?")
(pass-if (negative? 0) #f eq?)
(pass-if (negative? 42) #f eq?)
(pass-if (negative? -23) #t eq?)
(pass-if (negative? 0.0) #f eq?)
(pass-if (negative? 42.1) #f eq?)
(pass-if (negative? -23.1) #t eq?)

(begin-sub-section "even?")
(pass-if (even? 0) #t eq?)
(pass-if (even? 42) #t eq?)
(pass-if (even? -23) #f eq?)

(begin-sub-section "odd?")
(pass-if (odd? 0) #f eq?)
(pass-if (odd? 42) #f eq?)
(pass-if (odd? -23) #t eq?)

(begin-sub-section "+")
(pass-if (+) 0 =)
(pass-if (+ 42) 42 =)
(pass-if (+ 42 23) 65 =)
(pass-if (+ -42 23) -19 =)
(pass-if (+ -42 23 0) -19 =)
(pass-if (+ 42.0) 42.0 =)
(pass-if (+ 42.0 23.0) 65.0 =)
(pass-if (+ -42.0 23.0) -19.0 =)
(pass-if (+ -42.0 23.0 0) -19.0 =)
(pass-if (+ -42.0 23.0 0.0) -19.0 =)
(pass-if (+ 42.1 23) 65.1 =)
(pass-if (+ -42 23.1) -18.9 =)
(pass-if (+ -42.1 23 0) -19.1 =)

(begin-sub-section "-")
(pass-if (- 42) -42 =)
(pass-if (- 42 23) 19 =)
(pass-if (- -42 23) -65 =)
(pass-if (- -42 23 0) -65 =)
(pass-if (- 42.0) -42.0 =)
(pass-if (- 42.0 23.0) 19.0 =)
(pass-if (- -42.0 23.0) -65.0 =)
(pass-if (- -42.0 23.0 0) -65.0 =)
(pass-if (- -42.0 23.0 0.0) -65.0 =)
(pass-if (- -42.1 23) -65.1 =)
(pass-if (- 42 23.1) 18.9 =)
(pass-if (- -42 23.1 0) -65.1 =)

(begin-sub-section "*")
(pass-if (*) 1 =)
(pass-if (* 42) 42 =)
(pass-if (* 42 23) 966 =)
(pass-if (* -42 23) -966 =)
(pass-if (* -42 23 1) -966 =)
(pass-if (* 42.0) 42.0 =)
(pass-if (* 42.0 23.0) 966.0 =)
(pass-if (* -42.0 23.0) -966.0 =)
(pass-if (* -42.0 23.0 1) -966.0 =)
(pass-if (* -42.0 23.0 1.0) -966.0 =)
(pass-if (* 42.0 23) 966.0 =)
(pass-if (* -42 23.0) -966.0 =)
(pass-if (* -42 23 1.0) -966.0 =)

(begin-sub-section "/")
(pass-if (/ 2) 0.5 =)
(pass-if (/ 42 2) 21 =)
(pass-if (/ -42 2) -21 =)
(pass-if (/ -42 2 1) -21 =)
(pass-if (/ 2.0) 0.5 =)
(pass-if (/ 42.0 2.0) 21.0 =)
(pass-if (/ -42.0 2.0) -21.0 =)
(pass-if (/ -42.0 2.0 1) -21.0 =)
(pass-if (/ -42.0 2.0 1.0) -21.0 =)
(pass-if (/ 42.0 2) 21.0 =)
(pass-if (/ -42 2.0) -21.0 =)
(pass-if (/ -42 2 1.0) -21.0 =)

(begin-sub-section "abs")
(pass-if (abs 42) 42 =)
(pass-if (abs -32) 32 =)
(pass-if (abs 42.1) 42.1 =)
(pass-if (abs -32.1) 32.1 =)

(begin-sub-section "quotient")
(pass-if (quotient 10 3) 3 =)
(pass-if (quotient 45 6) 7 =)
(pass-if (quotient 6 2) 3 =)
(pass-if (quotient 3 -2) -1  =)

(begin-sub-section "remainder")
(pass-if (remainder 10 3) 1 =)
(pass-if (remainder 16 4) 0 =)
(pass-if (remainder 5 2) 1 =)
(pass-if (remainder -45 7) -3 =)
(pass-if (remainder 10 -3) 1 =)
(pass-if (remainder -17 -9) -8 =)

(begin-sub-section "modulo")
(pass-if (modulo 10 3) 1 =)
(pass-if (modulo 16 4) 0 =)
(pass-if (modulo 5 2) 1 =)
(pass-if (modulo -45 7) 4 =)
(pass-if (modulo 10 -3) -2 =)
(pass-if (modulo -17 -9) -8 =)
(pass-if (modulo -13 4) 3 =)
(pass-if (modulo 13 -4) -3 =)
(pass-if (modulo -13 -4) -1 =)

(begin-sub-section "division test")
(define (divtest n1 n2)
	(= n1 (+ (* n2 (quotient n1 n2))
		 (remainder n1 n2))))
(pass-if (divtest 238 9) #t eq?)
(pass-if (divtest -238 9) #t eq?)
(pass-if (divtest 238 -9) #t eq?)
(pass-if (divtest -238 -9) #t eq?)

(begin-sub-section "gcd / lcm")
(pass-if (gcd 0 4) 4 =)
(pass-if (gcd -4 0) 4 =)
(pass-if (gcd 32 -36) 4 =)
(pass-if (gcd) 0 =)
(pass-if (lcm 32 -36) 288 =)
(pass-if (lcm) 1 =)

(begin-sub-section "lognot")
(pass-if (lognot 0) -1 =)
(pass-if (lognot -1) 0 =)

(begin-sub-section "logand")
(pass-if (logand) -1 =)
(pass-if (logand 7) 7 =)
(pass-if (logand 7 5) 5 =)

(begin-sub-section "logior")
(pass-if (logior) 0 =)
(pass-if (logior 2) 2 =)
(pass-if (logior 2 4) 6 =)

(begin-sub-section "logxor")
(pass-if (logxor) 0 =)
(pass-if (logxor 1) 1 =)
(pass-if (logxor 1 3) 2 =)
(pass-if (logxor 0 1) 1 =)

(begin-sub-section "ash")
(pass-if (ash 1 0) 1 =)
(pass-if (ash 1 1) 2 =)

(begin-sub-section "=")
(pass-if (= 1 1) #t eq?)
(pass-if (= 1 -1) #f eq?)
(pass-if (= 1 1 1) #t eq?)
(pass-if (= 1 -1 0) #f eq?)
(pass-if (= 1.1 1.1) #t eq?)
(pass-if (= 1.1 -1.1) #f eq?)
(pass-if (= 1.1 1.1 1.1) #t eq?)
(pass-if (= 1.1 -1.1 0.1) #f eq?)

(begin-sub-section "<")
(pass-if (< 1 2) #t eq?)
(pass-if (< 1 1) #f eq?)
(pass-if (< 1 2 3) #t eq?)
(pass-if (< 1 1 1) #f eq?)
(pass-if (< 1.1 2.1) #t eq?)
(pass-if (< 1.1 1.1) #f eq?)
(pass-if (< 1.1 2.1 3.1) #t eq?)
(pass-if (< 1.1 1.1 1.1) #f eq?)

(begin-sub-section "<=")
(pass-if (<= 1 2) #t eq?)
(pass-if (<= 2 2) #t eq?)
(pass-if (<= 2 1) #f eq?)
(pass-if (<= 1 2 3) #t eq?)
(pass-if (<= 2 2 2) #t eq?)
(pass-if (<= 2 1 1) #f eq?)
(pass-if (<= 1.1 2.1) #t eq?)
(pass-if (<= 2.1 2.1) #t eq?)
(pass-if (<= 2.1 1.1) #f eq?)
(pass-if (<= 1.1 2.1 3.1) #t eq?)
(pass-if (<= 2.1 2.1 2.1) #t eq?)
(pass-if (<= 2.1 1.1 1.1) #f eq?)

(begin-sub-section ">")
(pass-if (> 2 1) #t eq?)
(pass-if (> 1 2) #f eq?)
(pass-if (> 2 1 0) #t eq?)
(pass-if (> 1 2 0) #f eq?)
(pass-if (> 2.1 1.1) #t eq?)
(pass-if (> 1.1 2.1) #f eq?)
(pass-if (> 2.1 1.1 0.1) #t eq?)
(pass-if (> 1.1 2.1 2.1) #f eq?)

(begin-sub-section ">=")
(pass-if (>= 2 1) #t eq?)
(pass-if (>= 2 2) #t eq?)
(pass-if (>= 1 2) #f eq?)
(pass-if (>= 2 1 0) #t eq?)
(pass-if (>= 2 2 2) #t eq?)
(pass-if (>= 1 2 0) #f eq?)
(pass-if (>= 2.1 1.1) #t eq?)
(pass-if (>= 2.1 2.1) #t eq?)
(pass-if (>= 1.1 2.1) #f eq?)
(pass-if (>= 2 1 0) #t eq?)
(pass-if (>= 2 2 2) #t eq?)
(pass-if (>= 1 2 2) #f eq?)
(pass-if (>= 2.1 1.1 0.1) #t eq?)
(pass-if (>= 2.1 2.1 2.1) #t eq?)
(pass-if (>= 1.1 2.1 2.1) #f eq?)

(begin-sub-section "max")
(pass-if (max 1) 1 =)
(pass-if (max 1 -1) 1 =)
(pass-if (max 2 1 3) 3 =)
(pass-if (max 1.1) 1.1 =)
(pass-if (max 1.1 -1.1) 1.1 =)
(pass-if (max 2.1 1.1 3.1) 3.1 =)
(pass-if (max 1 -1.1) 1 =)
(pass-if (max 2.1 1.1 3) 3 =)
(pass-if (max 1.1 -1) 1.1 =)
(pass-if (max 2 1 3.1) 3.1 =)

(begin-sub-section "min")
(pass-if (min 1) 1 =)
(pass-if (min 1 -1) -1 =)
(pass-if (min 2 1 3) 1 =)
(pass-if (min 1.1) 1.1 =)
(pass-if (min 1.1 -1.1) -1.1 =)
(pass-if (min 2.1 1.1 3.1) 1.1 =)
(pass-if (min 1 -1.1) -1.1 =)
(pass-if (min 2.1 1 3.1) 1 =)
(pass-if (min 1.1 -1) -1 =)
(pass-if (min 2 1.1 3) 1.1 =)

(begin-sub-section "exp")
(pass-if (exp 0) 1 =)

(begin-sub-section "log")
(pass-if (log 1) 0 =)

(begin-sub-section "sin")
(pass-if (sin 0) 0 =)

(begin-sub-section "cos")
(pass-if (cos 0) 1 =)

(begin-sub-section "tan")
(pass-if (tan 0) 0 =)

(begin-sub-section "asin")
(pass-if (asin 0) 0 =)

(begin-sub-section "acos")
(pass-if (acos 1) 0 =)

(begin-sub-section "atan")
(pass-if (atan 0) 0 =)

(begin-sub-section "sqrt")
(pass-if (sqrt 4) 2 =)

(begin-sub-section "expt")
(pass-if (expt 2 2) 4 =)

(begin-sub-section "floor")
(pass-if (floor 0) 0 =)
(pass-if (floor 1) 1 =)
(pass-if (floor -1) -1 =)
(pass-if (floor 0.0) 0 =)
(pass-if (floor 1.2) 1 =)
(pass-if (floor -1.2) -2 =)
(pass-if (floor 1.8) 1 =)
(pass-if (floor -1.8) -2 =)

(begin-sub-section "ceiling")
(pass-if (ceiling 0) 0 =)
(pass-if (ceiling 1) 1 =)
(pass-if (ceiling -1) -1 =)
(pass-if (ceiling 0.0) 0 =)
(pass-if (ceiling 1.2) 2 =)
(pass-if (ceiling -1.2) -1 =)
(pass-if (ceiling 1.8) 2 =)
(pass-if (ceiling -1.8) -1 =)

; FIXME: Seems truncate is not correctly implemented.
; Consider: (truncate 1.8) => 2, but should => 1, IIRC
(begin-sub-section "truncate")
(pass-if (truncate 0) 0 =)
(pass-if (truncate 1) 1 =)
(pass-if (truncate -1) -1 =)
(pass-if (truncate 0.0) 0 =)
(pass-if (truncate 1.2) 1 =)
(pass-if (truncate -1.2) -1 =)

(begin-sub-section "round")
(pass-if (round 0) 0 =)
(pass-if (round 1) 1 =)
(pass-if (round -1) -1 =)
(pass-if (round 0.0) 0 =)
(pass-if (round 1.2) 1 =)
(pass-if (round -1.2) -1 =)
(pass-if (round 1.8) 2 =)
(pass-if (round -1.8) -2 =)

(begin-sub-section "exact->inexact")
(pass-if (exact->inexact 0) 0.0 =)
(pass-if (exact->inexact 0.0) 0.0 =)
(pass-if (exact->inexact 2) 2.0 =)
(pass-if (exact->inexact 2.1) 2.1 =)
(pass-if (exact->inexact -2) -2.0 =)
(pass-if (exact->inexact -2.1) -2.1 =)

(begin-sub-section "inexact->exact")
(pass-if (inexact->exact 0) 0 =)
(pass-if (inexact->exact 0.0) 0 =)
(pass-if (inexact->exact 2) 2 =)
(pass-if (inexact->exact 2.0) 2 =)
(pass-if (inexact->exact -2) -2 =)
(pass-if (inexact->exact -2.0) -2 =)

(begin-sub-section "string->number")
(pass-if (string->number "0") 0 =)
(pass-if (string->number "#e0") 0 =)
(pass-if (string->number "#i0") 0 =)
(pass-if (string->number "#i0") 0.0 =)
(pass-if (string->number "#i0.0") 0.0 =)
(pass-if (string->number "1") 1 =)
(pass-if (string->number "#e1") 1 =)
(pass-if (string->number "#i1") 1 =)
(pass-if (string->number "#i1") 1.0 =)
(pass-if (string->number "#i1.0") 1.0 =)
(pass-if (string->number "-1") -1 =)
(pass-if (string->number "#e-1") -1 =)
(pass-if (string->number "#i-1") -1 =)
(pass-if (string->number "#i-1.0") -1 =)
(pass-if (string->number "#i-1.0") -1.0 =)

(pass-if (string->number "0" 10) 0 =)
(pass-if (string->number "#e0" 10) 0 =)
(pass-if (string->number "#i0" 10) 0 =)
(pass-if (string->number "#i0" 10) 0.0 =)
(pass-if (string->number "#i0.0" 10) 0.0 =)
(pass-if (string->number "1" 10) 1 =)
(pass-if (string->number "-1" 10) -1 =)

(pass-if (string->number "0" 16) 0 =)
(pass-if (string->number "#e0" 16) 0 =)
(pass-if (string->number "#i0" 16) 0 =)
(pass-if (string->number "#i0" 16) 0.0 =)
(pass-if (string->number "1" 16) 1 =)
(pass-if (string->number "#e1" 16) 1 =)
(pass-if (string->number "#i1" 16) 1 =)
(pass-if (string->number "#i1" 16) 1.0 =)
(pass-if (string->number "a" 16) 10 =)
(pass-if (string->number "#ea" 16) 10 =)
(pass-if (string->number "#ia" 16) 10 =)
(pass-if (string->number "#ia" 16) 10.0 =)

(pass-if (string->number "#x0") 0 =)
(pass-if (string->number "#x#e0") 0 =)
(pass-if (string->number "#x#i0") 0 =)
(pass-if (string->number "#x#i0") 0.0 =)
(pass-if (string->number "#x1") 1 =)
(pass-if (string->number "#x#e1") 1 =)
(pass-if (string->number "#x#i1") 1 =)
(pass-if (string->number "#x#i1") 1.0 =)
(pass-if (string->number "#xa") 10 =)
(pass-if (string->number "#x#ea") 10 =)
(pass-if (string->number "#x#ia") 10 =)
(pass-if (string->number "#x#ia") 10.0 =)

(pass-if (string->number "0" 8) 0 =)
(pass-if (string->number "#e0" 8) 0 =)
(pass-if (string->number "#i0" 8) 0 =)
(pass-if (string->number "#i0" 8) 0.0 =)
(pass-if (string->number "1" 8) 1 =)
(pass-if (string->number "#e1" 8) 1 =)
(pass-if (string->number "#i1" 8) 1 =)
(pass-if (string->number "#i1" 8) 1.0 =)
(pass-if (string->number "10" 8) 8 =)
(pass-if (string->number "#e10" 8) 8 =)
(pass-if (string->number "#i10" 8) 8 =)
(pass-if (string->number "#i10" 8) 8.0 =)

(pass-if (string->number "#o0") 0 =)
(pass-if (string->number "#o#e0") 0 =)
(pass-if (string->number "#o#i0") 0 =)
(pass-if (string->number "#o#i0") 0.0 =)
(pass-if (string->number "#o1") 1 =)
(pass-if (string->number "#o#e1") 1 =)
(pass-if (string->number "#o#i1") 1 =)
(pass-if (string->number "#o#i1") 1.0 =)
(pass-if (string->number "#o10") 8 =)
(pass-if (string->number "#o#e10") 8 =)
(pass-if (string->number "#o#i10") 8 =)
(pass-if (string->number "#o#i10") 8.0 =)

(pass-if (string->number "0" 2) 0 =)
(pass-if (string->number "#e0" 2) 0 =)
(pass-if (string->number "#i0" 2) 0 =)
(pass-if (string->number "#i0" 2) 0.0 =)
(pass-if (string->number "1" 2) 1 =)
(pass-if (string->number "#e1" 2) 1 =)
(pass-if (string->number "#i1" 2) 1 =)
(pass-if (string->number "#i1" 2) 1.0 =)
(pass-if (string->number "10" 2) 2 =)
(pass-if (string->number "#e10" 2) 2 =)
(pass-if (string->number "#i10" 2) 2 =)
(pass-if (string->number "#i10" 2) 2.0 =)

(pass-if (string->number "#b0") 0 =)
(pass-if (string->number "#b#e0") 0 =)
(pass-if (string->number "#b#i0") 0 =)
(pass-if (string->number "#b#i0") 0.0 =)
(pass-if (string->number "#b1") 1 =)
(pass-if (string->number "#b#e1") 1 =)
(pass-if (string->number "#b#i1") 1 =)
(pass-if (string->number "#b#i1") 1.0 =)
(pass-if (string->number "#b10") 2 =)
(pass-if (string->number "#b#e10") 2 =)
(pass-if (string->number "#b#i10") 2 =)
(pass-if (string->number "#b#i10") 2.0 =)

(begin-sub-section "number->string")
(pass-if (number->string 10) "10" equal?)
(pass-if (number->string -10) "-10" equal?)
(pass-if (number->string 10 2) "1010" equal?)
(pass-if (number->string 10 8) "12" equal?)
(pass-if (number->string 10 16) "a" equal?)

(begin-section "list functions")

(begin-sub-section "null?")
(pass-if (null? '()) #t eq?)
(pass-if (null? (cdr '(cat))) #t eq?)
(pass-if(null? (car '((a b)))) #f eq?)

(begin-sub-section "pair?")
(pass-if (pair? '(Ann Ben Carl)) #t eq?)
(pass-if (pair? '(1)) #t eq?)
(pass-if (pair? '()) #f eq?)
(pass-if (pair? '(())) #t eq?)
(pass-if (pair? '(a (b c) d)) #t eq?)
(pass-if (pair? (cons 'a '())) #t eq?)
(pass-if (pair? (cons 3 4)) #t eq?)
(pass-if (pair? 'pair) #f eq?)

(begin-sub-section "list?")
(pass-if (list? '(1 2 3)) #t eq?)

(begin-sub-section "cons")
(pass-if (cons 1 2) '(1 . 2) equal?)

(begin-sub-section "list")
(pass-if (list 1 2 3) '(1 2 3) equal?)

(begin-sub-section "car")
(pass-if (car '(1 2)) 1 =)
(pass-if (car '(1 . 2)) 1 =)

(begin-sub-section "cdr")
(pass-if (cdr '(1 2)) '(2) equal?)
(pass-if (cdr '(1 . 2)) 2 equal?)

(begin-sub-section "caar")
(pass-if (caar '((1 2) (1 2))) 1 =)

(begin-sub-section "cadr")
(pass-if (cadr '((1 2) (1 2))) '(1 2) equal?)

(begin-sub-section "cdar")
(pass-if (cadr '((1 2) (1 2))) '(1 2) equal?)

(begin-sub-section "cddr")
(pass-if (cddr '((1 2) (1 2))) '() equal?)

(begin-sub-section "caaar")
(pass-if (caaar '(((1 2)) ((a b)))) 1 =)

(begin-sub-section "caadr")
(pass-if (caadr '(((1 2)) ((a b)))) '(a b) equal?)

(begin-sub-section "cadar")
(pass-if (cadar '(((1 2) 1) ((a b)))) 1 =)

(begin-sub-section "caddr")
(pass-if (caddr '(((1 2) 1) ((a b)) (c d))) '(c d) equal?)

(begin-sub-section "cdaar")
(pass-if (cdaar '(((1 2) 1) ((a b)) (c d))) '(2) equal?)

(begin-sub-section "cdadr")
(pass-if (cdadr '(((1 2) 1) ((a b) 1) (c d))) '(1) equal?)

(begin-sub-section "cddar")
(pass-if (cddar '(((1 2) 1 a) ((a b) 1) (c d))) '(a) equal?)

(begin-sub-section "cdddr")
(pass-if (cdddr '(((1 2) 1 a) ((a b) 1) (c d) a)) '(a) equal?)

(begin-sub-section "caaaar")
(pass-if (caaaar '((((1) 2)) ((a b)))) 1 =)

(begin-sub-section "caaadr")
(pass-if (caaadr '((((1) 2)) ((a b)))) 'a eq?)

(begin-sub-section "caadar")
(pass-if (caadar '((1 (a b)))) 'a eq?)

(begin-sub-section "caaddr")
(pass-if (caaddr '(1 2 (a b))) 'a eq?)

(begin-sub-section "cadaar")
(pass-if (cadaar '(((a b)) 2)) 'b eq?)

(begin-sub-section "cadadr")
(pass-if (cadadr '(1 ((a b) 2))) 2 =)

(begin-sub-section "caddar")
(pass-if (caddar '((1 2 3))) 3 =)

(begin-sub-section "cadddr")
(pass-if (cadddr '(1 2 3 4)) 4 =)

(begin-sub-section "cdaaar")
(pass-if (cdaaar '((((1 2))))) '(2) equal?)

(begin-sub-section "cdaadr")
(pass-if (cdaadr '(1 ((1 2)))) '(2) equal?)

(begin-sub-section "cdadar")
(pass-if (cdadar '((1 (1 2)))) '(2) equal?)

(begin-sub-section "cdaddr")
(pass-if (cdaddr '(1 2 (1 2))) '(2) equal?)

(begin-sub-section "cddaar")
(pass-if (cddaar '(((1 2 3) 2))) '(3) equal?)

(begin-sub-section "cddadr")
(pass-if (cddadr '(1 (1 2 3))) '(3) equal?)

(begin-sub-section "cdddar")
(pass-if (cdddar '((1 2 3 4))) '(4) equal?)

(begin-sub-section "cddddr")
(pass-if (cddddr '(1 2 3 4 5)) '(5) equal?)

(begin-sub-section "set-car!")
(define set-car!-cons (cons 'a 'b))
(set-car! set-car!-cons 'c)
(pass-if (car set-car!-cons) 'c eq?)

(begin-sub-section "set-cdr!")
(define set-cdr!-cons (cons 'a 'b))
(set-cdr! set-cdr!-cons 'c)
(pass-if (cdr set-cdr!-cons) 'c eq?)

(begin-sub-section "append")
(pass-if (append '()) '() equal?)
(pass-if (append '() '()) '() equal?)
(pass-if (append '(1 2)) '(1 2) equal?)
(pass-if (append '(1 2) '(b c)) '(1 2 b c) equal?)

(begin-sub-section "reverse")
(pass-if (reverse '()) '() eq?)
(pass-if (reverse '(1 2 3)) '(3 2 1) equal?)

(begin-sub-section "last-pair")
(pass-if (last-pair '(1)) '(1) equal?)
(pass-if (last-pair '(1 2 3)) '(3) equal?)

(begin-sub-section "length")
(pass-if (length '()) 0 =)
(pass-if (length '(1)) 1 =)
(pass-if (length '(1 2)) 2 =)

(begin-sub-section "map")
(pass-if (map + '() '()) '() equal?)
(pass-if (map + '(1 2 3) '(1 2 3)) '(2 4 6) equal?)

(begin-sub-section "list-tail")
(pass-if (list-tail '(1 2 3) 2) '(3) equal?)

(begin-sub-section "list-ref")
(pass-if (list-ref '(1 2 3 4) 0) 1 =)
(pass-if (list-ref '(1 2 3 4) 2) 3 =)

(begin-sub-section "memq")
(pass-if (memq '! '(_ a b)) #f eq?)
(pass-if (memq 'a '(_ a b)) '(a b) equal?)

(begin-sub-section "memv")
(pass-if (memv '! '(_ 1.1 b)) #f eq?)
(pass-if (memv 1.1 '(_ 1.1 b)) '(1.1 b) equal?)

(begin-sub-section "member")
(pass-if (member '(!) '(_ (1.1) b)) #f eq?)
(pass-if (member '(1.1) '(_ (1.1) b)) '((1.1) b) equal?)
(pass-if (member '#(!) '(_ #(1.1) b)) #f eq?)
(pass-if (member '#(1.1) '(_ #(1.1) b)) '(#(1.1) b) equal?)

(begin-sub-section "assq")
(pass-if (assq 'd '((a . 1) (b . 2) (c . 3))) #f eq?)
(pass-if (assq 'b '((a . 1) (b . 2) (c . 3))) '(b . 2) equal?)

(begin-sub-section "assv")
(pass-if (assv '2.1 '((a . 1) (1.1 . 2) (c . 3))) #f eq?)
(pass-if (assv '1.1 '((a . 1) (1.1 . 2) (c . 3))) '(1.1 . 2) equal?)

(begin-sub-section "assoc")
(pass-if (assoc '(d) '(((a) . 1) ((b) . 2) ((c) . 3))) #f eq?)
(pass-if (assoc '(b) '(((a) . 1) ((b) . 2) ((c) . 3))) '((b) . 2) equal?)

(begin-section "evaluation functions")

(begin-sub-section "eval")
(pass-if (eval '()) '() eq?)
(pass-if (eval '(+ 1 2 3)) 6 =)

;(begin-sub-section "primitive-load")
;(pass-if )

(begin-section "control operations")

(begin-sub-section "procedure?")
(pass-if (procedure? +) #t eq?)
(pass-if (procedure? (lambda x x)) #t eq?)

(begin-sub-section "apply")
(pass-if (apply + '()) 0 =)
(pass-if (apply + '(1 2)) 3 =)
(pass-if (apply + '(1 2 3)) 6 =)

(begin-sub-section "for-each")
(define for-each-list '(1 2 3))
(define for-each-result '())
(for-each (lambda (c) (set! for-each-result (cons c for-each-result)))
	  for-each-list)
(pass-if for-each-result '(3 2 1) equal?)

(begin-sub-section "force")
(pass-if (force (delay (+ 1 2))) 3 =)

(begin-sub-section "call-with-values / values")
(pass-if (call-with-values
	     (lambda () 1)
	   (lambda x x))
	 '(1) equal?)
(pass-if (call-with-values
	     (lambda () 1)
	   (lambda (x) x))
	 1 =)
(pass-if (call-with-values
	     (lambda () (values 1))
	   (lambda x x))
	 '(1) equal?)
(pass-if (call-with-values
	     (lambda () (values 1 2))
	   (lambda x x))
	 '(1 2) equal?)

(begin-sub-section "throw / catch")
(pass-if (catch 'strange-exception 
		(lambda ()
		  (throw 'strange-exception "bla"))
		(lambda x x))
	 '(strange-exception "bla") equal?)
(pass-if (catch 'strange-exception 
		(lambda ()
		  (throw 'strange-exception "bla"))
		(lambda (tag . rest) rest))
	 '("bla") equal?)
(pass-if (catch 'strange-exception 
		(lambda ()
		  (throw 'strange-exception "bla"))
		(lambda (tag string) string))
	 "bla" equal?)
(pass-if (catch #t
		(lambda ()
		  (throw 'another-strange-exception "bla"))
		(lambda x x))
	 '(another-strange-exception "bla") equal?)

(begin-sub-section "dynamic-wind")
(define dynamic-wind-var 1)
(define dynamic-wind-var-backup 0)
(pass-if (dynamic-wind
	     (lambda () 
	       (set! dynamic-wind-var-backup dynamic-wind-var)
	       (set! dynamic-wind-var 0))
	     (lambda () (let ((x dynamic-wind-var))
			  (set! dynamic-wind-var 2)
			  x))
	     (lambda () (set! dynamic-wind-var 4)))
	 0 =)
(pass-if dynamic-wind-var 4 =)
(pass-if dynamic-wind-var-backup 1 =)
	     
(begin-section "input/output")

(begin-sub-section "display")
(pass-if (with-output-to-string
	   (lambda ()
	     (display 10))) "10" equal?)
(pass-if (with-output-to-string
	   (lambda ()
	     (display "10"))) "10" equal?)
(pass-if (with-output-to-string
	   (lambda ()
	     (display #t))) "#t" equal?)

(begin-sub-section "write")
(pass-if (with-output-to-string
	   (lambda ()
	     (write 10))) "10" equal?)
(pass-if (with-output-to-string
	   (lambda ()
	     (write "10"))) "\"10\"" equal?)
(pass-if (with-output-to-string
	   (lambda ()
	     (write #t))) "#t" equal?)

(begin-sub-section "read")
(pass-if (with-input-from-string
	     "Hallo"
	   (lambda ()
	     (read))) 'Hallo eq?)
(pass-if (with-input-from-string
	     "10"
	   (lambda ()
	     (read))) 10 =)
(pass-if (with-input-from-string
	     "\"Hallo\""
	   (lambda ()
	     (read))) "Hallo" equal?)

(begin-sub-section "read-char")
(pass-if (with-input-from-string
	     "Hallo"
	   (lambda ()
	     (read-char))) #\H equal?)
(pass-if (with-input-from-string
	     "Hallo"
	   (lambda ()
	     (read-char)
	     (read-char))) #\a equal?)

(begin-sub-section "peek-char")
(pass-if (with-input-from-string
	     "Hallo"
	   (lambda ()
	     (peek-char))) #\H equal?)
(pass-if (with-input-from-string
	     "Hallo"
	   (lambda ()
	     (read-char)
	     (peek-char))) #\a equal?)

(begin-sub-section "display / read-char")
(define f (open-output-file "sizzle-tmp.tmp"))
(let write-loop ((n 10000))
  (if (> n 0)
      (begin
	(display #\! f) (write-loop (- n 1)))))
(close-output-port f)
(define f (open-input-file "sizzle-tmp.tmp"))
(pass-if (catch 'invalid-character
		(lambda () 
		  (let read-loop ((n 0))
		    (if (< n 10000)
			(let ((ch (read-char f)))
			  (if (char=? ch #\!)
			      (read-loop (+ n 1))
			      (throw 'invalid-character 0)))
			n)))
		(lambda dummy
		  0))
	 10000 =)
(close-input-port f)

(begin-sub-section "seek")
(pass-if (with-input-from-string
	     "hello"
	   (lambda ()
	     (read-char)
	     (seek (current-input-port) 0 SEEK_SET)))
	 0 =)
(pass-if (with-input-from-string
	     "hello"
	   (lambda ()
	     (read-char)
	     (seek (current-input-port) 0 SEEK_CUR)))
	 1 =)
(pass-if (with-input-from-string
	     "hello"
	   (lambda ()
	     (read-char)
	     (seek (current-input-port) 0 SEEK_END)))
	 5 =)
(pass-if (with-input-from-string
	     "hello"
	   (lambda ()
	     (read-char)
	     (seek (current-input-port) -1 SEEK_END)))
	 4 =)

(begin-sub-section "ftell")
(pass-if (with-input-from-string
	     "hello"
	   (lambda ()
	     (ftell (current-input-port))))
	 0 =)
(pass-if (with-input-from-string
	     "hello"
	   (lambda ()
	     (read-char)
	     (ftell (current-input-port))))
	 1 =)
(pass-if (with-input-from-string
	     "hello"
	   (lambda ()
	     (read-char)
	     (read-char)
	     (read-char)
	     (ftell (current-input-port))))
	 3 =)
(pass-if (with-input-from-string
	     "hello"
	   (lambda ()
	     (read-char)
	     (read-char)
	     (read-char)
	     (read-char)
	     (read-char)
	     (ftell (current-input-port))))
	 5 =)
(pass-if (with-input-from-string
	     "hello"
	   (lambda ()
	     (read-char)
	     (read-char)
	     (read-char)
	     (read-char)
	     (read-char)
	     (read-char)
	     (ftell (current-input-port))))
	 5 =)

(begin-sub-section "open-output-file")
(define o-p (open-output-file "sizzle-test-tmp.tmp"))
(pass-if (output-port? o-p) #t eq?)
(write "Hello World!" o-p)
;(newline o-p)
(write 'barfoo o-p)
(close-output-port o-p)

(begin-sub-section "open-input-file")
(define i-p (open-input-file "sizzle-test-tmp.tmp"))
(pass-if (input-port? i-p) #t eq?) 
(let ((res (read i-p)))
  (pass-if res "Hello World!" equal?))
(let ((res (peek-char i-p)))
  (pass-if res #\b equal?))
(let ((res (read i-p)))
  (pass-if res 'barfoo eq?))
(close-input-port i-p)

(begin-sub-section "with-output-to-file")
(with-output-to-file "sizzle-test-tmp.tmp"
  (lambda () (write 1) (newline) (write "gar")))
(define i-p (open-input-file "sizzle-test-tmp.tmp"))
(pass-if (read i-p) 1 =)
(pass-if (read i-p) "gar" equal?)
(close-input-port i-p)

(begin-sub-section "with-input-from-file")
(pass-if (with-input-from-file "sizzle-test-tmp.tmp"
	   (lambda ()
	     (let* ((1st (read))
		    (2nd (read)))
	       (list 1st 2nd))))
	 '(1 "gar") equal?)

(begin-sub-section "call-with-output-file")
(call-with-output-file "sizzle-test-tmp.tmp"
  (lambda (port) (write 42 port) (newline port) (write "garr" port)))
(define i-p (open-input-file "sizzle-test-tmp.tmp"))
(pass-if (read i-p) 42 =)
(pass-if (read i-p) "garr" equal?)
(close-input-port i-p)

(begin-sub-section "call-with-input-port")
(pass-if (call-with-input-file "sizzle-test-tmp.tmp"
	   (lambda (port)
	     (let* ((1st (read port))
		    (2nd (read port)))
	       (list 1st 2nd))))
	 '(42 "garr") equal?)


(begin-sub-section "input-port? / current-input-port")
(pass-if (input-port? (current-input-port)) #t eq?)

(begin-sub-section "output-port? / current-output-port")
(pass-if (output-port? (current-output-port)) #t eq?)

(begin-sub-section "output-port? / current-error-port")
(pass-if (output-port? (current-error-port)) #t eq?)

(begin-sub-section "eof-object?")
(pass-if (with-input-from-string
	     ""
	   (lambda ()
	     (eof-object? (read))))
	 #t eq?)

(begin-sub-section "with-input-from-string")
(pass-if (with-input-from-string
	     "bar"
	   (lambda ()
	     (read)))
	 'bar eq?)
(pass-if (with-input-from-string
	     "\"foo\""
	   (lambda ()
	     (read)))
	 "foo" equal?)
(pass-if (with-input-from-string
	     "1"
	   (lambda ()
	     (read)))
	 1 =)

(begin-sub-section "with-output-to-string")
(pass-if (string-length (with-output-to-string
	   (lambda ()
	     1)))
	 0 =)
(pass-if (with-output-to-string
	   (lambda ()
	     (display "hello")))
	 "hello" equal?)


(begin-section "hash functions")

(begin-sub-section "hashq")
(pass-if (hashq 23 127) (hashq 23 127) =)
(pass-if (hashq -42 127) (hashq -42 127) =)
(pass-if (hashq 'foo 127) (hashq 'foo 127) =)

(begin-sub-section "hashv")
(pass-if (hashv 23 127) (hashv 23 127) =)
(pass-if (hashv -42 127) (hashv -42 127) =)
(pass-if (hashv 'foo 127) (hashv 'foo 127) =)

(begin-sub-section "hash")
(pass-if (hash 23 127) (hash 23 127) =)
(pass-if (hash -42 127) (hash -42 127) =)
(pass-if (hash 'foo 127) (hash 'foo 127) =)
(pass-if (hash "frob" 127) (hash "frob" 127) =)

(define hashq-table (make-hash 27))

(begin-sub-section "hashq-create-handle!")
(pass-if (hashq-create-handle! hashq-table 'foo 23) '(foo . 23) equal?)

(begin-sub-section "hashq-set!")
(pass-if (hashq-set! hashq-table 'foo 42) 42 =)

(begin-sub-section "hashq-get-handle")
(pass-if (hashq-get-handle hashq-table 'foo) '(foo . 42)  equal?)

(begin-sub-section "hashq-ref")
(pass-if (hashq-ref hashq-table 'foo) 42  equal?)

(begin-sub-section "hashq-remove!")
(pass-if (hashq-remove! hashq-table 'foo) '(foo . 42) equal?)
(pass-if (hashq-ref hashq-table 'foo 'boom!) 'boom! eq?)

(define hashv-table (make-hash 27))

(begin-sub-section "hashv-create-handle!")
(pass-if (hashv-create-handle! hashv-table 'foo 23) '(foo . 23) equal?)

(begin-sub-section "hashv-set!")
(pass-if (hashv-set! hashv-table 'foo 42) 42 =)

(begin-sub-section "hashv-get-handle")
(pass-if (hashv-get-handle hashv-table 'foo) '(foo . 42)  equal?)

(begin-sub-section "hashv-ref")
(pass-if (hashv-ref hashv-table 'foo) 42  equal?)

(begin-sub-section "hashv-remove!")
(pass-if (hashv-remove! hashv-table 'foo) '(foo . 42) equal?)
(pass-if (hashv-ref hashv-table 'foo 'boom!) 'boom! eq?)

(define hash-table (make-hash 27))

(begin-sub-section "hash-create-handle!")
(pass-if (hash-create-handle! hash-table 'foo 23) '(foo . 23) equal?)

(begin-sub-section "hash-set!")
(pass-if (hash-set! hash-table 'foo 42) 42 =)

(begin-sub-section "hash-get-handle")
(pass-if (hash-get-handle hash-table 'foo) '(foo . 42)  equal?)

(begin-sub-section "hash-ref")
(pass-if (hash-ref hash-table 'foo) 42  equal?)

(begin-sub-section "hash-remove!")
(pass-if (hash-remove! hash-table 'foo) '(foo . 42) equal?)
(pass-if (hash-ref hash-table 'foo 'boom!) 'boom! eq?)

(begin-section "box data type")

(begin-sub-section "box?")
(pass-if (box? #t) #f eq?)
(pass-if (box? 1) #f eq?)
(pass-if (box? #\a) #f eq?)
(pass-if (box? "asas") #f eq?)
(pass-if (box? '()) #f eq?)
(pass-if (box? '(1 2 3)) #f eq?)
(pass-if (box? '#(1 2 3)) #f eq?)
(pass-if (box? (make-box #f)) #t eq?)
(pass-if (box? (make-box (list 1 2 3))) #t eq?)

(begin-sub-section "make-box")
(pass-if (box? (make-box (make-box #t))) #t eq?)
(let ((b (make-box 1)))
  (pass-if (box? b) #t eq?))

(begin-sub-section "box-ref")
(pass-if (box? (box-ref (make-box (make-box #t)))) #t eq?)
(let ((b (make-box 1)))
  (pass-if (box-ref b) 1 eqv?))
(let ((b (make-box #t)))
  (pass-if (box-ref b) #t eq?))
(let ((b (make-box "foo")))
  (pass-if (box-ref b) "foo" equal?))

(begin-sub-section "box-set!")
(define bbox (make-box #f))
(pass-if (box? bbox) #t eq?)
(pass-if (box-ref bbox) #f eq?)
(box-set! bbox 1)
(pass-if (box-ref bbox) 1 eqv?)
(box-set! bbox "bar")
(pass-if (box-ref bbox) "bar" equal?)
(box-set! bbox #t)
(pass-if (boolean? (box-ref bbox)) #t eq?)

(test-summary)
