haskeem-0.7.9: selftest.scm
; Copyright 2008 Uwe Hollerbach <uh@alumni.caltech.edu>
; This file is part of haskeem.
; haskeem 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.
; haskeem 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 haskeem; if not, write to the Free Software
; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
; $Id: selftest.scm,v 1.46 2009-07-19 02:36:21 uwe Exp $
(define start (epochtime))
(define verbose? #f)
(when (and (positive? (length args)) (string=? (car args) "-v"))
(set! verbose? #t)
(set! args (cdr args)))
(write-string "Some simple self-tests for haskeem\n\n")
; First define the functions to run the tests, plus counters
(define n-tests 0)
(define n-fails 0)
(define n-excepts 0)
; These (chk-*) functions could all be rewritten as macros, which would
; make them cleaner in some respects... but they were written long before
; macros appeared in haskeem. C'est la vie.
(define (chk-closeto cmp expect expr)
(set! n-tests (+ n-tests 1))
(let* ((got (eval expr))
(show-details (lambda ()
(write-string "test "
(number->string n-tests)
": evaluating ")
(display expr)
(write-string "\nexpecting ")
(display expect)
(write-string "\ngot ")
(display got))))
(when verbose? (show-details))
(if (cmp expect got)
(when verbose? (write-string " ok!\n\n"))
(begin (unless verbose? (show-details))
(write-string " FAILED!\n\n")
(set! n-fails (+ n-fails 1))))))
(define (chk-run expect expr) (chk-closeto eqv? expect expr))
(define (rel-tol x y)
(when verbose?
(write-string "\nrel diff " (number->string (abs (- x y)))))
(< (abs (- x y)) (* (* 0.5 (+ (abs x) (abs y))) 1.25e-15)))
(define (abs-tol x y)
(when verbose?
(write-string "\nabs diff " (number->string (abs (- x y)))))
(< (abs (- x y)) 1.25e-15))
(define (get-user-response)
(let ((ans (list-drop-while char-whitespace? (string->char (read-line)))))
(cond ((= 0 (length ans)) #t)
((char=? #\y (char-downcase (car ans))) #t)
(else #f))))
(define (maybe expect got)
(unless verbose?
(write-string "expecting to see " expect ", got ")
(display got))
(write-string "\nis that reasonable? ")
(flush-port stdout)
(if verbose?
(get-user-response)
(begin (write-string "[assuming yes]\n") #t)))
(define (chk-query expect expr) (chk-closeto maybe expect expr))
(defmacro (catch-exceptions body)
`(guard (err
(else (write-string "caught exception ")
(display err)
(newline)
(set! n-excepts (+ 1 n-excepts))))
,body))
; test the chk-run function itself: this should fail
(write-string "checking chk-run and catch-exceptions... expect failure messages here\n")
(chk-run #f '1)
(if (zero? n-fails)
(begin (write-string "uh-oh! chk-run didn't record failure,"
" better check that!\n\n")
(set! n-fails 1))
(begin (write-string "ok, zeroing out n-fails so this"
" won't be recorded as a failure\n\n")
(set! n-fails 0)))
(catch-exceptions (raise "exception test"))
(if (zero? n-excepts)
(begin (write-string "uh-oh! catch-exceptions didn't record exception,"
" better check that!\n\n")
(set! n-excepts 1))
(begin (write-string "ok, zeroing out n-excepts so this"
" won't be recorded as an exception\n\n")
(set! n-excepts 0)))
; now do real tests
(chk-run 1 '1)
(chk-run 0 '(+))
(chk-run 2 '(+ 2))
(chk-run 1 '(*))
(chk-run 2 '(* 2))
(chk-run 5 '(+ 2 3))
(chk-run 2 '(+ 1 1))
(chk-run 3 '(+ 1 1 1))
(chk-run 4 '(+ 1 1 1 1))
(chk-run 5 '(+ 1 1 1 1 1))
(chk-run #f '(even? 3))
(chk-run 65536 '(* 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2))
(chk-run 11 '(+ 1 (* 2 3) (gcd 8 12)))
(chk-run 11 '(- 5 4 -2 3 -11))
(chk-run 163 '(+ 1 (* 2 (expt 3 4))))
(chk-run 163 '((car (list + * expt))
1 ((cadr (list + * expt))
2 ((caddr (list + * expt))
3 4))))
(chk-run 1267650600228229401496703205376 '(expt 2 100))
(chk-run +nan.0 '(sqrt -1.0))
(chk-run +nan.0 -nan.0)
(chk-run +inf.0 '(expt 1.0e99 1.0e99))
(chk-run -inf.0 '(log 0.0))
(chk-run +nan.0 '(+ +inf.0 -inf.0))
(chk-run +inf.0 '(+ +inf.0 1.0e99))
(chk-run +inf.0 '(- +inf.0 1.0e99))
(chk-run +inf.0 '(* +inf.0 1.0e99))
(chk-run +inf.0 '(/ +inf.0 1.0e99))
(chk-run 4 '(modulo 30 13))
(chk-run 9 '(modulo -30 13))
(chk-run -9 '(modulo 30 -13))
(chk-run -4 '(modulo -30 -13))
(chk-run 4 '(remainder 30 13))
(chk-run -4 '(remainder -30 13))
(chk-run 4 '(remainder 30 -13))
(chk-run -4 '(remainder -30 -13))
(chk-run 5 '(max 1 3 5 2 -17))
(chk-run -17 '(min 1 3 5 2 -17))
(chk-run 5 '(max 5))
(chk-run -17 '(min -17))
(chk-run 1 '(gcd 3 9 7))
(chk-run 1 '(gcd 582162 28906206 3064173 28894803 8519281 28657487
16218068 27093208 17492496 26590452 18289922 26224366))
(chk-run 6 '(lcm 2 3 6))
(chk-run 18 '(lcm 2 6 9))
; check candidate taxicab number Ta(6)
(define (cube x) (* x x x))
(chk-run 24153319581254312065344 '(+ (cube 582162) (cube 28906206)))
(chk-run 24153319581254312065344 '(+ (cube 3064173) (cube 28894803)))
(chk-run 24153319581254312065344 '(+ (cube 8519281) (cube 28657487)))
(chk-run 24153319581254312065344 '(+ (cube 16218068) (cube 27093208)))
(chk-run 24153319581254312065344 '(+ (cube 17492496) (cube 26590452)))
(chk-run 24153319581254312065344 '(+ (cube 18289922) (cube 26224366)))
(define (self-test-fn1 op x y) (op x y))
(chk-run 65 '(self-test-fn1 + 23 42))
(chk-run 966 '(self-test-fn1 * 23 42))
(chk-run #t '(number? 1))
(chk-run #t '(number? 1.0))
(chk-run #t '(number? 1/3))
(chk-run #f '(number? 'a))
(chk-run #f '(number? '()))
(chk-run #t '(integer? 1))
(chk-run #f '(integer? 1.0))
(chk-run #f '(integer? 1/3))
(chk-run #f '(integer? 'a))
(chk-run #f '(integer? '()))
(chk-run #t '(rational? 1))
(chk-run #t '(rational? 1/4))
(chk-run #f '(rational? 1.4))
(chk-run #f '(rational? 'a))
(chk-run #f '(rational? '()))
(chk-run #t '(real? 1))
(chk-run #t '(real? 1/4))
(chk-run #t '(real? 1.4))
(chk-run #f '(real? 'a))
(chk-run #f '(real? '()))
(chk-run #t '(number? +nan.0))
(chk-run #t '(number? 0/0))
(chk-run #t '(real? +nan.0))
(chk-run #f '(rational? +nan.0))
(chk-run #t '(real? 0/0))
(chk-run #t '(rational? 0/0))
(chk-run #t '(number? +inf.0))
(chk-run #t '(number? 1/0))
(chk-run #t '(real? +inf.0))
(chk-run #f '(rational? +inf.0))
(chk-run #t '(real? 1/0))
(chk-run #t '(rational? 1/0))
(chk-run #f '(positive? -inf.0))
(chk-run #f '(positive? -1/0))
(chk-run #f '(positive? -1))
(chk-run #f '(positive? -1.0))
(chk-run #f '(positive? -1/2))
(chk-run #f '(positive? +nan.0))
(chk-run #f '(positive? 0/0))
(chk-run #f '(positive? 0))
(chk-run #f '(positive? 0.0))
(chk-run #f '(positive? 0/2))
(chk-run #f '(positive? 'a))
(chk-run #f '(positive? '(1 2 3)))
(chk-run #t '(positive? +inf.0))
(chk-run #t '(positive? 1/0))
(chk-run #t '(positive? 1))
(chk-run #t '(positive? 1.0))
(chk-run #t '(positive? 1/2))
(chk-run #t '(negative? -inf.0))
(chk-run #t '(negative? -1/0))
(chk-run #t '(negative? -1))
(chk-run #t '(negative? -1.0))
(chk-run #t '(negative? -1/2))
(chk-run #f '(negative? +nan.0))
(chk-run #f '(negative? 0/0))
(chk-run #f '(negative? 0))
(chk-run #f '(negative? 0.0))
(chk-run #f '(negative? 0/2))
(chk-run #f '(negative? 'a))
(chk-run #f '(negative? '(1 2 3)))
(chk-run #f '(negative? +inf.0))
(chk-run #f '(negative? 1/0))
(chk-run #f '(negative? 1))
(chk-run #f '(negative? 1.0))
(chk-run #f '(negative? 1/2))
(chk-run #f '(zero? -inf.0))
(chk-run #f '(zero? -1/0))
(chk-run #f '(zero? -1))
(chk-run #f '(zero? -1.0))
(chk-run #f '(zero? -1/2))
(chk-run #f '(zero? +nan.0))
(chk-run #f '(zero? 0/0))
(chk-run #t '(zero? 0))
(chk-run #t '(zero? 0.0))
(chk-run #t '(zero? 0/2))
(chk-run #f '(zero? 'a))
(chk-run #f '(zero? '(1 2 3)))
(chk-run #f '(zero? +inf.0))
(chk-run #f '(zero? 1/0))
(chk-run #f '(zero? 1))
(chk-run #f '(zero? 1.0))
(chk-run #f '(zero? 1/2))
(chk-run #t '(symbol? '+))
(chk-run #t '(symbol? 'a))
(chk-run #t '(symbol? 'zippyfoo123_?))
(chk-run #f '(symbol? '()))
(chk-run #f '(symbol? 4))
(chk-run #f '(symbol? '(a b c)))
(chk-run #t '(pair? '(a . b)))
(chk-run #t '(pair? '(a b c)))
(chk-run #f '(pair? '()))
(chk-run #f '(pair? 'a))
(chk-run #f '(pair? 4))
(chk-run #f '(pair? #t))
(chk-run #f '(list? '(a . b)))
(chk-run #t '(list? '(a b c)))
(chk-run #t '(list? '()))
(chk-run #f '(list? 'a))
(chk-run #f '(list? 4))
(chk-run #f '(list? #t))
(chk-run #f '(string=? "lesser" "greater"))
(chk-run #f '(string<? "lesser" "greater"))
(chk-run #t '(string>? "lesser" "greater"))
(chk-run #t '(string>=? "lesser" "greater"))
(chk-run #f '(string<=? "lesser" "greater"))
(chk-run #t '(string<? "greater" "lesser"))
(chk-run #f '(string>? "greater" "lesser"))
(chk-run #f '(string>=? "greater" "lesser"))
(chk-run #t '(string<=? "greater" "lesser"))
(chk-run #t '(string=? "lesser" "lesser"))
(chk-run #f '(string<? "lesser" "lesser"))
(chk-run #f '(string>? "lesser" "lesser"))
(chk-run #t '(string>=? "lesser" "lesser"))
(chk-run #t '(string<=? "lesser" "lesser"))
(define p3 (curry + 3))
(define m3 (curry * 3))
(define m3p3 (compose m3 p3))
(chk-run '(a a a a a a a a a a) '(stream-head (cycle '(a)) 10))
(chk-run '(a b c a b c a b c a) '(stream-head (cycle '(a b c)) 10))
(chk-run 3 '(p3))
(chk-run 5 '(p3 2))
(chk-run 10 '(p3 2 5))
(chk-run 9 '(p3 2 5 -1))
(chk-run 9 '(m3p3))
(chk-run 15 '(m3p3 2))
(chk-run 21 '(m3p3 1 3))
; TODO: check a bunch more of these
; ("/", lispDiv),
; ("quotient", integerBinop "quotient" quot),
; ("boolean?", isBool),
; ("string?", isString),
; ("char?", isChar),
; ("port?", isPort),
; ("char=?", charBoolBinop "char=?" (==)),
; ("char<?", charBoolBinop "char<?" (<)),
; ("char>?", charBoolBinop "char>?" (>)),
; ("char>=?", charBoolBinop "char>=?" (>=)),
; ("char<=?", charBoolBinop "char<=?" (<=)),
; ("char-alphabetic?", charIs isAlpha),
; ("char-numeric?", charIs isDigit),
; ("char-oct-digit?", charIs isOctDigit),
; ("char-hex-digit?", charIs isHexDigit),
; ("char-whitespace?", charIs isSpace),
; ("char-upper-case?", charIs isUpper),
; ("char-lower-case?", charIs isLower),
; ("char-alphanumeric?", charIs isAlphaNum),
; ("char-control?", charIs isControl),
; ("char-printable?", charIs isPrint),
; ("eqv?", eqv),
; ("char->integer", char2int),
; ("integer->char", int2char),
(chk-run 69 '(expmod 3 21 77))
(chk-run 43 '(expmod 17 125000 211))
(chk-run #t '(mersenne-prime? 2))
(chk-run #t '(mersenne-prime? 3))
(chk-run #t '(mersenne-prime? 5))
(chk-run #t '(mersenne-prime? 7))
(chk-run #t '(mersenne-prime? 13))
(chk-run #t '(mersenne-prime? 17))
(chk-run #t '(mersenne-prime? 19))
(chk-run #t '(mersenne-prime? 31))
(chk-run #t '(mersenne-prime? 61))
(chk-run #t '(mersenne-prime? 89))
(chk-run #t '(mersenne-prime? 107))
(chk-run #t '(mersenne-prime? 127))
(chk-run #t '(mersenne-prime? 521))
(chk-run #t '(mersenne-prime? 607))
(chk-run #f '(mersenne-prime? 11))
(chk-run #f '(mersenne-prime? 23))
(chk-run #f '(mersenne-prime? 29))
(chk-run #t '(mersenne-prime? 4423))
(chk-closeto rel-tol -0.1411200080598672221 '(sin -3))
(chk-closeto rel-tol -0.9092974268256816954 '(sin -2))
(chk-closeto rel-tol -0.84147098480789650665 '(sin -1))
(chk-closeto abs-tol 0.0 '(sin 0))
(chk-closeto rel-tol 0.84147098480789650665 '(sin 1))
(chk-closeto rel-tol 0.9092974268256816954 '(sin 2))
(chk-closeto rel-tol 0.1411200080598672221 '(sin 3))
(chk-closeto rel-tol -1.11976951499863418669 '(asin -0.9))
(chk-closeto rel-tol -0.92729521800161223243 '(asin -0.8))
(chk-closeto rel-tol -0.77539749661075306374 '(asin -0.7))
(chk-closeto rel-tol -0.6435011087932843868 '(asin -0.6))
(chk-closeto rel-tol -0.52359877559829887308 '(asin -0.5))
(chk-closeto rel-tol -0.41151684606748801939 '(asin -0.4))
(chk-closeto rel-tol -0.30469265401539750797 '(asin -0.3))
(chk-closeto rel-tol -0.20135792079033079145 '(asin -0.2))
(chk-closeto rel-tol -0.10016742116155979635 '(asin -0.1))
(chk-closeto abs-tol 0.0 '(asin 0))
(chk-closeto rel-tol 0.10016742116155979635 '(asin 0.1))
(chk-closeto rel-tol 0.20135792079033079145 '(asin 0.2))
(chk-closeto rel-tol 0.30469265401539750797 '(asin 0.3))
(chk-closeto rel-tol 0.41151684606748801939 '(asin 0.4))
(chk-closeto rel-tol 0.52359877559829887308 '(asin 0.5))
(chk-closeto rel-tol 0.6435011087932843868 '(asin 0.6))
(chk-closeto rel-tol 0.77539749661075306374 '(asin 0.7))
(chk-closeto rel-tol 0.92729521800161223243 '(asin 0.8))
(chk-closeto rel-tol 1.11976951499863418669 '(asin 0.9))
(chk-closeto rel-tol -0.98999249660044545727 '(cos -3))
(chk-closeto rel-tol -0.416146836547142387 '(cos -2))
(chk-closeto rel-tol 0.5403023058681397174 '(cos -1))
(chk-closeto rel-tol 1.0 '(cos 0))
(chk-closeto rel-tol 0.5403023058681397174 '(cos 1))
(chk-closeto rel-tol -0.416146836547142387 '(cos 2))
(chk-closeto rel-tol -0.98999249660044545727 '(cos 3))
(chk-closeto rel-tol 2.69056584179353080592 '(acos -0.9))
(chk-closeto rel-tol 2.49809154479650885166 '(acos -0.8))
(chk-closeto rel-tol 2.34619382340564968297 '(acos -0.7))
(chk-closeto rel-tol 2.21429743558818100603 '(acos -0.6))
(chk-closeto rel-tol 2.09439510239319549231 '(acos -0.5))
(chk-closeto rel-tol 1.98231317286238463862 '(acos -0.4))
(chk-closeto rel-tol 1.8754889808102941272 '(acos -0.3))
(chk-closeto rel-tol 1.77215424758522741069 '(acos -0.2))
(chk-closeto rel-tol 1.67096374795645641558 '(acos -0.1))
(chk-closeto rel-tol 1.57079632679489661923 '(acos 0))
(chk-closeto rel-tol 1.47062890563333682289 '(acos 0.1))
(chk-closeto rel-tol 1.36943840600456582778 '(acos 0.2))
(chk-closeto rel-tol 1.26610367277949911126 '(acos 0.3))
(chk-closeto rel-tol 1.15927948072740859985 '(acos 0.4))
(chk-closeto rel-tol 1.04719755119659774615 '(acos 0.5))
(chk-closeto rel-tol 0.92729521800161223243 '(acos 0.6))
(chk-closeto rel-tol 0.79539883018414355549 '(acos 0.7))
(chk-closeto rel-tol 0.6435011087932843868 '(acos 0.8))
(chk-closeto rel-tol 0.45102681179626243255 '(acos 0.9))
(chk-closeto rel-tol 0.1425465430742778053 '(tan -3))
(chk-closeto rel-tol 2.18503986326151899164 '(tan -2))
(chk-closeto rel-tol -1.55740772465490223051 '(tan -1))
(chk-closeto abs-tol 0.0 '(tan 0))
(chk-closeto rel-tol 1.55740772465490223051 '(tan 1))
(chk-closeto rel-tol -2.18503986326151899164 '(tan 2))
(chk-closeto rel-tol -0.1425465430742778053 '(tan 3))
(chk-closeto rel-tol -0.73281510178650659164 '(atan -0.9))
(chk-closeto rel-tol -0.67474094222355266306 '(atan -0.8))
(chk-closeto rel-tol -0.61072596438920861654 '(atan -0.7))
(chk-closeto rel-tol -0.54041950027058415544 '(atan -0.6))
(chk-closeto rel-tol -0.46364760900080611621 '(atan -0.5))
(chk-closeto rel-tol -0.3805063771123648863 '(atan -0.4))
(chk-closeto rel-tol -0.291456794477867092 '(atan -0.3))
(chk-closeto rel-tol -0.19739555984988075837 '(atan -0.2))
(chk-closeto rel-tol -0.09966865249116202738 '(atan -0.1))
(chk-closeto abs-tol 0.0 '(atan 0))
(chk-closeto rel-tol 0.09966865249116202738 '(atan 0.1))
(chk-closeto rel-tol 0.19739555984988075837 '(atan 0.2))
(chk-closeto rel-tol 0.291456794477867092 '(atan 0.3))
(chk-closeto rel-tol 0.3805063771123648863 '(atan 0.4))
(chk-closeto rel-tol 0.46364760900080611621 '(atan 0.5))
(chk-closeto rel-tol 0.54041950027058415544 '(atan 0.6))
(chk-closeto rel-tol 0.61072596438920861654 '(atan 0.7))
(chk-closeto rel-tol 0.67474094222355266306 '(atan 0.8))
(chk-closeto rel-tol 0.73281510178650659164 '(atan 0.9))
(chk-closeto rel-tol -10.01787492740990189897 '(sinh -3))
(chk-closeto rel-tol -3.62686040784701876767 '(sinh -2))
(chk-closeto rel-tol -1.17520119364380145688 '(sinh -1))
(chk-closeto abs-tol 0.0 '(sinh 0))
(chk-closeto rel-tol 1.17520119364380145688 '(sinh 1))
(chk-closeto rel-tol 3.62686040784701876767 '(sinh 2))
(chk-closeto rel-tol 10.01787492740990189897 '(sinh 3))
(chk-closeto rel-tol -0.80886693565278246251 '(asinh -0.9))
(chk-closeto rel-tol -0.73266825604541086415 '(asinh -0.8))
(chk-closeto rel-tol -0.65266656608235578681 '(asinh -0.7))
(chk-closeto rel-tol -0.5688248987322475301 '(asinh -0.6))
(chk-closeto rel-tol -0.4812118250596034475 '(asinh -0.5))
(chk-closeto rel-tol -0.39003531977071527608 '(asinh -0.4))
(chk-closeto rel-tol -0.2956730475634224391 '(asinh -0.3))
(chk-closeto rel-tol -0.19869011034924140647 '(asinh -0.2))
(chk-closeto rel-tol -0.09983407889920756333 '(asinh -0.1))
(chk-closeto abs-tol 0 '(asinh 0))
(chk-closeto rel-tol 0.09983407889920756333 '(asinh 0.1))
(chk-closeto rel-tol 0.19869011034924140647 '(asinh 0.2))
(chk-closeto rel-tol 0.2956730475634224391 '(asinh 0.3))
(chk-closeto rel-tol 0.39003531977071527608 '(asinh 0.4))
(chk-closeto rel-tol 0.4812118250596034475 '(asinh 0.5))
(chk-closeto rel-tol 0.5688248987322475301 '(asinh 0.6))
(chk-closeto rel-tol 0.65266656608235578681 '(asinh 0.7))
(chk-closeto rel-tol 0.73266825604541086415 '(asinh 0.8))
(chk-closeto rel-tol 0.80886693565278246251 '(asinh 0.9))
(chk-closeto rel-tol 10.06766199577776584195 '(cosh -3))
(chk-closeto rel-tol 3.76219569108363145956 '(cosh -2))
(chk-closeto rel-tol 1.54308063481524377848 '(cosh -1))
(chk-closeto rel-tol 1.0 '(cosh 0))
(chk-closeto rel-tol 1.54308063481524377848 '(cosh 1))
(chk-closeto rel-tol 3.76219569108363145956 '(cosh 2))
(chk-closeto rel-tol 10.06766199577776584195 '(cosh 3))
(chk-closeto rel-tol 0.44356825438511518913 '(acosh 1.1))
(chk-closeto rel-tol 0.62236250371477866781 '(acosh 1.2))
(chk-closeto rel-tol 0.75643291085695958624 '(acosh 1.3))
(chk-closeto rel-tol 0.86701472649056510395 '(acosh 1.4))
(chk-closeto rel-tol 0.962423650119206895 '(acosh 1.5))
(chk-closeto rel-tol 1.04696791500318841107 '(acosh 1.6))
(chk-closeto rel-tol 1.12323098258729588953 '(acosh 1.7))
(chk-closeto rel-tol 1.19291073099304900366 '(acosh 1.8))
(chk-closeto rel-tol 1.25719582660038043454 '(acosh 1.9))
(chk-closeto rel-tol 1.31695789692481670862 '(acosh 2))
(chk-closeto rel-tol 1.37285914424257984048 '(acosh 2.1))
(chk-closeto rel-tol 1.42541694307061258385 '(acosh 2.2))
(chk-closeto rel-tol 1.47504478124142507995 '(acosh 2.3))
(chk-closeto rel-tol 1.52207936746365331526 '(acosh 2.4))
(chk-closeto rel-tol 1.56679923697241107866 '(acosh 2.5))
(chk-closeto rel-tol -0.99505475368673045133 '(tanh -3))
(chk-closeto rel-tol -0.96402758007581688395 '(tanh -2))
(chk-closeto rel-tol -0.76159415595576488812 '(tanh -1))
(chk-closeto abs-tol 0.0 '(tanh 0))
(chk-closeto rel-tol 0.76159415595576488812 '(tanh 1))
(chk-closeto rel-tol 0.96402758007581688395 '(tanh 2))
(chk-closeto rel-tol 0.99505475368673045133 '(tanh 3))
(chk-closeto rel-tol -1.47221948958322023 '(atanh -0.9))
(chk-closeto rel-tol -1.0986122886681096914 '(atanh -0.8))
(chk-closeto rel-tol -0.86730052769405319443 '(atanh -0.7))
(chk-closeto rel-tol -0.69314718055994530942 '(atanh -0.6))
(chk-closeto rel-tol -0.5493061443340548457 '(atanh -0.5))
(chk-closeto rel-tol -0.42364893019360180686 '(atanh -0.4))
(chk-closeto rel-tol -0.30951960420311171547 '(atanh -0.3))
(chk-closeto rel-tol -0.20273255405408219099 '(atanh -0.2))
(chk-closeto rel-tol -0.10033534773107558064 '(atanh -0.1))
(chk-closeto abs-tol 0.0 '(atanh 0))
(chk-closeto rel-tol 0.10033534773107558064 '(atanh 0.1))
(chk-closeto rel-tol 0.20273255405408219099 '(atanh 0.2))
(chk-closeto rel-tol 0.30951960420311171547 '(atanh 0.3))
(chk-closeto rel-tol 0.42364893019360180686 '(atanh 0.4))
(chk-closeto rel-tol 0.5493061443340548457 '(atanh 0.5))
(chk-closeto rel-tol 0.69314718055994530942 '(atanh 0.6))
(chk-closeto rel-tol 0.86730052769405319443 '(atanh 0.7))
(chk-closeto rel-tol 1.0986122886681096914 '(atanh 0.8))
(chk-closeto rel-tol 1.47221948958322023 '(atanh 0.9))
(chk-closeto rel-tol 0.00247875217666635842 '(exp -6))
(chk-closeto rel-tol 0.0067379469990854671 '(exp -5))
(chk-closeto rel-tol 0.01831563888873418029 '(exp -4))
(chk-closeto rel-tol 0.04978706836786394298 '(exp -3))
(chk-closeto rel-tol 0.13533528323661269189 '(exp -2))
(chk-closeto rel-tol 0.3678794411714423216 '(exp -1))
(chk-closeto rel-tol 1 '(exp 0))
(chk-closeto rel-tol 2.71828182845904523536 '(exp 1))
(chk-closeto rel-tol 7.38905609893065022723 '(exp 2))
(chk-closeto rel-tol 20.08553692318766774093 '(exp 3))
(chk-closeto rel-tol 54.59815003314423907811 '(exp 4))
(chk-closeto rel-tol 148.41315910257660342111 '(exp 5))
(chk-closeto rel-tol 403.42879349273512260839 '(exp 6))
(chk-closeto rel-tol -2.30258509299404568402 '(log 0.1))
(chk-closeto rel-tol 0.09531017980432486004 '(log 1.1))
(chk-closeto rel-tol 0.74193734472937731248 '(log 2.1))
(chk-closeto rel-tol 1.13140211149110056191 '(log 3.1))
(chk-closeto rel-tol 1.41098697371026211985 '(log 4.1))
(chk-closeto rel-tol 1.62924053973028008763 '(log 5.1))
(chk-closeto rel-tol 1.0 '(sin (* pi 0.5)))
(chk-closeto abs-tol 0.0 '(cos (* pi 0.5)))
(chk-closeto rel-tol (/ pi 4.0) '(atan 1.0))
(chk-closeto rel-tol 10.0 '(sqrt 1.0e2))
(chk-closeto rel-tol 0.3333 '(exp (log 0.3333)))
(chk-closeto rel-tol 171.411373 '(exp (log 171.411373)))
(chk-closeto rel-tol 0.4753882 '(tan (atan 0.4753882)))
(chk-closeto abs-tol 1.0
'(let* ((x 0.4332758)
(s (sin x))
(c (cos x)))
(+ (* s s) (* c c))))
(chk-closeto abs-tol 1.0
'(let* ((x 14.123456579)
(s (sin x))
(c (cos x)))
(+ (* s s) (* c c))))
(chk-run 14 '(round 14.33))
(chk-run 15 '(round 14.53))
(chk-run 14 '(round 14.5))
(chk-run 14 '(floor 14.2))
(chk-run 14 '(floor 14.999))
(chk-run -15 '(floor -14.2))
(chk-run 15 '(ceiling 14.999))
(chk-run -14 '(ceiling -14.2))
(chk-run 14 '(truncate 14.2))
(chk-run -14 '(truncate -14.2))
(chk-run 566667/10000 '(round 170/3 10 4))
(chk-run 56667/1000 '(round 170/3 10 3))
(chk-run 5667/100 '(round 170/3 10 2))
(chk-run 567/10 '(round 170/3 10 1))
(chk-run 57 '(round 170/3 10 0))
(chk-run 60 '(round 170/3 10 -1))
(chk-run 100 '(round 170/3 10 -2))
(chk-run 0 '(round 170/3 10 -4))
(chk-run 56.6667 '(round 56.666666666666666 10 4))
(chk-run 56.667 '(round 56.666666666666666 10 3))
(chk-run 56.67 '(round 56.666666666666666 10 2))
(chk-run 56.7 '(round 56.666666666666666 10 1))
(chk-run 57 '(round 56.666666666666666 10 0))
(chk-run 60 '(round 56.666666666666666 10 -1))
(chk-run 100 '(round 56.666666666666666 10 -2))
(chk-run 0 '(round 56.666666666666666 10 -3))
(chk-closeto rel-tol 0.1233456677 '(cos (acos 0.1233456677)))
(chk-closeto rel-tol 0.4753882 '(sin (asin 0.4753882)))
(chk-run '(a 7 c) '(list 'a (+ 3 4) 'c))
(chk-run '() '(list))
(chk-run 3 '(length '(a b c)))
(chk-run 3 '(length '(a (b) (c d e))))
(chk-run 0 '(length '()))
(chk-run '(a . b) '(cons 'a 'b))
(chk-run '(a b c) '(list 'a 'b 'c))
(chk-run '(a b c) '(cons 'a (cons 'b (cons 'c '()))))
(chk-run '(a b c) '(id '(a . (b . (c . ())))))
(chk-run 'a '(car '(a . (b . (c . ())))))
(chk-run '(b c) '(cdr '(a . (b . (c . ())))))
(chk-run 'b '(cadr '(a . (b . (c . ())))))
(chk-run '(b e h) '(map cadr '((a b) (d e) (g h))))
(chk-run '(1 4 27 256 3125) '(map (lambda (n) (expt n n)) '(1 2 3 4 5)))
; R6RS says this can produce either '(1 2) or '(2 1); it basically returns
; the order in which map processes the contents of its list argument, which
; for haskeem is (1 2)
(chk-run '(1 2) '(let ((count 0))
(map (lambda (ignored)
(set! count (+ count 1))
count)
'(a b))))
(chk-run '(6 8 10 12) '(map + '(1 2 3 4) '(5 6 7 8)))
(chk-run -1 '((flip -) 2 1))
(chk-run 10 '(foldr + 0 '(1 2 3 4)))
(chk-run 10 '(foldl + 0 '(1 2 3 4)))
; test conditionals 'if', 'cond', 'when', and 'unless'
(define cond-test-expr '(cond ((= cond-test-var 1) 'foo)
((= cond-test-var 2) 'bar)
((= cond-test-var 3) 'baz)
(else 'quux)))
(define if-test-expr
'(if (= cond-test-var 1)
'foo (if (= cond-test-var 2)
'bar (if (= cond-test-var 3) 'baz 'quux))))
(define when-test-expr '(when (= cond-test-var 1) 'foo))
(define unless-test-expr '(unless (= cond-test-var 1) 'foo))
(define cond-test-var 1)
(chk-run 'foo cond-test-expr)
(chk-run 'foo if-test-expr)
(chk-run 'foo when-test-expr)
(chk-run #f unless-test-expr)
(define cond-test-var 2)
(chk-run 'bar cond-test-expr)
(chk-run 'bar if-test-expr)
(chk-run #f when-test-expr)
(chk-run 'foo unless-test-expr)
(define cond-test-var 3)
(chk-run 'baz cond-test-expr)
(chk-run 'baz if-test-expr)
(chk-run #f when-test-expr)
(chk-run 'foo unless-test-expr)
(define cond-test-var 4)
(chk-run 'quux cond-test-expr)
(chk-run 'quux if-test-expr)
(chk-run #f when-test-expr)
(chk-run 'foo unless-test-expr)
; and the alternate cond syntax with '=>'
(define cond-test-expr '(cond ((= cond-test-var 1) 0)
((= cond-test-var 2) 1)
(cond-test-var => sin)))
(define cond-test-var 1)
(chk-run 0 cond-test-expr)
(define cond-test-var 2)
(chk-run 1 cond-test-expr)
(define cond-test-var 3)
(chk-closeto rel-tol 0.1411200080598672 cond-test-expr)
(define cond-test-var 4)
(chk-closeto rel-tol -0.7568024953079282 cond-test-expr)
; test conditionals 'and' and 'or'
; if (write-string) is reached, and failed
(chk-run #f '(and 1 'a '() #f (write-string "and failed!\n")))
(chk-run 'baloney '(and 1 'a 'baloney))
; if (write-string) is reached, or failed
(chk-run 'a '(or #f 'a 1 '() (write-string "or failed!\n")))
(chk-run #f '(or #f (= 1 0)))
(chk-run #f '(or #f (= 0 2) #f))
; test conditional 'case'; these are pretty directly from R6RS:
(define case-expr '(case case-val
((1) 'unit)
((2 3 5 7) 'prime)
((4 6 8 9 10 (* 6 2)) 'composite)))
(define case-val 1)
(chk-run 'unit case-expr)
(define case-val 2)
(chk-run 'prime case-expr)
(define case-val 3)
(chk-run 'prime case-expr)
(define case-val 4)
(chk-run 'composite case-expr)
(define case-val 5)
(chk-run 'prime case-expr)
(define case-val 6)
(chk-run 'composite case-expr)
(define case-val 7)
(chk-run 'prime case-expr)
(define case-val 8)
(chk-run 'composite case-expr)
(define case-val 9)
(chk-run 'composite case-expr)
(define case-val 10)
(chk-run 'composite case-expr)
(define case-val 11)
(chk-run #f case-expr)
(define case-val 12)
(chk-run #f case-expr)
(define case-val '(* 6 2))
(chk-run 'composite case-expr)
(chk-run #f '(case (car '(c d))
((a) 'a)
((b) 'b)))
(chk-run 'vowel '(case (car '(u d))
((a e i o u) 'vowel)
((w y) 'semivowel)
(else 'consonant)))
; letXXX examples are pretty much directly from R6RS:
; test let form, including shadowing of variables:
; def'n of z sees outer value of x, then body sees inner value
(chk-run 35 '(let ((x 2) (y 3))
(let ((x 7) (z (+ x y)))
(* z x))))
(chk-run 42 '(let ((x 23)) (set! x 42) x))
; test let* form: this is almost the same as above, except that now
; the def'n of z should see the inner value of x rather than the outer
(chk-run 70 '(let ((x 2) (y 3))
(let* ((x 7) (z (+ x y)))
(* z x))))
; test letrec form: mutually-recursive procedures evo? and odo?
(chk-run #t '(letrec ((evo?
(lambda (n)
(if (zero? n)
#t
(odo? (- n 1)))))
(odo?
(lambda (n)
(if (zero? n)
#f
(evo? (- n 1))))))
(evo? 88)))
; test letrec*: mutually-recursive, plus prior variables accessible
(chk-run 5 '(letrec* ((p (lambda (x) (+ 1 (q (- x 1)))))
(q (lambda (y) (if (zero? y) 0 (+ 1 (p (- y 1))))))
(x (p 5))
(y x))
y))
; test named-let form
(chk-run '((6 1 3) (-5 -2)) '(let lupus ((numbers '(3 -2 1 6 -5))
(nonneg '())
(neg '()))
(cond ((null? numbers) (list nonneg neg))
((>= (car numbers) 0)
(lupus (cdr numbers)
(cons (car numbers) nonneg)
neg))
((< (car numbers) 0)
(lupus (cdr numbers)
nonneg
(cons (car numbers) neg))))))
; test "do" syntactic form: this comes directly from R6RS
(chk-run 25 '(let ((x '(1 3 5 7 9)))
(do ((x x (cdr x))
(sum 0 (+ sum (car x))))
((null? x) sum))))
; and this version checks the (<variable> <init>) version, without the <step>
(chk-run 35 '(let ((x '(1 3 5 7 9)))
(do ((x x (cdr x))
(monkey 2)
(sum 0 (+ sum monkey (car x))))
((null? x) sum))))
; test some list-manipulation functions
(chk-run '((1 a) (2 b) (3 c)) '(map list '(1 2 3) '(a b c)))
(chk-run '((1 2 3) (a b c)) '(unzip '((1 a) (2 b) (3 c))))
(chk-run '(5 7 9) '(map + '(1 2 3) '(4 5 6)))
(chk-run '(4 10 18) '(map * '(1 2 3) '(4 5 6)))
(chk-run '(0) '(replicate 0 1))
(chk-run '(0 0 0) '(replicate 0 3))
(chk-run '((1 2)) '(replicate '(1 2) 1))
(chk-run '((1 2) (1 2) (1 2)) '(replicate '(1 2) 3))
(chk-run '() '(replicate '(1 2) 0))
(chk-run '(0 1 2 3 4) '(upfrom 0 5))
(chk-run '(0 1 2 3 4) '(list-tabulate 5 id))
(chk-run '() '(list-tabulate 0 id))
(chk-run '(0 1 4 9 16) '(list-tabulate 5 (lambda (x) (* x x))))
(define lst '(1 2 7 9 3 4 4 6 -1 8 11 -24))
(chk-run 12 '(length lst))
(chk-run '() '(list-head lst -2))
(chk-run '() '(list-head lst 0))
(chk-run '(1 2 7 9 3) '(list-head lst 5))
(chk-run lst '(list-head lst 100))
(chk-run '(4 4 6 -1 8 11 -24) '(list-tail lst 5))
(chk-run lst '(list-tail lst -100))
(chk-run lst '(list-tail lst 0))
(chk-run '() '(list-tail lst 100))
(chk-run '(8 11 -24) '(list-unhead lst 3))
(chk-run '() '(list-unhead lst -10))
(chk-run '() '(list-unhead lst 0))
(chk-run lst '(list-unhead lst 100))
(chk-run '(1 2 7 9 3 4 4 6) '(list-untail lst 4))
(chk-run lst '(list-untail lst -100))
(chk-run '() '(list-untail lst 100))
(chk-run 1 '(list-ref lst -100))
(chk-run 1 '(list-ref lst 0))
(chk-run 9 '(list-ref lst 3))
(chk-run '() '(list-ref lst 100))
(chk-run lst '(list-unref lst -100))
(chk-run (cdr lst) '(list-unref lst 0))
(chk-run '(1 2 7 3 4 4 6 -1 8 11 -24) '(list-unref lst 3))
(chk-run lst '(list-unref lst 100))
(chk-run -24 '(last lst))
(chk-run '(x y) '(append '(x) '(y)))
(chk-run '(a b c d) '(append '(a) '(b c d)))
(chk-run '(a (b) (c)) '(append '(a (b)) '((c))))
(chk-run '(a b c . d) '(append '(a b) '(c . d)))
(chk-run 'a '(append '() 'a))
(chk-run '(c b a) '(reverse '(a b c)))
(chk-run '((e (f)) d (b c) a) '(reverse '(a (b c) d (e (f)))))
(chk-run lst '(append (list-head lst 5) (list-unhead lst 7)))
(chk-run '(1 2 3 4 5 6 7 8 9) '(append '(1 2 3) '(4 5) '(6 7) '(8 9)))
(chk-run '(-24 11 8 -1 6) '(reverse (list-unhead lst 5)))
(chk-run '(2 4 4 6 8 -24) '(filter even? lst))
(chk-run '(1 7 9 3 -1 11 -24)
'(filter (lambda (x) (or (odd? x) (< x 0))) lst))
(chk-run '(3 5 15 19 7 9 9 13 -1 17 23 -47)
'(map (lambda (x) (+ 1 (* 2 x))) lst))
(chk-run 4 '(find even? '(3 1 4 1 5 9)))
(chk-run #f '(find even? '(3 1 5 1 5 9)))
(chk-run '(4 1 5 9 2 6 5) '(memp even? '(3 1 4 1 5 9 2 6 5)))
(chk-run #f '(memp negative? '(3 1 4 1 5 9 2 6 5)))
(chk-run '(101 102) '(memv 101 '(100 101 102)))
(chk-run #f '(memv 99 '(100 101 102)))
(chk-run '(4 c) '(assp even? '((3 a) (1 b) (4 c))))
(chk-run '(3 a) '(assp odd? '((3 a) (1 b) (4 c))))
(chk-run #f '(assp zero? '((3 a) (1 b) (4 c))))
(chk-run '(4 c) '(assv 4 '((3 a) (1 b) (4 c))))
(chk-run '(3 a) '(assv 3 '((3 a) (1 b) (4 c))))
(chk-run '(1 b) '(assv 1 '((3 a) (1 b) (4 c))))
(chk-run #f '(assv 0 '((3 a) (1 b) (4 c))))
(chk-run '((4 2 6 8) (3 1 1 5 9 5 3 5 9))
'(partition even? '(3 1 4 1 5 9 2 6 5 3 5 8 9)))
; sort in increasing order
(define (c1 x y) (< x y))
(chk-run '(-24 -1 1 2 3 4 4 6 7 8 9 11) '(list-sort c1 lst))
; sort in decreasing order (then reverse)
(define (c2 x y) (> x y))
(chk-run '(-24 -1 1 2 3 4 4 6 7 8 9 11) '(reverse (list-sort c2 lst)))
; expect first all odds, decreasing, then all evens, increasing:
; if both are even, use comparison function c1 -> increasing
; if both are odd, use c2 -> decreasing
; if one is odd and one is even, the odd comes first
(define (c3 x y)
(define ex (even? x))
(define ey (even? y))
(cond ((and ex ey) (c1 x y))
((and (not ex) (not ey)) (c2 x y))
((and ex (not ey)) #f)
((and (not ex) ey) #t)
(else (error "waaa"))))
(chk-run '(11 9 7 3 1 -1 -24 2 4 4 6 8) '(list-sort c3 lst))
; test stability of list-sort
(define lp '((1 a) (1 b) (2 a) (1 c) (3 b) (2 f) (1 d) (2 b)))
(define (c1p x y) (< (car x) (car y)))
(chk-run '((1 a) (1 b) (1 c) (1 d) (2 a) (2 f) (2 b) (3 b))
'(list-sort c1p lp))
(chk-run '(#\N #\O #\W) '(char-upcase (list #\n #\o #\w)))
(chk-run '(#\N #\O #\W) '(char-upcase #\n #\o #\w))
(chk-run '#\I '(char-upcase #\i))
(chk-run '#\s '(char-downcase #\S))
(chk-run "doit" '(char->string #\d #\o #\i #\t))
(chk-run "right" '(char->string '(#\r #\i #\g #\h #\t)))
(chk-run '(#\t #\i #\m #\e) '(char-downcase (list #\T #\I #\M #\E)))
(chk-run '(#\t #\i #\m #\e) '(char-downcase #\T #\I #\M #\E))
(chk-run "NOW IS THE TIME!" '(string-upcase "now is the time!"))
(chk-run "it works, he said, in a small quiet voice"
'(string-downcase "IT WORKS, He sAId, IN A sMall QUIET voIcE"))
(chk-run '(7 9 3 4 4 6 -1 8 11 -24)
'(list-drop-while (lambda (v) (< v 5)) lst))
(chk-run '((1 2) (7 9 3 4 4 6 -1 8 11 -24))
'(list-take-while (lambda (v) (< v 5)) lst))
(chk-run '(1 2 3 2 1) '(list-remove-dups '(1 2 2 3 3 2 2 2 2 2 1 1)))
(chk-run '("it" "works" "he" "said" "in" "a" "small" "quiet" "voice")
'(string-split-by (lambda (c) (not (char-alphabetic? c)))
"it works, he said, in a small quiet voice"))
(chk-run "now, is, the, time, for, all"
'(string-join-by ", " (list "now" "is" "the" "time" "for" "all")))
(chk-run "now:is:the:time:for:all"
'(string-join-by ":" "now" "is" "the" "time" "for" "all"))
(chk-run 3735928559 '(string->number "#xdeadbeef"))
; THIS IS AN EXTENSION OF R6RS!
; They only do decimal floating-point numbers... how boring!
(chk-run 2.220446049250313e-16 '(string->number "#b1.0e-110100"))
; and use that extension to probe the floating-point representation...
(chk-run #f '(= 1.0 (+ 1.0 #b1.0e-110100)))
(chk-run #t '(= 1.0 (+ 1.0 #b1.0e-110101)))
; pi in base-8 and base-16
(chk-run "#o3.1103755242102643e0" '(number->string pi 8))
(chk-run "#x3.243f6a8885a3x0" '(number->string pi 16))
; this generates the base-8 string representing pi, explodes it into
; individual digits, adds those up via foldr, and compares the result
; to pi... this is specific to base 8, because:
; in base-2, the exponent is 1 not 0, but we just clip it off
; in base-10, there is no "#d" at the head, so we clip off too much
; in base-16, the simplistic character->number conversion doesn't work
(chk-run pi '(+ 3.0 (/ (foldr (lambda (a b)
(+ (string->number (char->string a))
(/ b 8)))
0.0
(list-untail
(list-tail
(string->char (number->string pi 8))
4) 2)) 8)))
; This tests a hack: I have "(define (eval x) (eval x))" in stdlib.scm,
; which looks quite idiotic (and, indeed, it is) but it works, because
; "eval" is currently a special form in haskeem: so (eval foo) works,
; but (map eval (list foo)) does not. I have to fix that...
(chk-run '(3 1.0 #\C) '(map eval '((+ 1 2) (sin (/ pi 2)) (integer->char 67))))
; check rational comparison operators
(define nan 0/0)
(define pinf 1/0)
(define ninf -1/0)
(define zero 0)
(define pos 1)
(define neg -1)
; check comparison operator =
(chk-run #f '(= nan nan))
(chk-run #f '(= nan ninf))
(chk-run #f '(= nan neg))
(chk-run #f '(= nan zero))
(chk-run #f '(= nan pos))
(chk-run #f '(= nan pinf))
(chk-run #f '(= ninf nan))
(chk-run #t '(= ninf ninf))
(chk-run #f '(= ninf neg))
(chk-run #f '(= ninf zero))
(chk-run #f '(= ninf pos))
(chk-run #f '(= ninf pinf))
(chk-run #f '(= neg nan))
(chk-run #f '(= neg ninf))
(chk-run #t '(= neg neg))
(chk-run #f '(= neg zero))
(chk-run #f '(= neg pos))
(chk-run #f '(= neg pinf))
(chk-run #f '(= zero nan))
(chk-run #f '(= zero ninf))
(chk-run #f '(= zero neg))
(chk-run #t '(= zero zero))
(chk-run #f '(= zero pos))
(chk-run #f '(= zero pinf))
(chk-run #f '(= pos nan))
(chk-run #f '(= pos ninf))
(chk-run #f '(= pos neg))
(chk-run #f '(= pos zero))
(chk-run #t '(= pos pos))
(chk-run #f '(= pos pinf))
(chk-run #f '(= pinf nan))
(chk-run #f '(= pinf ninf))
(chk-run #f '(= pinf neg))
(chk-run #f '(= pinf zero))
(chk-run #f '(= pinf pos))
(chk-run #t '(= pinf pinf))
; check comparison operator /=
(chk-run #t '(/= nan nan))
(chk-run #t '(/= nan ninf))
(chk-run #t '(/= nan neg))
(chk-run #t '(/= nan zero))
(chk-run #t '(/= nan pos))
(chk-run #t '(/= nan pinf))
(chk-run #t '(/= ninf nan))
(chk-run #f '(/= ninf ninf))
(chk-run #t '(/= ninf neg))
(chk-run #t '(/= ninf zero))
(chk-run #t '(/= ninf pos))
(chk-run #t '(/= ninf pinf))
(chk-run #t '(/= neg nan))
(chk-run #t '(/= neg ninf))
(chk-run #f '(/= neg neg))
(chk-run #t '(/= neg zero))
(chk-run #t '(/= neg pos))
(chk-run #t '(/= neg pinf))
(chk-run #t '(/= zero nan))
(chk-run #t '(/= zero ninf))
(chk-run #t '(/= zero neg))
(chk-run #f '(/= zero zero))
(chk-run #t '(/= zero pos))
(chk-run #t '(/= zero pinf))
(chk-run #t '(/= pos nan))
(chk-run #t '(/= pos ninf))
(chk-run #t '(/= pos neg))
(chk-run #t '(/= pos zero))
(chk-run #f '(/= pos pos))
(chk-run #t '(/= pos pinf))
(chk-run #t '(/= pinf nan))
(chk-run #t '(/= pinf ninf))
(chk-run #t '(/= pinf neg))
(chk-run #t '(/= pinf zero))
(chk-run #t '(/= pinf pos))
(chk-run #f '(/= pinf pinf))
; check comparison operator <
(chk-run #f '(< nan nan))
(chk-run #f '(< nan ninf))
(chk-run #f '(< nan neg))
(chk-run #f '(< nan zero))
(chk-run #f '(< nan pos))
(chk-run #f '(< nan pinf))
(chk-run #f '(< ninf nan))
(chk-run #f '(< ninf ninf))
(chk-run #t '(< ninf neg))
(chk-run #t '(< ninf zero))
(chk-run #t '(< ninf pos))
(chk-run #t '(< ninf pinf))
(chk-run #f '(< neg nan))
(chk-run #f '(< neg ninf))
(chk-run #f '(< neg neg))
(chk-run #t '(< neg zero))
(chk-run #t '(< neg pos))
(chk-run #t '(< neg pinf))
(chk-run #f '(< zero nan))
(chk-run #f '(< zero ninf))
(chk-run #f '(< zero neg))
(chk-run #f '(< zero zero))
(chk-run #t '(< zero pos))
(chk-run #t '(< zero pinf))
(chk-run #f '(< pos nan))
(chk-run #f '(< pos ninf))
(chk-run #f '(< pos neg))
(chk-run #f '(< pos zero))
(chk-run #f '(< pos pos))
(chk-run #t '(< pos pinf))
(chk-run #f '(< pinf nan))
(chk-run #f '(< pinf ninf))
(chk-run #f '(< pinf neg))
(chk-run #f '(< pinf zero))
(chk-run #f '(< pinf pos))
(chk-run #f '(< pinf pinf))
; check comparison operator >
(chk-run #f '(> nan nan))
(chk-run #f '(> nan ninf))
(chk-run #f '(> nan neg))
(chk-run #f '(> nan zero))
(chk-run #f '(> nan pos))
(chk-run #f '(> nan pinf))
(chk-run #f '(> ninf nan))
(chk-run #f '(> ninf ninf))
(chk-run #f '(> ninf neg))
(chk-run #f '(> ninf zero))
(chk-run #f '(> ninf pos))
(chk-run #f '(> ninf pinf))
(chk-run #f '(> neg nan))
(chk-run #t '(> neg ninf))
(chk-run #f '(> neg neg))
(chk-run #f '(> neg zero))
(chk-run #f '(> neg pos))
(chk-run #f '(> neg pinf))
(chk-run #f '(> zero nan))
(chk-run #t '(> zero ninf))
(chk-run #t '(> zero neg))
(chk-run #f '(> zero zero))
(chk-run #f '(> zero pos))
(chk-run #f '(> zero pinf))
(chk-run #f '(> pos nan))
(chk-run #t '(> pos ninf))
(chk-run #t '(> pos neg))
(chk-run #t '(> pos zero))
(chk-run #f '(> pos pos))
(chk-run #f '(> pos pinf))
(chk-run #f '(> pinf nan))
(chk-run #t '(> pinf ninf))
(chk-run #t '(> pinf neg))
(chk-run #t '(> pinf zero))
(chk-run #t '(> pinf pos))
(chk-run #f '(> pinf pinf))
; check comparison operator <=
(chk-run #f '(<= nan nan))
(chk-run #f '(<= nan ninf))
(chk-run #f '(<= nan neg))
(chk-run #f '(<= nan zero))
(chk-run #f '(<= nan pos))
(chk-run #f '(<= nan pinf))
(chk-run #f '(<= ninf nan))
(chk-run #t '(<= ninf ninf))
(chk-run #t '(<= ninf neg))
(chk-run #t '(<= ninf zero))
(chk-run #t '(<= ninf pos))
(chk-run #t '(<= ninf pinf))
(chk-run #f '(<= neg nan))
(chk-run #f '(<= neg ninf))
(chk-run #t '(<= neg neg))
(chk-run #t '(<= neg zero))
(chk-run #t '(<= neg pos))
(chk-run #t '(<= neg pinf))
(chk-run #f '(<= zero nan))
(chk-run #f '(<= zero ninf))
(chk-run #f '(<= zero neg))
(chk-run #t '(<= zero zero))
(chk-run #t '(<= zero pos))
(chk-run #t '(<= zero pinf))
(chk-run #f '(<= pos nan))
(chk-run #f '(<= pos ninf))
(chk-run #f '(<= pos neg))
(chk-run #f '(<= pos zero))
(chk-run #t '(<= pos pos))
(chk-run #t '(<= pos pinf))
(chk-run #f '(<= pinf nan))
(chk-run #f '(<= pinf ninf))
(chk-run #f '(<= pinf neg))
(chk-run #f '(<= pinf zero))
(chk-run #f '(<= pinf pos))
(chk-run #t '(<= pinf pinf))
; check comparison operator >=
(chk-run #f '(>= nan nan))
(chk-run #f '(>= nan ninf))
(chk-run #f '(>= nan neg))
(chk-run #f '(>= nan zero))
(chk-run #f '(>= nan pos))
(chk-run #f '(>= nan pinf))
(chk-run #f '(>= ninf nan))
(chk-run #t '(>= ninf ninf))
(chk-run #f '(>= ninf neg))
(chk-run #f '(>= ninf zero))
(chk-run #f '(>= ninf pos))
(chk-run #f '(>= ninf pinf))
(chk-run #f '(>= neg nan))
(chk-run #t '(>= neg ninf))
(chk-run #t '(>= neg neg))
(chk-run #f '(>= neg zero))
(chk-run #f '(>= neg pos))
(chk-run #f '(>= neg pinf))
(chk-run #f '(>= zero nan))
(chk-run #t '(>= zero ninf))
(chk-run #t '(>= zero neg))
(chk-run #t '(>= zero zero))
(chk-run #f '(>= zero pos))
(chk-run #f '(>= zero pinf))
(chk-run #f '(>= pos nan))
(chk-run #t '(>= pos ninf))
(chk-run #t '(>= pos neg))
(chk-run #t '(>= pos zero))
(chk-run #t '(>= pos pos))
(chk-run #f '(>= pos pinf))
(chk-run #f '(>= pinf nan))
(chk-run #t '(>= pinf ninf))
(chk-run #t '(>= pinf neg))
(chk-run #t '(>= pinf zero))
(chk-run #t '(>= pinf pos))
(chk-run #t '(>= pinf pinf))
; check floating-point comparison operators
(define nan +nan.0)
(define pinf +inf.0)
(define ninf -inf.0)
(define zero 0.0)
(define pos 1.0)
(define neg -1.0)
; check comparison operator =
(chk-run #f '(= nan nan))
(chk-run #f '(= nan ninf))
(chk-run #f '(= nan neg))
(chk-run #f '(= nan zero))
(chk-run #f '(= nan pos))
(chk-run #f '(= nan pinf))
(chk-run #f '(= ninf nan))
(chk-run #t '(= ninf ninf))
(chk-run #f '(= ninf neg))
(chk-run #f '(= ninf zero))
(chk-run #f '(= ninf pos))
(chk-run #f '(= ninf pinf))
(chk-run #f '(= neg nan))
(chk-run #f '(= neg ninf))
(chk-run #t '(= neg neg))
(chk-run #f '(= neg zero))
(chk-run #f '(= neg pos))
(chk-run #f '(= neg pinf))
(chk-run #f '(= zero nan))
(chk-run #f '(= zero ninf))
(chk-run #f '(= zero neg))
(chk-run #t '(= zero zero))
(chk-run #f '(= zero pos))
(chk-run #f '(= zero pinf))
(chk-run #f '(= pos nan))
(chk-run #f '(= pos ninf))
(chk-run #f '(= pos neg))
(chk-run #f '(= pos zero))
(chk-run #t '(= pos pos))
(chk-run #f '(= pos pinf))
(chk-run #f '(= pinf nan))
(chk-run #f '(= pinf ninf))
(chk-run #f '(= pinf neg))
(chk-run #f '(= pinf zero))
(chk-run #f '(= pinf pos))
(chk-run #t '(= pinf pinf))
; check comparison operator /=
(chk-run #t '(/= nan nan))
(chk-run #t '(/= nan ninf))
(chk-run #t '(/= nan neg))
(chk-run #t '(/= nan zero))
(chk-run #t '(/= nan pos))
(chk-run #t '(/= nan pinf))
(chk-run #t '(/= ninf nan))
(chk-run #f '(/= ninf ninf))
(chk-run #t '(/= ninf neg))
(chk-run #t '(/= ninf zero))
(chk-run #t '(/= ninf pos))
(chk-run #t '(/= ninf pinf))
(chk-run #t '(/= neg nan))
(chk-run #t '(/= neg ninf))
(chk-run #f '(/= neg neg))
(chk-run #t '(/= neg zero))
(chk-run #t '(/= neg pos))
(chk-run #t '(/= neg pinf))
(chk-run #t '(/= zero nan))
(chk-run #t '(/= zero ninf))
(chk-run #t '(/= zero neg))
(chk-run #f '(/= zero zero))
(chk-run #t '(/= zero pos))
(chk-run #t '(/= zero pinf))
(chk-run #t '(/= pos nan))
(chk-run #t '(/= pos ninf))
(chk-run #t '(/= pos neg))
(chk-run #t '(/= pos zero))
(chk-run #f '(/= pos pos))
(chk-run #t '(/= pos pinf))
(chk-run #t '(/= pinf nan))
(chk-run #t '(/= pinf ninf))
(chk-run #t '(/= pinf neg))
(chk-run #t '(/= pinf zero))
(chk-run #t '(/= pinf pos))
(chk-run #f '(/= pinf pinf))
; check comparison operator <
(chk-run #f '(< nan nan))
(chk-run #f '(< nan ninf))
(chk-run #f '(< nan neg))
(chk-run #f '(< nan zero))
(chk-run #f '(< nan pos))
(chk-run #f '(< nan pinf))
(chk-run #f '(< ninf nan))
(chk-run #f '(< ninf ninf))
(chk-run #t '(< ninf neg))
(chk-run #t '(< ninf zero))
(chk-run #t '(< ninf pos))
(chk-run #t '(< ninf pinf))
(chk-run #f '(< neg nan))
(chk-run #f '(< neg ninf))
(chk-run #f '(< neg neg))
(chk-run #t '(< neg zero))
(chk-run #t '(< neg pos))
(chk-run #t '(< neg pinf))
(chk-run #f '(< zero nan))
(chk-run #f '(< zero ninf))
(chk-run #f '(< zero neg))
(chk-run #f '(< zero zero))
(chk-run #t '(< zero pos))
(chk-run #t '(< zero pinf))
(chk-run #f '(< pos nan))
(chk-run #f '(< pos ninf))
(chk-run #f '(< pos neg))
(chk-run #f '(< pos zero))
(chk-run #f '(< pos pos))
(chk-run #t '(< pos pinf))
(chk-run #f '(< pinf nan))
(chk-run #f '(< pinf ninf))
(chk-run #f '(< pinf neg))
(chk-run #f '(< pinf zero))
(chk-run #f '(< pinf pos))
(chk-run #f '(< pinf pinf))
; check comparison operator >
(chk-run #f '(> nan nan))
(chk-run #f '(> nan ninf))
(chk-run #f '(> nan neg))
(chk-run #f '(> nan zero))
(chk-run #f '(> nan pos))
(chk-run #f '(> nan pinf))
(chk-run #f '(> ninf nan))
(chk-run #f '(> ninf ninf))
(chk-run #f '(> ninf neg))
(chk-run #f '(> ninf zero))
(chk-run #f '(> ninf pos))
(chk-run #f '(> ninf pinf))
(chk-run #f '(> neg nan))
(chk-run #t '(> neg ninf))
(chk-run #f '(> neg neg))
(chk-run #f '(> neg zero))
(chk-run #f '(> neg pos))
(chk-run #f '(> neg pinf))
(chk-run #f '(> zero nan))
(chk-run #t '(> zero ninf))
(chk-run #t '(> zero neg))
(chk-run #f '(> zero zero))
(chk-run #f '(> zero pos))
(chk-run #f '(> zero pinf))
(chk-run #f '(> pos nan))
(chk-run #t '(> pos ninf))
(chk-run #t '(> pos neg))
(chk-run #t '(> pos zero))
(chk-run #f '(> pos pos))
(chk-run #f '(> pos pinf))
(chk-run #f '(> pinf nan))
(chk-run #t '(> pinf ninf))
(chk-run #t '(> pinf neg))
(chk-run #t '(> pinf zero))
(chk-run #t '(> pinf pos))
(chk-run #f '(> pinf pinf))
; check comparison operator <=
(chk-run #f '(<= nan nan))
(chk-run #f '(<= nan ninf))
(chk-run #f '(<= nan neg))
(chk-run #f '(<= nan zero))
(chk-run #f '(<= nan pos))
(chk-run #f '(<= nan pinf))
(chk-run #f '(<= ninf nan))
(chk-run #t '(<= ninf ninf))
(chk-run #t '(<= ninf neg))
(chk-run #t '(<= ninf zero))
(chk-run #t '(<= ninf pos))
(chk-run #t '(<= ninf pinf))
(chk-run #f '(<= neg nan))
(chk-run #f '(<= neg ninf))
(chk-run #t '(<= neg neg))
(chk-run #t '(<= neg zero))
(chk-run #t '(<= neg pos))
(chk-run #t '(<= neg pinf))
(chk-run #f '(<= zero nan))
(chk-run #f '(<= zero ninf))
(chk-run #f '(<= zero neg))
(chk-run #t '(<= zero zero))
(chk-run #t '(<= zero pos))
(chk-run #t '(<= zero pinf))
(chk-run #f '(<= pos nan))
(chk-run #f '(<= pos ninf))
(chk-run #f '(<= pos neg))
(chk-run #f '(<= pos zero))
(chk-run #t '(<= pos pos))
(chk-run #t '(<= pos pinf))
(chk-run #f '(<= pinf nan))
(chk-run #f '(<= pinf ninf))
(chk-run #f '(<= pinf neg))
(chk-run #f '(<= pinf zero))
(chk-run #f '(<= pinf pos))
(chk-run #t '(<= pinf pinf))
; check comparison operator >=
(chk-run #f '(>= nan nan))
(chk-run #f '(>= nan ninf))
(chk-run #f '(>= nan neg))
(chk-run #f '(>= nan zero))
(chk-run #f '(>= nan pos))
(chk-run #f '(>= nan pinf))
(chk-run #f '(>= ninf nan))
(chk-run #t '(>= ninf ninf))
(chk-run #f '(>= ninf neg))
(chk-run #f '(>= ninf zero))
(chk-run #f '(>= ninf pos))
(chk-run #f '(>= ninf pinf))
(chk-run #f '(>= neg nan))
(chk-run #t '(>= neg ninf))
(chk-run #t '(>= neg neg))
(chk-run #f '(>= neg zero))
(chk-run #f '(>= neg pos))
(chk-run #f '(>= neg pinf))
(chk-run #f '(>= zero nan))
(chk-run #t '(>= zero ninf))
(chk-run #t '(>= zero neg))
(chk-run #t '(>= zero zero))
(chk-run #f '(>= zero pos))
(chk-run #f '(>= zero pinf))
(chk-run #f '(>= pos nan))
(chk-run #t '(>= pos ninf))
(chk-run #t '(>= pos neg))
(chk-run #t '(>= pos zero))
(chk-run #t '(>= pos pos))
(chk-run #f '(>= pos pinf))
(chk-run #f '(>= pinf nan))
(chk-run #t '(>= pinf ninf))
(chk-run #t '(>= pinf neg))
(chk-run #t '(>= pinf zero))
(chk-run #t '(>= pinf pos))
(chk-run #t '(>= pinf pinf))
; check rational arithmetic
(define nan 0/0)
(define pinf 1/0)
(define ninf -1/0)
(define zero 0)
(define pos 1)
(define neg -1)
(define fpnan (sqrt -1.0))
(chk-run nan '(+ nan nan))
(chk-run nan '(+ nan pinf))
(chk-run nan '(+ nan pos))
(chk-run nan '(+ nan zero))
(chk-run nan '(+ nan neg))
(chk-run nan '(+ nan ninf))
(chk-run nan '(+ pinf nan))
(chk-run pinf '(+ pinf pinf))
(chk-run pinf '(+ pinf pos))
(chk-run pinf '(+ pinf zero))
(chk-run pinf '(+ pinf neg))
(chk-run nan '(+ pinf ninf))
(chk-run nan '(+ pos nan))
(chk-run pinf '(+ pos pinf))
(chk-run 2 '(+ pos pos))
(chk-run pos '(+ pos zero))
(chk-run zero '(+ pos neg))
(chk-run ninf '(+ pos ninf))
(chk-run nan '(+ zero nan))
(chk-run pinf '(+ zero pinf))
(chk-run pos '(+ zero pos))
(chk-run zero '(+ zero zero))
(chk-run neg '(+ zero neg))
(chk-run ninf '(+ zero ninf))
(chk-run nan '(+ neg nan))
(chk-run pinf '(+ neg pinf))
(chk-run zero '(+ neg pos))
(chk-run neg '(+ neg zero))
(chk-run -2 '(+ neg neg))
(chk-run ninf '(+ neg ninf))
(chk-run nan '(+ ninf nan))
(chk-run nan '(+ ninf pinf))
(chk-run ninf '(+ ninf pos))
(chk-run ninf '(+ ninf zero))
(chk-run ninf '(+ ninf neg))
(chk-run ninf '(+ ninf ninf))
(chk-run nan '(- nan nan))
(chk-run nan '(- nan pinf))
(chk-run nan '(- nan pos))
(chk-run nan '(- nan zero))
(chk-run nan '(- nan neg))
(chk-run nan '(- nan ninf))
(chk-run nan '(- pinf nan))
(chk-run nan '(- pinf pinf))
(chk-run pinf '(- pinf pos))
(chk-run pinf '(- pinf zero))
(chk-run pinf '(- pinf neg))
(chk-run pinf '(- pinf ninf))
(chk-run nan '(- pos nan))
(chk-run ninf '(- pos pinf))
(chk-run zero '(- pos pos))
(chk-run pos '(- pos zero))
(chk-run 2 '(- pos neg))
(chk-run pinf '(- pos ninf))
(chk-run nan '(- zero nan))
(chk-run ninf '(- zero pinf))
(chk-run neg '(- zero pos))
(chk-run zero '(- zero zero))
(chk-run pos '(- zero neg))
(chk-run pinf '(- zero ninf))
(chk-run nan '(- neg nan))
(chk-run ninf '(- neg pinf))
(chk-run -2 '(- neg pos))
(chk-run neg '(- neg zero))
(chk-run zero '(- neg neg))
(chk-run pinf '(- neg ninf))
(chk-run nan '(- ninf nan))
(chk-run ninf '(- ninf pinf))
(chk-run ninf '(- ninf pos))
(chk-run ninf '(- ninf zero))
(chk-run ninf '(- ninf neg))
(chk-run nan '(- ninf ninf))
(chk-run nan '(* nan nan))
(chk-run nan '(* nan pinf))
(chk-run nan '(* nan pos))
(chk-run nan '(* nan zero))
(chk-run nan '(* nan neg))
(chk-run nan '(* nan ninf))
(chk-run nan '(* pinf nan))
(chk-run pinf '(* pinf pinf))
(chk-run pinf '(* pinf pos))
(chk-run nan '(* pinf zero))
(chk-run ninf '(* pinf neg))
(chk-run ninf '(* pinf ninf))
(chk-run nan '(* pos nan))
(chk-run pinf '(* pos pinf))
(chk-run pos '(* pos pos))
(chk-run zero '(* pos zero))
(chk-run neg '(* pos neg))
(chk-run ninf '(* pos ninf))
(chk-run nan '(* zero nan))
(chk-run nan '(* zero pinf))
(chk-run zero '(* zero pos))
(chk-run zero '(* zero zero))
(chk-run zero '(* zero neg))
(chk-run nan '(* zero ninf))
(chk-run nan '(* neg nan))
(chk-run ninf '(* neg pinf))
(chk-run neg '(* neg pos))
(chk-run zero '(* neg zero))
(chk-run pos '(* neg neg))
(chk-run pinf '(* neg ninf))
(chk-run nan '(* ninf nan))
(chk-run ninf '(* ninf pinf))
(chk-run ninf '(* ninf pos))
(chk-run nan '(* ninf zero))
(chk-run pinf '(* ninf neg))
(chk-run pinf '(* ninf ninf))
(chk-run nan '(/ nan nan))
(chk-run nan '(/ nan pinf))
(chk-run nan '(/ nan pos))
(chk-run nan '(/ nan zero))
(chk-run nan '(/ nan neg))
(chk-run nan '(/ nan ninf))
(chk-run nan '(/ pinf nan))
(chk-run nan '(/ pinf pinf))
(chk-run pinf '(/ pinf pos))
(chk-run pinf '(/ pinf zero))
(chk-run ninf '(/ pinf neg))
(chk-run nan '(/ pinf ninf))
(chk-run nan '(/ pos nan))
(chk-run zero '(/ pos pinf))
(chk-run pos '(/ pos pos))
(chk-run pinf '(/ pos zero))
(chk-run neg '(/ pos neg))
(chk-run zero '(/ pos ninf))
(chk-run nan '(/ zero nan))
(chk-run zero '(/ zero pinf))
(chk-run zero '(/ zero pos))
(chk-run nan '(/ zero zero))
(chk-run zero '(/ zero neg))
(chk-run zero '(/ zero ninf))
(chk-run nan '(/ neg nan))
(chk-run zero '(/ neg pinf))
(chk-run neg '(/ neg pos))
(chk-run ninf '(/ neg zero))
(chk-run pos '(/ neg neg))
(chk-run zero '(/ neg ninf))
(chk-run nan '(/ ninf nan))
(chk-run nan '(/ ninf pinf))
(chk-run ninf '(/ ninf pos))
(chk-run ninf '(/ ninf zero))
(chk-run pinf '(/ ninf neg))
(chk-run nan '(/ ninf ninf))
(chk-run nan '(expt nan nan))
(chk-run nan '(expt nan zero))
(chk-run nan '(expt nan pinf))
(chk-run nan '(expt nan 2))
(chk-run nan '(expt nan pos))
(chk-run nan '(expt nan 1/2))
(chk-run nan '(expt nan ninf))
(chk-run nan '(expt nan -2))
(chk-run nan '(expt nan neg))
(chk-run nan '(expt nan -1/2))
(chk-run nan '(expt zero nan))
(chk-run pos '(expt zero zero))
(chk-run zero '(expt zero pinf))
(chk-run zero '(expt zero 2))
(chk-run zero '(expt zero pos))
(chk-run zero '(expt zero 1/2))
(chk-run pinf '(expt zero ninf))
(chk-run pinf '(expt zero -2))
(chk-run pinf '(expt zero neg))
(chk-run pinf '(expt zero -1/2))
(chk-run nan '(expt pinf nan))
(chk-run nan '(expt pinf zero))
(chk-run pinf '(expt pinf pinf))
(chk-run pinf '(expt pinf 2))
(chk-run pinf '(expt pinf pos))
(chk-run pinf '(expt pinf 1/2))
(chk-run zero '(expt pinf ninf))
(chk-run zero '(expt pinf -2))
(chk-run zero '(expt pinf neg))
(chk-run zero '(expt pinf -1/2))
(chk-run nan '(expt 2 nan))
(chk-run pos '(expt 2 zero))
(chk-run pinf '(expt 2 pinf))
(chk-run 4 '(expt 2 2))
(chk-run 2 '(expt 2 pos))
(chk-run (sqrt 2) '(expt 2 1/2))
(chk-run zero '(expt 2 ninf))
(chk-run 1/4 '(expt 2 -2))
(chk-run 1/2 '(expt 2 neg))
(chk-run (sqrt 0.5) '(expt 2 -1/2))
(chk-run nan '(expt pos nan))
(chk-run pos '(expt pos zero))
(chk-run pos '(expt pos pinf))
(chk-run pos '(expt pos 2))
(chk-run pos '(expt pos pos))
(chk-run pos '(expt pos 1/2))
(chk-run pos '(expt pos ninf))
(chk-run pos '(expt pos -2))
(chk-run pos '(expt pos neg))
(chk-run pos '(expt pos -1/2))
(chk-run nan '(expt 1/2 nan))
(chk-run pos '(expt 1/2 zero))
(chk-run zero '(expt 1/2 pinf))
(chk-run 1/4 '(expt 1/2 2))
(chk-run 1/2 '(expt 1/2 pos))
(chk-run (sqrt 0.5) '(expt 1/2 1/2))
(chk-run pinf '(expt 1/2 ninf))
(chk-run 4 '(expt 1/2 -2))
(chk-run 2 '(expt 1/2 neg))
(chk-run (sqrt 2) '(expt 1/2 -1/2))
(chk-run nan '(expt ninf nan))
(chk-run nan '(expt ninf zero))
(chk-run nan '(expt ninf pinf))
(chk-run pinf '(expt ninf 2))
(chk-run ninf '(expt ninf pos))
(chk-run nan '(expt ninf 1/2))
(chk-run zero '(expt ninf ninf))
(chk-run zero '(expt ninf -2))
(chk-run zero '(expt ninf neg))
(chk-run zero '(expt ninf -1/2))
(chk-run nan '(expt -2 nan))
(chk-run pos '(expt -2 zero))
(chk-run nan '(expt -2 pinf))
(chk-run 4 '(expt -2 2))
(chk-run -2 '(expt -2 pos))
(chk-run fpnan '(expt -2 1/2)) ; should be complex
(chk-run zero '(expt -2 ninf))
(chk-run 1/4 '(expt -2 -2))
(chk-run -1/2 '(expt -2 neg))
(chk-run fpnan '(expt -2 -1/2)) ; should be complex
(chk-run nan '(expt neg nan))
(chk-run pos '(expt neg zero))
(chk-run nan '(expt neg pinf))
(chk-run pos '(expt neg 2))
(chk-run neg '(expt neg pos))
(chk-run fpnan '(expt neg 1/2)) ; should be complex
(chk-run nan '(expt neg ninf))
(chk-run pos '(expt neg -2))
(chk-run neg '(expt neg neg))
(chk-run fpnan '(expt neg -1/2)) ; should be complex
(chk-run nan '(expt -1/2 nan))
(chk-run pos '(expt -1/2 zero))
(chk-run zero '(expt -1/2 pinf))
(chk-run 1/4 '(expt -1/2 2))
(chk-run -1/2 '(expt -1/2 pos))
(chk-run fpnan '(expt -1/2 1/2)) ; should be complex
(chk-run nan '(expt -1/2 ninf))
(chk-run 4 '(expt -1/2 -2))
(chk-run -2 '(expt -1/2 neg))
(chk-run fpnan '(expt -1/2 -1/2)) ; should be complex
(chk-run nan '(max nan nan))
(chk-run nan '(max nan pinf))
(chk-run nan '(max nan pos))
(chk-run nan '(max nan zero))
(chk-run nan '(max nan neg))
(chk-run nan '(max nan ninf))
(chk-run nan '(max pinf nan))
(chk-run pinf '(max pinf pinf))
(chk-run pinf '(max pinf pos))
(chk-run pinf '(max pinf zero))
(chk-run pinf '(max pinf neg))
(chk-run pinf '(max pinf ninf))
(chk-run nan '(max pos nan))
(chk-run pinf '(max pos pinf))
(chk-run pos '(max pos pos))
(chk-run pos '(max pos zero))
(chk-run pos '(max pos neg))
(chk-run pos '(max pos ninf))
(chk-run nan '(max zero nan))
(chk-run pinf '(max zero pinf))
(chk-run pos '(max zero pos))
(chk-run zero '(max zero zero))
(chk-run zero '(max zero neg))
(chk-run zero '(max zero ninf))
(chk-run nan '(max neg nan))
(chk-run pinf '(max neg pinf))
(chk-run pos '(max neg pos))
(chk-run zero '(max neg zero))
(chk-run neg '(max neg neg))
(chk-run neg '(max neg ninf))
(chk-run nan '(max ninf nan))
(chk-run pinf '(max ninf pinf))
(chk-run pos '(max ninf pos))
(chk-run zero '(max ninf zero))
(chk-run neg '(max ninf neg))
(chk-run ninf '(max ninf ninf))
(chk-run nan '(min nan nan))
(chk-run nan '(min nan pinf))
(chk-run nan '(min nan pos))
(chk-run nan '(min nan zero))
(chk-run nan '(min nan neg))
(chk-run nan '(min nan ninf))
(chk-run nan '(min pinf nan))
(chk-run pinf '(min pinf pinf))
(chk-run pos '(min pinf pos))
(chk-run zero '(min pinf zero))
(chk-run neg '(min pinf neg))
(chk-run ninf '(min pinf ninf))
(chk-run nan '(min pos nan))
(chk-run pos '(min pos pinf))
(chk-run pos '(min pos pos))
(chk-run zero '(min pos zero))
(chk-run neg '(min pos neg))
(chk-run ninf '(min pos ninf))
(chk-run nan '(min zero nan))
(chk-run zero '(min zero pinf))
(chk-run zero '(min zero pos))
(chk-run zero '(min zero zero))
(chk-run neg '(min zero neg))
(chk-run ninf '(min zero ninf))
(chk-run nan '(min neg nan))
(chk-run neg '(min neg pinf))
(chk-run neg '(min neg pos))
(chk-run neg '(min neg zero))
(chk-run neg '(min neg neg))
(chk-run ninf '(min neg ninf))
(chk-run nan '(min ninf nan))
(chk-run ninf '(min ninf pinf))
(chk-run ninf '(min ninf pos))
(chk-run ninf '(min ninf zero))
(chk-run ninf '(min ninf neg))
(chk-run ninf '(min ninf ninf))
; check floating-point arithmetic
(define nan +nan.0)
(define pinf +inf.0)
(define ninf -inf.0)
(define zero 0.0)
(define pos 1.0)
(define neg -1.0)
(define fpnan (sqrt -1.0))
(define ptwo 2.0)
(define ntwo -2.0)
(define phalf 0.5)
(define nhalf -0.5)
(define pfour 4.0)
(define nfour -4.0)
(define pqtr 0.25)
(define nqtr -0.25)
(chk-run nan '(+ nan nan))
(chk-run nan '(+ nan pinf))
(chk-run nan '(+ nan pos))
(chk-run nan '(+ nan zero))
(chk-run nan '(+ nan neg))
(chk-run nan '(+ nan ninf))
(chk-run nan '(+ pinf nan))
(chk-run pinf '(+ pinf pinf))
(chk-run pinf '(+ pinf pos))
(chk-run pinf '(+ pinf zero))
(chk-run pinf '(+ pinf neg))
(chk-run nan '(+ pinf ninf))
(chk-run nan '(+ pos nan))
(chk-run pinf '(+ pos pinf))
(chk-run ptwo '(+ pos pos))
(chk-run pos '(+ pos zero))
(chk-run zero '(+ pos neg))
(chk-run ninf '(+ pos ninf))
(chk-run nan '(+ zero nan))
(chk-run pinf '(+ zero pinf))
(chk-run pos '(+ zero pos))
(chk-run zero '(+ zero zero))
(chk-run neg '(+ zero neg))
(chk-run ninf '(+ zero ninf))
(chk-run nan '(+ neg nan))
(chk-run pinf '(+ neg pinf))
(chk-run zero '(+ neg pos))
(chk-run neg '(+ neg zero))
(chk-run ntwo '(+ neg neg))
(chk-run ninf '(+ neg ninf))
(chk-run nan '(+ ninf nan))
(chk-run nan '(+ ninf pinf))
(chk-run ninf '(+ ninf pos))
(chk-run ninf '(+ ninf zero))
(chk-run ninf '(+ ninf neg))
(chk-run ninf '(+ ninf ninf))
(chk-run nan '(- nan nan))
(chk-run nan '(- nan pinf))
(chk-run nan '(- nan pos))
(chk-run nan '(- nan zero))
(chk-run nan '(- nan neg))
(chk-run nan '(- nan ninf))
(chk-run nan '(- pinf nan))
(chk-run nan '(- pinf pinf))
(chk-run pinf '(- pinf pos))
(chk-run pinf '(- pinf zero))
(chk-run pinf '(- pinf neg))
(chk-run pinf '(- pinf ninf))
(chk-run nan '(- pos nan))
(chk-run ninf '(- pos pinf))
(chk-run zero '(- pos pos))
(chk-run pos '(- pos zero))
(chk-run ptwo '(- pos neg))
(chk-run pinf '(- pos ninf))
(chk-run nan '(- zero nan))
(chk-run ninf '(- zero pinf))
(chk-run neg '(- zero pos))
(chk-run zero '(- zero zero))
(chk-run pos '(- zero neg))
(chk-run pinf '(- zero ninf))
(chk-run nan '(- neg nan))
(chk-run ninf '(- neg pinf))
(chk-run ntwo '(- neg pos))
(chk-run neg '(- neg zero))
(chk-run zero '(- neg neg))
(chk-run pinf '(- neg ninf))
(chk-run nan '(- ninf nan))
(chk-run ninf '(- ninf pinf))
(chk-run ninf '(- ninf pos))
(chk-run ninf '(- ninf zero))
(chk-run ninf '(- ninf neg))
(chk-run nan '(- ninf ninf))
(chk-run nan '(* nan nan))
(chk-run nan '(* nan pinf))
(chk-run nan '(* nan pos))
(chk-run nan '(* nan zero))
(chk-run nan '(* nan neg))
(chk-run nan '(* nan ninf))
(chk-run nan '(* pinf nan))
(chk-run pinf '(* pinf pinf))
(chk-run pinf '(* pinf pos))
(chk-run nan '(* pinf zero))
(chk-run ninf '(* pinf neg))
(chk-run ninf '(* pinf ninf))
(chk-run nan '(* pos nan))
(chk-run pinf '(* pos pinf))
(chk-run pos '(* pos pos))
(chk-run zero '(* pos zero))
(chk-run neg '(* pos neg))
(chk-run ninf '(* pos ninf))
(chk-run nan '(* zero nan))
(chk-run nan '(* zero pinf))
(chk-run zero '(* zero pos))
(chk-run zero '(* zero zero))
(chk-run zero '(* zero neg))
(chk-run nan '(* zero ninf))
(chk-run nan '(* neg nan))
(chk-run ninf '(* neg pinf))
(chk-run neg '(* neg pos))
(chk-run zero '(* neg zero))
(chk-run pos '(* neg neg))
(chk-run pinf '(* neg ninf))
(chk-run nan '(* ninf nan))
(chk-run ninf '(* ninf pinf))
(chk-run ninf '(* ninf pos))
(chk-run nan '(* ninf zero))
(chk-run pinf '(* ninf neg))
(chk-run pinf '(* ninf ninf))
(chk-run nan '(/ nan nan))
(chk-run nan '(/ nan pinf))
(chk-run nan '(/ nan pos))
(chk-run nan '(/ nan zero))
(chk-run nan '(/ nan neg))
(chk-run nan '(/ nan ninf))
(chk-run nan '(/ pinf nan))
(chk-run nan '(/ pinf pinf))
(chk-run pinf '(/ pinf pos))
(chk-run pinf '(/ pinf zero))
(chk-run ninf '(/ pinf neg))
(chk-run nan '(/ pinf ninf))
(chk-run nan '(/ pos nan))
(chk-run zero '(/ pos pinf))
(chk-run pos '(/ pos pos))
(chk-run pinf '(/ pos zero))
(chk-run neg '(/ pos neg))
(chk-run zero '(/ pos ninf))
(chk-run nan '(/ zero nan))
(chk-run zero '(/ zero pinf))
(chk-run zero '(/ zero pos))
(chk-run nan '(/ zero zero))
(chk-run zero '(/ zero neg))
(chk-run zero '(/ zero ninf))
(chk-run nan '(/ neg nan))
(chk-run zero '(/ neg pinf))
(chk-run neg '(/ neg pos))
(chk-run ninf '(/ neg zero))
(chk-run pos '(/ neg neg))
(chk-run zero '(/ neg ninf))
(chk-run nan '(/ ninf nan))
(chk-run nan '(/ ninf pinf))
(chk-run ninf '(/ ninf pos))
(chk-run ninf '(/ ninf zero))
(chk-run pinf '(/ ninf neg))
(chk-run nan '(/ ninf ninf))
(chk-run nan '(expt nan nan))
(chk-run nan '(expt nan zero))
(chk-run nan '(expt nan pinf))
(chk-run nan '(expt nan ptwo))
(chk-run nan '(expt nan pos))
(chk-run nan '(expt nan phalf))
(chk-run nan '(expt nan ninf))
(chk-run nan '(expt nan ntwo))
(chk-run nan '(expt nan neg))
(chk-run nan '(expt nan nhalf))
(chk-run nan '(expt zero nan))
(chk-run 1 '(expt zero zero))
(chk-run 0 '(expt zero pinf))
(chk-run 0 '(expt zero ptwo))
(chk-run 0 '(expt zero pos))
(chk-run 0 '(expt zero phalf))
(chk-run 1/0 '(expt zero ninf))
(chk-run 1/0 '(expt zero ntwo))
(chk-run 1/0 '(expt zero neg))
(chk-run 1/0 '(expt zero nhalf))
(chk-run nan '(expt pinf nan))
(chk-run nan '(expt pinf zero))
(chk-run pinf '(expt pinf pinf))
(chk-run pinf '(expt pinf ptwo))
(chk-run pinf '(expt pinf pos))
(chk-run pinf '(expt pinf phalf))
(chk-run 0 '(expt pinf ninf))
(chk-run zero '(expt pinf ntwo))
(chk-run zero '(expt pinf neg))
(chk-run zero '(expt pinf nhalf))
(chk-run nan '(expt ptwo nan))
(chk-run 1 '(expt ptwo zero))
(chk-run pinf '(expt ptwo pinf))
(chk-run pfour '(expt ptwo ptwo))
(chk-run ptwo '(expt ptwo pos))
(chk-run (sqrt ptwo) '(expt ptwo phalf))
(chk-run 0 '(expt ptwo ninf))
(chk-run pqtr '(expt ptwo ntwo))
(chk-run phalf '(expt ptwo neg))
(chk-run (sqrt 0.5) '(expt ptwo nhalf))
(chk-run nan '(expt pos nan))
(chk-run 1 '(expt pos zero))
(chk-run pos '(expt pos pinf))
(chk-run pos '(expt pos ptwo))
(chk-run pos '(expt pos pos))
(chk-run pos '(expt pos phalf))
(chk-run pos '(expt pos ninf))
(chk-run pos '(expt pos ntwo))
(chk-run pos '(expt pos neg))
(chk-run pos '(expt pos nhalf))
(chk-run nan '(expt phalf nan))
(chk-run 1 '(expt phalf zero))
(chk-run 0 '(expt phalf pinf))
(chk-run pqtr '(expt phalf ptwo))
(chk-run phalf '(expt phalf pos))
(chk-run (sqrt 0.5) '(expt phalf phalf))
(chk-run pinf '(expt phalf ninf))
(chk-run pfour '(expt phalf ntwo))
(chk-run ptwo '(expt phalf neg))
(chk-run (sqrt ptwo) '(expt phalf nhalf))
(chk-run nan '(expt ninf nan))
(chk-run nan '(expt ninf zero))
(chk-run nan '(expt ninf pinf))
(chk-run pinf '(expt ninf ptwo))
(chk-run ninf '(expt ninf pos))
(chk-run nan '(expt ninf phalf))
(chk-run 0 '(expt ninf ninf))
(chk-run zero '(expt ninf ntwo))
(chk-run zero '(expt ninf neg))
(chk-run zero '(expt ninf nhalf))
(chk-run nan '(expt ntwo nan))
(chk-run 1 '(expt ntwo zero))
(chk-run nan '(expt ntwo pinf))
(chk-run pfour '(expt ntwo ptwo))
(chk-run ntwo '(expt ntwo pos))
(chk-run fpnan '(expt ntwo phalf)) ; should be complex
(chk-run 0 '(expt ntwo ninf))
(chk-run pqtr '(expt ntwo ntwo))
(chk-run nhalf '(expt ntwo neg))
(chk-run fpnan '(expt ntwo nhalf)) ; should be complex
(chk-run nan '(expt neg nan))
(chk-run 1 '(expt neg zero))
(chk-run nan '(expt neg pinf))
(chk-run pos '(expt neg ptwo))
(chk-run neg '(expt neg pos))
(chk-run fpnan '(expt neg phalf)) ; should be complex
(chk-run nan '(expt neg ninf))
(chk-run pos '(expt neg ntwo))
(chk-run neg '(expt neg neg))
(chk-run fpnan '(expt neg nhalf)) ; should be complex
(chk-run nan '(expt nhalf nan))
(chk-run 1 '(expt nhalf zero))
(chk-run 0 '(expt nhalf pinf))
(chk-run pqtr '(expt nhalf ptwo))
(chk-run nhalf '(expt nhalf pos))
(chk-run fpnan '(expt nhalf phalf)) ; should be complex
(chk-run nan '(expt nhalf ninf))
(chk-run pfour '(expt nhalf ntwo))
(chk-run ntwo '(expt nhalf neg))
(chk-run fpnan '(expt nhalf nhalf)) ; should be complex
(chk-run nan '(max nan nan))
(chk-run nan '(max nan pinf))
(chk-run nan '(max nan pos))
(chk-run nan '(max nan zero))
(chk-run nan '(max nan neg))
(chk-run nan '(max nan ninf))
(chk-run nan '(max pinf nan))
(chk-run pinf '(max pinf pinf))
(chk-run pinf '(max pinf pos))
(chk-run pinf '(max pinf zero))
(chk-run pinf '(max pinf neg))
(chk-run pinf '(max pinf ninf))
(chk-run nan '(max pos nan))
(chk-run pinf '(max pos pinf))
(chk-run pos '(max pos pos))
(chk-run pos '(max pos zero))
(chk-run pos '(max pos neg))
(chk-run pos '(max pos ninf))
(chk-run nan '(max zero nan))
(chk-run pinf '(max zero pinf))
(chk-run pos '(max zero pos))
(chk-run zero '(max zero zero))
(chk-run zero '(max zero neg))
(chk-run zero '(max zero ninf))
(chk-run nan '(max neg nan))
(chk-run pinf '(max neg pinf))
(chk-run pos '(max neg pos))
(chk-run zero '(max neg zero))
(chk-run neg '(max neg neg))
(chk-run neg '(max neg ninf))
(chk-run nan '(max ninf nan))
(chk-run pinf '(max ninf pinf))
(chk-run pos '(max ninf pos))
(chk-run zero '(max ninf zero))
(chk-run neg '(max ninf neg))
(chk-run ninf '(max ninf ninf))
(chk-run nan '(min nan nan))
(chk-run nan '(min nan pinf))
(chk-run nan '(min nan pos))
(chk-run nan '(min nan zero))
(chk-run nan '(min nan neg))
(chk-run nan '(min nan ninf))
(chk-run nan '(min pinf nan))
(chk-run pinf '(min pinf pinf))
(chk-run pos '(min pinf pos))
(chk-run zero '(min pinf zero))
(chk-run neg '(min pinf neg))
(chk-run ninf '(min pinf ninf))
(chk-run nan '(min pos nan))
(chk-run pos '(min pos pinf))
(chk-run pos '(min pos pos))
(chk-run zero '(min pos zero))
(chk-run neg '(min pos neg))
(chk-run ninf '(min pos ninf))
(chk-run nan '(min zero nan))
(chk-run zero '(min zero pinf))
(chk-run zero '(min zero pos))
(chk-run zero '(min zero zero))
(chk-run neg '(min zero neg))
(chk-run ninf '(min zero ninf))
(chk-run nan '(min neg nan))
(chk-run neg '(min neg pinf))
(chk-run neg '(min neg pos))
(chk-run neg '(min neg zero))
(chk-run neg '(min neg neg))
(chk-run ninf '(min neg ninf))
(chk-run nan '(min ninf nan))
(chk-run ninf '(min ninf pinf))
(chk-run ninf '(min ninf pos))
(chk-run ninf '(min ninf zero))
(chk-run ninf '(min ninf neg))
(chk-run ninf '(min ninf ninf))
(chk-run #t '(= (atan 1.0 2.0) (atan 1/2)))
(chk-run #t '(/= (atan -1.0 -2.0) (atan 1/2)))
(chk-run '(0 0) '(exact-integer-sqrt 0))
(chk-run '(1 0) '(exact-integer-sqrt 1))
(chk-run '(3 1) '(exact-integer-sqrt 10))
(chk-run '(10 0) '(exact-integer-sqrt 100))
(chk-run '(111111110611 24691096802)
'(exact-integer-sqrt 12345678901234567890123))
(chk-run (list (expt 101 51) 101)
'(exact-integer-sqrt (+ (expt 101 102) 101)))
(chk-run '(0 0) '(exact-integer-cbrt 0))
(chk-run '(1 0) '(exact-integer-cbrt 1))
(chk-run '(2 2) '(exact-integer-cbrt 10))
(chk-run '(10 0) '(exact-integer-cbrt 1000))
(chk-run '(23112042 655451715112035)
'(exact-integer-cbrt 12345678901234567890123))
(chk-run '(-23112042 -655451715112035)
'(exact-integer-cbrt -12345678901234567890123))
(chk-run (list (expt 101 51) 101)
'(exact-integer-cbrt (+ (expt 101 153) 101)))
(define natural-numbers
(letrec ((next
(lambda (n)
(cons n (delay (next (+ n 1)))))))
(next 1)))
(chk-run '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)
'(stream-head natural-numbers 20))
(chk-run '(2 4 6 8 10 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40)
'(stream-head (stream-map (lambda (n) (* 2 n)) natural-numbers) 20))
; check that a promise is not redeemed more than once
; this is taken pretty directly from R6RS
(define promise-count 0)
(define promise
(delay (begin (set! promise-count (+ promise-count 1))
(if (>= promise-count promise-target)
promise-count
(force promise)))))
(define promise-target 5)
(chk-run 5 '(force promise))
(set! promise-target 10)
(chk-run 5 '(force promise))
; define and test some macros
; 3-way numeric if macro -- depending on whether test-value is negative,
; zero, or positive, evaluate one of three forms and return its value.
; It's /not/ kosher to evaluate all three and only return the correct one.
(begin
; This tests how many times everything gets evaluated
(define probe 0)
; This is what actually gets tested... the wrapper below is just to
; diddle the value of probe
(define test-val -1)
(define n-action (lambda () (set! probe (+ probe 1)) "negative!"))
(define z-action (lambda () (set! probe (+ probe 10)) "zero!"))
(define p-action (lambda () (set! probe (+ probe 100)) "positive!"))
; The value returned from this determines which of the three branches is chosen
(define test-value (lambda () (set! probe (+ probe 1000)) test-val))
(defmacro (test-numeric-if tval ifn ifz ifp)
(let ((nit (gensym)))
`(let ((,nit ,tval))
(if (number? ,nit)
(if (negative? ,nit)
,ifn
(if (positive? ,nit)
,ifp
,ifz))))))
(set! probe 0)
(set! test-val -1)
(chk-run "negative!"
'(test-numeric-if (test-value) (n-action) (z-action) (p-action)))
(chk-run 1001 probe)
(set! probe 0)
(set! test-val 0)
(chk-run "zero!"
'(test-numeric-if (test-value) (n-action) (z-action) (p-action)))
(chk-run 1010 probe)
(set! probe 0)
(set! test-val 1)
(chk-run "positive!"
'(test-numeric-if (test-value) (n-action) (z-action) (p-action)))
(chk-run 1100 probe))
(define i 0)
(define j 0)
(define ret '())
(chk-run 10 '(while (< i 10) (set! i (+ i 1)) (set! ret (cons i ret))))
(chk-run '(10 9 8 7 6 5 4 3 2 1) 'ret)
(set! i 0)
(set! ret '())
(while (< i 4)
(set! j 0)
(while (< j 4)
(set! j (+ j 1))
(set! ret (cons (cons i j) ret)))
(set! i (+ i 1)))
; Note we increment j before accumulating into ret, but we
; increment i after; thus the dotted-pairs aren't symmetric
(chk-run '((3 . 4) (3 . 3) (3 . 2) (3 . 1)
(2 . 4) (2 . 3) (2 . 2) (2 . 1)
(1 . 4) (1 . 3) (1 . 2) (1 . 1)
(0 . 4) (0 . 3) (0 . 2) (0 . 1)) 'ret)
(set! i 0)
(chk-run 1 '(do-while #f (set! i (+ i 1))))
(chk-run 1 'i)
(set! i 3)
(chk-run 8 '(until (> i 10) (set! i (+ i 1))))
(chk-run 11 'i)
(set! i 20)
(chk-run 1 '(do-until (> i 10) (set! i (+ i 1))))
(chk-run 21 'i)
; A "swap" macro
(begin
(defmacro (test-swap var1 var2)
(let ((vs (gensym)))
`(let ((,vs ,var1))
(set! ,var1 ,var2)
(set! ,var2 ,vs))))
(define val1 0)
(define val2 1)
(chk-run #t '(and (eqv? val1 0) (eqv? val2 1)))
(test-swap val1 val2)
(chk-run #t '(and (eqv? val1 1) (eqv? val2 0)))
(test-swap val1 val2)
(chk-run #t '(and (eqv? val1 0) (eqv? val2 1))))
; A "let" macro... tests are exactly the same as for the actual "let" above
(begin
(defmacro (test-let bindings . body)
`((lambda ,(map car bindings) ,@body) ,@(map cadr bindings)))
(chk-run 42 '(test-let ((x 23)) (set! x 42) x))
(chk-run 35 '(test-let ((x 2) (y 3))
(test-let ((x 7) (z (+ x y)))
(* z x)))))
; Summarize these results
(write-string "\ntotal tests run: "
(number->string n-tests)
"\ntests failed: "
(number->string n-fails)
#\linefeed)
(write-string
"\nThe next series of tests are going to check interactions with\n"
"the outside world. Some of these are not so easy to check, so haskeem\n"
"will just print the results and assume that they are good. If you\n"
"re-run the test in verbose mode by adding '-v' to the command line,\n"
"you will have a chance to verify whether they are reasonable.\n\n")
(catch-exceptions (chk-query "your home directory" '(get-environment "HOME")))
(catch-exceptions (chk-query "the current local time" '(localtime)))
(catch-exceptions
(chk-query "the current local time" '(localtime (epochtime))))
(catch-exceptions (chk-query "the current UTC time" '(UTCtime)))
(catch-exceptions (chk-query "the current UTC time" '(UTCtime (epochtime))))
(catch-exceptions (chk-query "current directory" '(get-current-directory)))
; these need to be global because apparently eval isn't picking them
; up if I define them via let inside do-dir-tests... which is right
; according to the R6RS, but ought not be the case in my version,
; due to eval being a special form: it should have access to the
; current environment, in which these should be bound. TODO: check that!
(define test-dir1 "scratch-dir")
(define test-file1 (string-join-by "/" (list test-dir1 "testfile1")))
(define test-file2 (string-join-by "/" (list test-dir1 "testfile2")))
(define test-dir2 (string-join-by "/" (list test-dir1 "subdir")))
(define line1 "This is a test")
(define line2 "no")
(define port 0)
(define (ssort lst) (list-sort string<? lst))
(define (do-dir-tests)
(write-string
#\linefeed
"Some of the tests involving directory and file creation\n"
"and removal may fail if run on an NFS-mounted filesystem.\n"
"If you see weird files like '.nfs000000000029a82600000001'\n"
"and an exception while removing the test directory, that\n"
"is the likely cause. Don't Panic!\n"
#\linefeed)
(catch-exceptions (chk-run #f '(directory-exists? test-dir1)))
(catch-exceptions (chk-run #t '(create-directory test-dir1)))
(catch-exceptions (chk-run #t '(create-directory test-dir2)))
(catch-exceptions
(chk-run (ssort '("." ".." "subdir")) '(ssort (read-directory test-dir1))))
(catch-exceptions (chk-run #t '(remove-directory test-dir2)))
(catch-exceptions (chk-run #f '(file-exists? test-file1)))
(set! port (open-output-file test-file1))
(catch-exceptions (chk-run #t '(file-exists? test-file1)))
(write-string port line1 #\linefeed)
(close-port port)
(catch-exceptions (chk-run #t '(rename-file test-file1 test-file2)))
(catch-exceptions (chk-run (ssort '("." ".." "testfile2"))
'(ssort (read-directory test-dir1))))
(catch-exceptions (chk-run #f '(file-exists? test-file1)))
(catch-exceptions (chk-run #t '(file-exists? test-file2)))
(set! port (open-input-file test-file2))
(set! line2 (read-line port))
(catch-exceptions (chk-run #t '(string=? line1 line2)))
(catch-exceptions (chk-run #t '(remove-file test-file2)))
(catch-exceptions (chk-run #f '(file-exists? test-file2)))
(catch-exceptions (chk-run (ssort '("." ".."))
'(ssort (read-directory test-dir1))))
(catch-exceptions (chk-run #t '(set-current-directory test-dir1)))
(catch-exceptions (chk-query "test directory" '(get-current-directory)))
(catch-exceptions (chk-run #t '(set-current-directory "..")))
(catch-exceptions (chk-run #t '(remove-directory test-dir1)))
(run-command (string-join-by " " "/bin/rm -rf" test-dir1)))
(if (directory-exists? test-dir1)
(write-string "\nSkipping file and directory I/O tests,\n"
"test directory \""
test-dir1
"\" seems to already exist...\n")
(do-dir-tests))
(chk-run '((1 4 a d) (2 5 b e) (3 6 c f))
'(begin (define acc '())
(for-each (lambda v (set! acc (cons v acc)))
'(1 2 3)
'(4 5 6)
'(a b c)
'(d e f))
(reverse acc)))
(chk-run '((1) (2)) '(begin (define acc '())
(for-all-combinations
(lambda v (set! acc (cons v acc)))
'((1 2)))
(reverse acc)))
(chk-run '((1) (2)) '(begin (define acc '())
(for-all-combinations
(lambda v (set! acc (cons v acc)))
'() '(1 2))
(reverse acc)))
(chk-run '(((1 2))) '(begin (define acc '())
(for-all-combinations
(lambda v (set! acc (cons v acc)))
'(((1 2))))
(reverse acc)))
(chk-run '(((1 2))) '(begin (define acc '())
(for-all-combinations
(lambda v (set! acc (cons v acc)))
'() '((1 2)))
(reverse acc)))
(chk-run '((1 a) (1 b) (2 a) (2 b)) '(begin (define acc '())
(for-all-combinations
(lambda v (set! acc (cons v acc)))
'((1 2) (a b)))
(reverse acc)))
(chk-run '((1 a) (1 b) (2 a) (2 b)) '(begin (define acc '())
(for-all-combinations
(lambda v (set! acc (cons v acc)))
'() '(1 2) '(a b))
(reverse acc)))
(chk-run '(((1 2)) ((a b))) '(begin (define acc '())
(for-all-combinations
(lambda v (set! acc (cons v acc)))
'(((1 2) (a b))))
(reverse acc)))
(chk-run '(((1 2)) ((a b))) '(begin (define acc '())
(for-all-combinations
(lambda v (set! acc (cons v acc)))
'() '((1 2) (a b)))
(reverse acc)))
(chk-run '((1 a 4) (1 a 5) (1 b 4) (1 b 5) (2 a 4) (2 a 5) (2 b 4) (2 b 5))
'(begin (define acc '())
(for-all-combinations (lambda v (set! acc (cons v acc)))
'((1 2) (a b) (4 5)))
(reverse acc)))
(chk-run '((1 a 4) (1 a 5) (1 b 4) (1 b 5) (2 a 4) (2 a 5) (2 b 4) (2 b 5))
'(begin (define acc '())
(for-all-combinations (lambda v (set! acc (cons v acc)))
'() '(1 2) '(a b) '(4 5))
(reverse acc)))
(chk-run "#b0.0" '(number->string 1/4 2 1))
(chk-run "#b0.01" '(number->string 1/4 2 2))
(chk-run "#b0.010" '(number->string 1/4 2 3))
(chk-run "#b0.0100" '(number->string 1/4 2 4))
(chk-run "#o0.2" '(number->string 1/4 8 1))
(chk-run "#o0.20" '(number->string 1/4 8 2))
(chk-run "#o0.200" '(number->string 1/4 8 3))
(chk-run "#o0.2000" '(number->string 1/4 8 4))
(chk-run "0.2" '(number->string 1/4 10 1))
(chk-run "0.25" '(number->string 1/4 10 2))
(chk-run "0.250" '(number->string 1/4 10 3))
(chk-run "0.2500" '(number->string 1/4 10 4))
(chk-run "#x0.4" '(number->string 1/4 16 1))
(chk-run "#x0.40" '(number->string 1/4 16 2))
(chk-run "#x0.400" '(number->string 1/4 16 3))
(chk-run "#x0.4000" '(number->string 1/4 16 4))
(chk-run "0.3" '(number->string 1/3 10 1))
(chk-run "0.33" '(number->string 1/3 10 2))
(chk-run "0.333" '(number->string 1/3 10 3))
(chk-run "0.3333" '(number->string 1/3 10 4))
(chk-run "0.7" '(number->string 2/3 10 1))
(chk-run "0.67" '(number->string 2/3 10 2))
(chk-run "0.667" '(number->string 2/3 10 3))
(chk-run "0.6667" '(number->string 2/3 10 4))
(chk-run "1.0" '(number->string 999/1000 10 1))
(chk-run "1.00" '(number->string 999/1000 10 2))
(chk-run "0.999" '(number->string 999/1000 10 3))
(chk-run "0.9990" '(number->string 999/1000 10 4))
(chk-run "0.99900" '(number->string 999/1000 10 5))
(chk-run "#b-0.0" '(number->string -1/4 2 1))
(chk-run "#b-0.01" '(number->string -1/4 2 2))
(chk-run "#b-0.010" '(number->string -1/4 2 3))
(chk-run "#b-0.0100" '(number->string -1/4 2 4))
(chk-run "#o-0.2" '(number->string -1/4 8 1))
(chk-run "#o-0.20" '(number->string -1/4 8 2))
(chk-run "#o-0.200" '(number->string -1/4 8 3))
(chk-run "#o-0.2000" '(number->string -1/4 8 4))
(chk-run "-0.2" '(number->string -1/4 10 1))
(chk-run "-0.25" '(number->string -1/4 10 2))
(chk-run "-0.250" '(number->string -1/4 10 3))
(chk-run "-0.2500" '(number->string -1/4 10 4))
(chk-run "#x-0.4" '(number->string -1/4 16 1))
(chk-run "#x-0.40" '(number->string -1/4 16 2))
(chk-run "#x-0.400" '(number->string -1/4 16 3))
(chk-run "#x-0.4000" '(number->string -1/4 16 4))
(chk-run "-0.3" '(number->string -1/3 10 1))
(chk-run "-0.33" '(number->string -1/3 10 2))
(chk-run "-0.333" '(number->string -1/3 10 3))
(chk-run "-0.3333" '(number->string -1/3 10 4))
(chk-run "-0.7" '(number->string -2/3 10 1))
(chk-run "-0.67" '(number->string -2/3 10 2))
(chk-run "-0.667" '(number->string -2/3 10 3))
(chk-run "-0.6667" '(number->string -2/3 10 4))
(chk-run "-1.0" '(number->string -999/1000 10 1))
(chk-run "-1.00" '(number->string -999/1000 10 2))
(chk-run "-0.999" '(number->string -999/1000 10 3))
(chk-run "-0.9990" '(number->string -999/1000 10 4))
(chk-run "-0.99900" '(number->string -999/1000 10 5))
; convert the number to a string with the inner (number->string);
; convert that back to a number with (string->number) and find the
; difference between that and the original number: it should be
; no more than 0.5 unit in the last digit -- actually, it seems that
; due to finiteness of FP arithmetic it can be just a smidgen larger
; than 0.5 ULP
(define (chk-reversible val base prec)
(set! n-tests (+ n-tests 1))
(let* ((vs (number->string val base prec))
(diff (abs (- val (string->number vs))))
(ddif (* (expt base prec) diff)))
(if (> ddif 0.5000000001)
(begin (set! n-fails (+ n-fails 1))
(write-string "reversible failed! "
(number->string val)
" -> " vs
" ULPdiff = "
(number->string ddif)
#\linefeed)))))
(write-string "\nNow test number/string conversions... "
"this'll take a bit longer\n\n")
(do ((j 1 (+ j 13)))
((> j 2000) #t)
(do ((i 1 (+ i 21)))
((> i 5000) #t)
(chk-reversible (/ i j) 10 2)))
(write-string "Again, this time with floating-point numbers\n\n")
(do ((j 1 (+ j 17)))
((> j 2000) #t)
(do ((i 1 (+ i 19)))
((> i 5000) #t)
(chk-reversible (/ (+ i 0.0) (+ j 0.0)) 10 2)))
(chk-run 3 '(ilog (- (expt 2 4) 1)))
(chk-run 4 '(ilog (expt 2 4)))
(chk-run 11 '(ilog (- (expt 2 12) 1)))
(chk-run 12 '(ilog (expt 2 12)))
(chk-run 26 '(ilog (- (expt 2 27) 1)))
(chk-run 27 '(ilog (expt 2 27)))
(chk-run 1242 '(ilog (- (expt 2 1243) 1)))
(chk-run 1243 '(ilog (expt 2 1243)))
(define mynum 1.2345)
; If this is true, we'll see 1.235 with rounding in two places below,
; and 1.2345000000000002e0 without rounding
(define mynumtest? (< 12345 (* mynum 10000)))
(chk-run (if mynumtest? "1.2345000000000002e0" "1.2345e0")
'(number->string mynum))
(chk-run (if mynumtest? "1.2345000000000002e0" "1.2345e0")
'(number->string mynum 10))
(chk-run "1.2345" '(number->string mynum 10 4))
(chk-run "1.23450" '(number->string mynum 10 5))
(chk-run "1.234500" '(number->string mynum 10 6))
(chk-run (if mynumtest? "1.235" "1.234") '(number->string mynum 10 3))
(chk-run "1.23" '(number->string mynum 10 2))
(chk-run "1.2" '(number->string mynum 10 1))
(chk-run "1." '(number->string mynum 10 0))
(chk-run "1.2e0" '(number->string mynum 10 -1))
(chk-run "1.23e0" '(number->string mynum 10 -2))
(chk-run (if mynumtest? "1.235e0" "1.234e0") '(number->string mynum 10 -3))
(chk-run "1.2345e0" '(number->string mynum 10 -4))
(chk-run "1.2345e0" '(number->string 12345e-4 10 -4))
(chk-run "1.2345" '(number->string 12345/10000 10 4))
(chk-run "1.2345e0" '(number->string 12345/10000 10 -4))
; Same as 1.2345 decimal, but in the above when we read in 1.2345 the last
; four binary digits get turned into 1110 which doesn't quite get turned
; back into 1.2345; that leads to the four "might fail" cases above.
(set! mynum #b1.0011110000001000001100010010011011101001011110001101)
(chk-run "1.2345e0" '(number->string mynum))
(chk-run "1.2345e0" '(number->string mynum 10))
(chk-run "1.2345" '(number->string mynum 10 4))
(chk-run "1.23450" '(number->string mynum 10 5))
(chk-run "1.234500" '(number->string mynum 10 6))
(chk-run "1.234" '(number->string mynum 10 3))
(chk-run "1.23" '(number->string mynum 10 2))
(chk-run "1.2" '(number->string mynum 10 1))
(chk-run "1." '(number->string mynum 10 0))
(chk-run "1.2e0" '(number->string mynum 10 -1))
(chk-run "1.23e0" '(number->string mynum 10 -2))
(chk-run "1.234e0" '(number->string mynum 10 -3))
(chk-run "1.2345e0" '(number->string mynum 10 -4))
(chk-run "1.0" '(number->string 0.99999 10 1))
(chk-run "1.00" '(number->string 0.99999 10 2))
(chk-run "1.000" '(number->string 0.99999 10 3))
(chk-run "1.0000" '(number->string 0.99999 10 4))
(chk-run "0.99999" '(number->string 0.99999 10 5))
(chk-run "0.999990" '(number->string 0.99999 10 6))
(chk-run "1.0e0" '(number->string 0.99999 10 -1))
(chk-run "1.00e0" '(number->string 0.99999 10 -2))
(chk-run "1.000e0" '(number->string 0.99999 10 -3))
(chk-run "9.9999e-1" '(number->string 0.99999 10 -4))
(chk-run "9.99990e-1" '(number->string 0.99999 10 -5))
(chk-run "9.999900e-1" '(number->string 0.99999 10 -6))
; check that we can get lots of digits of rational numbers, more than what a
; floating-point number could generate: #d1.45 is non-terminating in base 16:
; it is #x1.7333333... so it's easy to know what the result ought to be
(chk-run "#x1.7" '(number->string 145/100 16 1))
(chk-run "#x1.73" '(number->string 145/100 16 2))
(chk-run "#x1.733" '(number->string 145/100 16 3))
(chk-run "#x1.7333" '(number->string 145/100 16 4))
(chk-run "#x1.73333" '(number->string 145/100 16 5))
(chk-run "#x1.733333333333333" '(number->string 145/100 16 15))
(chk-run "#x1.7333333333333333333333333" '(number->string 145/100 16 25))
(chk-run "#x1.733333333333333333333333333333333333333333333333333333333333"
'(number->string 145/100 16 60))
(chk-run "#x1.733333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333"
'(number->string 145/100 16 120))
; and a larger number; comparison value was generated by a separate program
(chk-run "9.990020930143845079440327643300335909804291390541816917715293e30102"
'(number->string (expt 2 100000) 10 -60))
; check a couple of bit manipulations
(chk-run 1 '(bits-shift 1 0))
(chk-run 2 '(bits-shift 1 1))
(chk-run 4 '(bits-shift 1 2))
(chk-run 8 '(bits-shift 1 3))
(chk-run 65536 '(bits-shift 1 16))
(chk-run (expt 2 128) '(bits-shift 1 128))
(chk-run (expt 2 1000) '(bits-shift 1 1000))
(chk-run 32768 '(bits-shift 65536 -1))
(chk-run 16384 '(bits-shift 65536 -2))
(chk-run 2 '(bits-shift 65536 -15))
(chk-run 1 '(bits-shift 65536 -16))
(chk-run #b111000 '(bits-and #b111111000 #b111111))
(chk-run #b111111111 '(bits-or #b111111000 #b111111))
(chk-run #b111000111 '(bits-xor #b111111000 #b111111))
(chk-run #b111010111 '(bits-set #b111000111 4))
(chk-run #b111010111 '(bits-set #b111010111 4))
(chk-run #b111000111 '(bits-clear #b111000111 4))
(chk-run #b111000111 '(bits-clear #b111010111 4))
(chk-run #b111010111 '(bits-flip #b111000111 4))
(chk-run #b111000111 '(bits-flip #b111010111 4))
(chk-run 0 '(bits-get #b111000111 4))
(chk-run 16 '(bits-get #b111010111 4))
(chk-run #f '(bits-set? #b111000111 4))
(chk-run #t '(bits-set? #b111010111 4))
(chk-run '#(a b c 1 2 3) '(list->vector '(a b c 1 2 3)))
(chk-run '(a b c 1 2 3) '(vector->list '#(a b c 1 2 3)))
(chk-run '#(a b c 1 2 3) '(vector 'a 'b 'c 1 2 3))
(chk-run '#(#f #f #f #f) '(make-vector 4))
(chk-run '#((a . b) (a . b) (a . b) (a . b)) '(make-vector 4 '(a . b)))
(chk-run 6 '(vector-length '#(a b c 1 2 3)))
(chk-run 8 '(vector-ref '#(1 1 2 3 5 8 13 21) 5))
(chk-run '#(0 "queen of the galaxy" "Barbarella")
'(let ((vec (vector 0 '(2 2 2 2) "Barbarella")))
(vector-set! vec 1 "queen of the galaxy")
vec))
(chk-run '#("sexy" "sexy" "sexy")
'(let ((vec (vector "bodacious" "sexy" "Barbarella")))
(vector-fill! vec "sexy")
vec))
; check quasi-quote and unquote stuff
(chk-run '(list 3 4) '`(list ,(+ 1 2) 4))
(chk-run '(list a (quote a)) '(let ((name 'a)) `(list ,name ',name)))
(chk-run '(a 3 4 5 6 b) '`(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b))
(chk-run '((foo 7) . cons) '`((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons))))
; This test doesn't return quite what R6RS says: the 2, 4, 3 are
; floating-point rather than int as they show
(chk-run '#(10 5 2.0 4.0 3.0 8) '`#(10 5 ,(sqrt 4) ,@(map sqrt '(16 9)) 8))
(chk-run '(foo foo foo) '(let ((name 'foo))
`((unquote name name name))))
(chk-run '((foo) (foo) (foo)) '(let ((name '(foo)))
`((unquote name name name))))
(chk-run '(foo foo foo) '(let ((name '(foo)))
`((unquote-splicing name name name))))
(chk-run '`(foo (unquote (append x y) (sqrt 9)))
'(let ((q '((append x y) (sqrt 9))))
``(foo ,,@q)))
(chk-run '(a `(b ,(+ 1 2) ,(foo 4 d) e) f)
'`(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f))
(chk-run '(a `(b ,x ,'y d) e)
'(let ((name1 'x)
(name2 'y))
`(a `(b ,,name1 ,',name2 d) e)))
; This test doesn't return quite what R6RS says: the trailing 3 is
; floating-point rather than int as they show
(chk-run '(foo (2 3 4 5) 3.0)
'(let ((x '(2 3))
(y '(4 5)))
`(foo (unquote (append x y) (sqrt 9)))))
; This comes out right, but the quasi-quoted expression on the right ends
; up being equivalent in the sense of (eqv?) to all three of the expressions
; listed in R6RS; I'm not entirely sure that's a problem, however... the
; innards are sufficiently different that I am not quite sure it makes sense
; to make the distinction they do.
(chk-run '((1 2) 3 4 five 6) '(let ((a 3)) `((1 2) ,a ,4 ,'five 6)))
(define st (make-stack))
(define counter 0)
(define (bump-counter)
(set! counter (+ 1 counter))
(st 'push counter)
counter)
(chk-run #f '(st 'top))
(chk-run '(3) '(st 'push 3))
(chk-run '(2 3) '(st 'push 2))
(chk-run '(17 2 3) '(st 'push 17))
(chk-run 17 '(st 'pop))
(chk-run #f '(st 'empty?))
(chk-run '(1 2 3) '(st 'push 1))
(chk-run '(1 2 3) '(st 'dump))
(chk-run #f '(st 'top))
(chk-run #t '(st 'empty?))
(bump-counter)
(bump-counter)
(bump-counter)
(chk-run '(3 2 1) '(st 'dump))
(let ((counter 99))
(bump-counter)
(st 'push counter)
(bump-counter)
(st 'push counter)
(bump-counter))
(chk-run '(6 99 5 99 4) '(st 'dump))
(fluid-let ((counter 99))
(bump-counter)
(st 'push counter)
(bump-counter)
(st 'push counter)
(bump-counter))
(chk-run '(102 101 101 100 100) '(st 'dump))
(chk-run 6 counter)
; if anything gets past the guard, it'll kill the self-test; so don't do that
(write-string "Now test exception-handling; this will write some random text\n\n")
(define (guard-test exception)
(guard
(err ((begin (write-string "exception is '")
(if (string? err)
(write-string err)
(display err))
(write-string "'... ")
#f) #t)
((and (string? err) (string=? err "meh"))
(write-string "caught 'meh'\n")
"I am the 'meh'-catcher")
((and (string? err) (string=? err "barf"))
(write-string "caught 'barf'... yuk!\n")
-42)
((and (string? err) (string=? err "yahoo!"))
(write-string "a little excitable today, aren't we...\n")
"US$44.6billion")
((eqv? err '(1 2))
(write-string "does not compute <dalek's head explodes>\n")
"daleks rule! (until their heads blow off)"))
(raise exception)))
(define (nested-guard exception)
(guard
(err (else (write-string "hah, wimpy inner guard didn't catch that one!\n")
#f))
(guard-test exception)))
(chk-run "I am the 'meh'-catcher" '(guard-test "meh"))
(chk-run -42 '(guard-test "barf"))
(chk-run "US$44.6billion" '(guard-test "yahoo!"))
(chk-run "daleks rule! (until their heads blow off)" '(guard-test '(1 2)))
(write-string "\nAgain, this time with nested guards\n\n")
(chk-run "I am the 'meh'-catcher" '(nested-guard "meh"))
(chk-run -42 '(nested-guard "barf"))
(chk-run "US$44.6billion" '(nested-guard "yahoo!"))
(chk-run "daleks rule! (until their heads blow off)" '(nested-guard '(1 2)))
(chk-run #f '(nested-guard "shazam"))
; check some vector error messages
(guard (err
(else (write-string "caught vector error ") (display err) (newline)))
(let ((vec (vector 0 '(2 2 2 2) "Barbarella")))
(vector-set! vec 200 "queen of the galaxy")
vec))
(write-string "\nEnd of exception-handling test\n")
; and summarize everything again
(write-string "\ntotal tests run:\t"
(number->string n-tests)
"\ntests failed:\t\t"
(number->string n-fails)
"\nexceptions caught:\t"
(number->string n-excepts)
"\ntotal CPU time:\t\t"
(number->string (cputime) 10 3)
" seconds\n"
"total elapsed time:\t"
(number->string (- (epochtime) start) 10 3)
" seconds\n"
"test finished at\t"
(localtime)
#\linefeed)