1571 lines
49 KiB
Scheme
1571 lines
49 KiB
Scheme
#!r6rs
|
|
|
|
(library (tests r6rs base)
|
|
(export run-base-tests)
|
|
(import (rnrs)
|
|
(tests r6rs test))
|
|
|
|
(define (try-reals f but-not)
|
|
(if (not (member 0 but-not))
|
|
(f 0))
|
|
(f -1.0)
|
|
(f 0.0)
|
|
(f 1.0)
|
|
(f 1/2)
|
|
(f (expt 2 30))
|
|
(f (expt 2 60))
|
|
(f (expt 2 90))
|
|
(f (- (expt 2 90)))
|
|
(if (not (member +inf.0 but-not))
|
|
(f +inf.0))
|
|
(if (not (member -inf.0 but-not))
|
|
(f -inf.0))
|
|
(if (not (exists nan? but-not))
|
|
(f +nan.0)))
|
|
|
|
(define (try-complexes f but-not)
|
|
(try-reals f but-not)
|
|
(f 1+2i))
|
|
|
|
(define (zero-or-nan? v)
|
|
(or (equal? v 0)
|
|
(nan? v)))
|
|
|
|
(define (one-two-or-two-one? v)
|
|
(or (equal? v '(1 2))
|
|
(equal? v '(2 1))))
|
|
|
|
;; Based on tests from Ikarus:
|
|
(define-syntax divmod-test/?
|
|
(syntax-rules ()
|
|
[(_ x1 x2)
|
|
(begin
|
|
(test/values (div-and-mod x1 x2)
|
|
(div x1 x2)
|
|
(mod x1 x2))
|
|
(test/values (div0-and-mod0 x1 x2)
|
|
(div0 x1 x2)
|
|
(mod0 x1 x2)))]))
|
|
(define-syntax divmod-test
|
|
(syntax-rules ()
|
|
[(_ x1 x2)
|
|
(begin
|
|
(divmod-test/? x1 x2)
|
|
(test (<= 0 (mod x1 x2)) #t)
|
|
(test (< (mod x1 x2) (abs x2)) #t)
|
|
(test (+ (* (div x1 x2) x2) (mod x1 x2)) x1)
|
|
(test (<= (- (abs (/ x2 2))) (mod0 x1 x2)) #t)
|
|
(test (< (mod0 x1 x2) (abs (/ x2 2))) #t)
|
|
(test (+ (* (div0 x1 x2) x2) (mod0 x1 x2)) x1))]))
|
|
|
|
(define-syntax try-bad-divs
|
|
(syntax-rules ()
|
|
[(_ op)
|
|
(begin
|
|
(test/exn (op 1 0) &assertion)
|
|
(test/exn (op 1 0.0) &assertion)
|
|
(test/exn (op +inf.0 1) &assertion)
|
|
(test/exn (op -inf.0 1) &assertion)
|
|
(test/exn (op +nan.0 1) &assertion))]))
|
|
|
|
(define-syntax test-string-to-number
|
|
(syntax-rules ()
|
|
[(_ [str num] ...) (begin (test (string->number str) num) ...)]))
|
|
|
|
;; Definitions ----------------------------------------
|
|
|
|
(define add3
|
|
(lambda (x) (+ x 3)))
|
|
(define first car)
|
|
|
|
(define reverse-subtract
|
|
(lambda (x y) (- y x)))
|
|
|
|
(define add4
|
|
(let ((x 4))
|
|
(lambda (y) (+ x y))))
|
|
|
|
(define x 0)
|
|
|
|
(define gen-counter
|
|
(lambda ()
|
|
(let ((n 0))
|
|
(lambda () (set! n (+ n 1)) n))))
|
|
|
|
(define gen-loser
|
|
(lambda ()
|
|
(let ((n 0))
|
|
(lambda () (set! n (+ n 1)) 27))))
|
|
|
|
(define (fac n)
|
|
(if (not (integer-valued? n))
|
|
(assertion-violation
|
|
'fac "non-integral argument" n))
|
|
(if (negative? n)
|
|
(assertion-violation
|
|
'fac "negative argument" n))
|
|
(letrec
|
|
((loop (lambda (n r)
|
|
(if (zero? n)
|
|
r
|
|
(loop (- n 1) (* r n))))))
|
|
(loop n 1)))
|
|
|
|
(define compose
|
|
(lambda (f g)
|
|
(lambda args
|
|
(f (apply g args)))))
|
|
|
|
(define list-length
|
|
(lambda (obj)
|
|
(call-with-current-continuation
|
|
(lambda (return)
|
|
(letrec ((r
|
|
(lambda (obj)
|
|
(cond ((null? obj) 0)
|
|
((pair? obj)
|
|
(+ (r (cdr obj)) 1))
|
|
(else (return #f))))))
|
|
(r obj))))))
|
|
|
|
(define-syntax be-like-begin
|
|
(syntax-rules ()
|
|
((be-like-begin name)
|
|
(define-syntax name
|
|
(syntax-rules ()
|
|
((name expr (... ...))
|
|
(begin expr (... ...))))))))
|
|
(be-like-begin sequence)
|
|
|
|
(define p (cons 4 5))
|
|
(define-syntax p.car
|
|
(identifier-syntax (car p)))
|
|
|
|
(define-syntax kons
|
|
(identifier-syntax cons))
|
|
|
|
;; Not the same as in the report, because we avoid `set-car!':
|
|
(define-syntax p2.car
|
|
(identifier-syntax
|
|
(_ (car p))
|
|
((set! _ e) (set! p (cons e (cdr p))))))
|
|
|
|
;; Expressions ----------------------------------------
|
|
|
|
(define (run-base-tests)
|
|
;; 11.2.1
|
|
(test (add3 3) 6)
|
|
(test (first '(1 2)) 1)
|
|
|
|
;; 11.2.2
|
|
(test (let ()
|
|
(define even?
|
|
(lambda (x)
|
|
(or (= x 0) (odd? (- x 1)))))
|
|
(define-syntax odd?
|
|
(syntax-rules ()
|
|
((odd? x) (not (even? x)))))
|
|
(even? 10))
|
|
#t)
|
|
(test (let ()
|
|
(define-syntax bind-to-zero
|
|
(syntax-rules ()
|
|
((bind-to-zero id) (define id 0))))
|
|
(bind-to-zero x)
|
|
x)
|
|
0)
|
|
|
|
;; 11.3
|
|
(test (let ((x 5))
|
|
(define foo (lambda (y) (bar x y)))
|
|
(define bar (lambda (a b) (+ (* a b) a)))
|
|
(foo (+ x 3)))
|
|
45)
|
|
(test (let ((x 5))
|
|
(letrec* ((foo (lambda (y) (bar x y)))
|
|
(bar (lambda (a b) (+ (* a b) a))))
|
|
(foo (+ x 3))))
|
|
45)
|
|
|
|
(test/exn (letrec ([x y]
|
|
[y x])
|
|
'should-not-get-here)
|
|
&assertion)
|
|
|
|
(test (letrec ([x (if (eq? (cons 1 2) (cons 1 2))
|
|
x
|
|
1)])
|
|
x)
|
|
1)
|
|
|
|
;; 11.4.1
|
|
;; (These tests are especially silly, since they really
|
|
;; have to work to get this far.)
|
|
(test (quote a) 'a)
|
|
(test (quote #(a b c)) (vector 'a 'b 'c))
|
|
(test (quote (+ 1 2)) '(+ 1 2))
|
|
(test '"abc" "abc")
|
|
(test '145932 145932)
|
|
(test 'a 'a)
|
|
(test '#(a b c) (vector 'a 'b 'c))
|
|
(test '() (list))
|
|
(test '(+ 1 2) '(+ 1 2))
|
|
(test '(quote a) '(quote a))
|
|
(test ''a '(quote a))
|
|
|
|
;; 11.4.2
|
|
;; (test (lambda (x) (+ x x)) {a procedure})
|
|
(test ((lambda (x) (+ x x)) 4) 8)
|
|
(test ((lambda (x)
|
|
(define (p y)
|
|
(+ y 1))
|
|
(+ (p x) x))
|
|
5)
|
|
11)
|
|
(test (reverse-subtract 7 10) 3)
|
|
(test (add4 6) 10)
|
|
(test ((lambda x x) 3 4 5 6) '(3 4 5 6))
|
|
(test ((lambda (x y . z) z) 3 4 5 6)
|
|
'(5 6))
|
|
|
|
;; 11.4.3
|
|
(test (if (> 3 2) 'yes 'no) 'yes)
|
|
(test (if (> 2 3) 'yes 'no) 'no)
|
|
(test (if (> 3 2)
|
|
(- 3 2)
|
|
(+ 3 2))
|
|
1)
|
|
(test/unspec (if #f #f))
|
|
|
|
;; 11.4.4
|
|
(test (let ((x 2))
|
|
(+ x 1)
|
|
(set! x 4)
|
|
(+ x 1))
|
|
5)
|
|
|
|
;; 11.4.5
|
|
(test (cond ((> 3 2) 'greater)
|
|
((< 3 2) 'less))
|
|
'greater)
|
|
|
|
(test (cond ((> 3 3) 'greater)
|
|
((< 3 3) 'less)
|
|
(else 'equal))
|
|
'equal)
|
|
(test (cond ('(1 2 3) => cadr)
|
|
(else #t))
|
|
2)
|
|
|
|
(test (case (* 2 3)
|
|
((2 3 5 7) 'prime)
|
|
((1 4 6 8 9) 'composite))
|
|
'composite)
|
|
(test/unspec (case (car '(c d))
|
|
((a) 'a)
|
|
((b) 'b)))
|
|
(test (case (car '(c d))
|
|
((a e i o u) 'vowel)
|
|
((w y) 'semivowel)
|
|
(else 'consonant))
|
|
'consonant)
|
|
|
|
(test (and (= 2 2) (> 2 1)) #t)
|
|
(test (and (= 2 2) (< 2 1)) #f)
|
|
(test (and 1 2 'c '(f g)) '(f g))
|
|
(test (and) #t)
|
|
|
|
(test (or (= 2 2) (> 2 1)) #t)
|
|
(test (or (= 2 2) (< 2 1)) #t)
|
|
(test (or #f #f #f) #f)
|
|
(test (or '(b c) (/ 3 0)) '(b c))
|
|
|
|
;; 11.4.6
|
|
(test (let ((x 2) (y 3))
|
|
(* x y))
|
|
6)
|
|
|
|
(test (let ((x 2) (y 3))
|
|
(let ((x 7)
|
|
(z (+ x y)))
|
|
(* z x)))
|
|
35)
|
|
(test (let ((x 2) (y 3))
|
|
(let* ((x 7)
|
|
(z (+ x y)))
|
|
(* z x)))
|
|
70)
|
|
(test (letrec ((even?
|
|
(lambda (n)
|
|
(if (zero? n)
|
|
#t
|
|
(odd? (- n 1)))))
|
|
(odd?
|
|
(lambda (n)
|
|
(if (zero? n)
|
|
#f
|
|
(even? (- n 1))))))
|
|
(even? 88))
|
|
#t)
|
|
(test (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)
|
|
5)
|
|
(test (let-values (((a b) (values 1 2))
|
|
((c d) (values 3 4)))
|
|
(list a b c d))
|
|
'(1 2 3 4))
|
|
(test (let-values (((a b . c) (values 1 2 3 4)))
|
|
(list a b c))
|
|
'(1 2 (3 4)))
|
|
(test (let ((a 'a) (b 'b) (x 'x) (y 'y))
|
|
(let-values (((a b) (values x y))
|
|
((x y) (values a b)))
|
|
(list a b x y)))
|
|
'(x y a b))
|
|
(test (let ((a 'a) (b 'b) (x 'x) (y 'y))
|
|
(let*-values (((a b) (values x y))
|
|
((x y) (values a b)))
|
|
(list a b x y)))
|
|
'(x y x y))
|
|
|
|
;; 11.4.7
|
|
(test (begin (set! x 5)
|
|
(+ x 1))
|
|
6)
|
|
(test/output/unspec
|
|
(begin (display "4 plus 1 equals ")
|
|
(display (+ 4 1)))
|
|
"4 plus 1 equals 5")
|
|
|
|
;; 11.5
|
|
(test (eqv? 'a 'a) #t)
|
|
(test (eqv? 'a 'b) #f)
|
|
(test (eqv? 2 2) #t)
|
|
(test (eqv? '() '()) #t)
|
|
(test (eqv? 100000000 100000000) #t)
|
|
(test (eqv? (cons 1 2) (cons 1 2)) #f)
|
|
(test (eqv? (lambda () 1) (lambda () 2)) #f)
|
|
(test (eqv? #f 'nil) #f)
|
|
(test/unspec (let ((p (lambda (x) x)))
|
|
(eqv? p p)))
|
|
(test/unspec (eqv? "" ""))
|
|
(test/unspec (eqv? '#() '#()))
|
|
(test/unspec (eqv? (lambda (x) x)
|
|
(lambda (x) x)))
|
|
(test/unspec (eqv? (lambda (x) x) (lambda (y) y)))
|
|
(test/unspec (eqv? +nan.0 +nan.0))
|
|
|
|
(test/unspec (let ((g (gen-counter)))
|
|
(eqv? g g)))
|
|
(test (eqv? (gen-counter) (gen-counter)) #f)
|
|
|
|
(test/unspec (let ((g (gen-loser)))
|
|
(eqv? g g)))
|
|
(test/unspec (eqv? (gen-loser) (gen-loser)))
|
|
|
|
(test/unspec (letrec ((f (lambda () (if (eqv? f g) 'both 'f)))
|
|
(g (lambda () (if (eqv? f g) 'both 'g))))
|
|
(eqv? f g)))
|
|
|
|
(test (letrec ((f (lambda () (if (eqv? f g) 'f 'both)))
|
|
(g (lambda () (if (eqv? f g) 'g 'both))))
|
|
(eqv? f g))
|
|
#f)
|
|
|
|
(test/unspec (eqv? '(a) '(a)))
|
|
(test/unspec (eqv? "a" "a"))
|
|
(test/unspec (eqv? '(b) (cdr '(a b))))
|
|
(test (let ((x '(a)))
|
|
(eqv? x x))
|
|
#t)
|
|
|
|
(test (eq? 'a 'a) #t)
|
|
(test/unspec (eq? '(a) '(a)))
|
|
(test (eq? (list 'a) (list 'a)) #f)
|
|
(test/unspec (eq? "a" "a"))
|
|
(test/unspec (eq? "" ""))
|
|
(test (eq? '() '()) #t)
|
|
(test/unspec (eq? 2 2))
|
|
(test/unspec (eq? #\A #\A))
|
|
(test (eq? car car) #t)
|
|
(test/unspec (let ((n (+ 2 3)))
|
|
(eq? n n)))
|
|
(test (let ((x '(a)))
|
|
(eq? x x))
|
|
#t)
|
|
(test/unspec (let ((x '#()))
|
|
(eq? x x)))
|
|
(test/unspec (let ((p (lambda (x) x)))
|
|
(eq? p p)))
|
|
|
|
(test (equal? 'a 'a) #t)
|
|
(test (equal? '(a) '(a)) #t)
|
|
(test (equal? '(a (b) c) '(a (b) c)) #t)
|
|
(test (equal? "abc" "abc") #t)
|
|
(test (equal? 2 2) #t)
|
|
(test (equal? (make-vector 5 'a)
|
|
(make-vector 5 'a))
|
|
#t)
|
|
(test (equal? '#vu8(1 2 3 4 5)
|
|
(u8-list->bytevector
|
|
'(1 2 3 4 5)))
|
|
#t)
|
|
(test/unspec (equal? (lambda (x) x)
|
|
(lambda (y) y)))
|
|
|
|
(test (let* ((x (list 'a))
|
|
(y (list 'a))
|
|
(z (list x y)))
|
|
(list (equal? z (list y x))
|
|
(equal? z (list x x))))
|
|
'(#t #t))
|
|
|
|
;; 11.6
|
|
(test (procedure? car) #t)
|
|
(test (procedure? 'car) #f)
|
|
(test (procedure? (lambda (x) (* x x))) #t)
|
|
(test (procedure? '(lambda (x) (* x x))) #f)
|
|
|
|
;; 11.7.4
|
|
(test (complex? 3+4i) #t)
|
|
(test (complex? 3) #t)
|
|
(test (real? 3) #t)
|
|
(test (real? -2.5+0.0i) #f)
|
|
(test (real? -2.5+0i) #t)
|
|
(test (real? -2.5) #t)
|
|
(test (real? #e1e10) #t)
|
|
(test (rational? 6/10) #t)
|
|
(test (rational? 6/3) #t)
|
|
(test (rational? 2) #t)
|
|
(test (integer? 3+0i) #t)
|
|
(test (integer? 3.0) #t)
|
|
(test (integer? 8/4) #t)
|
|
|
|
(test (number? +nan.0) #t)
|
|
(test (complex? +nan.0) #t)
|
|
(test (real? +nan.0) #t)
|
|
(test (rational? +nan.0) #f)
|
|
(test (complex? +inf.0) #t)
|
|
(test (real? -inf.0) #t)
|
|
(test (rational? -inf.0) #f)
|
|
(test (integer? -inf.0) #f)
|
|
|
|
(test (real-valued? +nan.0) #t)
|
|
(test (real-valued? +nan.0+0i) #t)
|
|
(test (real-valued? -inf.0) #t)
|
|
(test (real-valued? 3) #t)
|
|
(test (real-valued? -2.5+0.0i) #t)
|
|
(test (real-valued? -2.5+0i) #t)
|
|
(test (real-valued? -2.5) #t)
|
|
(test (real-valued? #e1e10) #t)
|
|
|
|
(test (rational-valued? +nan.0) #f)
|
|
(test (rational-valued? -inf.0) #f)
|
|
(test (rational-valued? 6/10) #t)
|
|
(test (rational-valued? 6/10+0.0i) #t)
|
|
(test (rational-valued? 6/10+0i) #t)
|
|
(test (rational-valued? 6/3) #t)
|
|
|
|
(test (integer-valued? 3+0i) #t)
|
|
(test (integer-valued? 3+0.0i) #t)
|
|
(test (integer-valued? 3.0) #t)
|
|
(test (integer-valued? 3.0+0.0i) #t)
|
|
(test (integer-valued? 8/4) #t)
|
|
|
|
(test (exact? 5) #t)
|
|
(test (inexact? +inf.0) #t)
|
|
|
|
(test (inexact 2) 2.0)
|
|
(test (inexact 2.0) 2.0)
|
|
(test (exact 2) 2)
|
|
(test (exact 2.0) 2)
|
|
|
|
(for-each
|
|
(lambda (x y)
|
|
(let ([try-one
|
|
(lambda (x y)
|
|
(let ([try-x
|
|
(lambda (x x2)
|
|
(test (= x x2) #t)
|
|
(test (< x x2) #f)
|
|
(test (> x x2) #f)
|
|
(test (<= x x2) #t)
|
|
(test (>= x x2) #t))])
|
|
(try-x x x)
|
|
(when (exact? x)
|
|
(try-x x (inexact x))
|
|
(try-x (inexact x) x)))
|
|
(test (< x y) #t)
|
|
(test (<= x y) #t)
|
|
(test (> x y) #f)
|
|
(test (>= x y) #f)
|
|
(test (< y x) #f)
|
|
(test (<= y x) #f)
|
|
(test (> y x) #t)
|
|
(test (>= y x) #t))])
|
|
(try-one x y)
|
|
(try-one (inexact x) y)
|
|
(try-one x (inexact y))
|
|
(try-one (inexact x) (inexact y))))
|
|
(list 1/2 1 3/2 (expt 2 100) (expt 2 100))
|
|
(list 1 2 51/20 (expt 2 102) (/ (* 4 (expt 2 100)) 3)))
|
|
|
|
(test (= +inf.0 +inf.0) #t)
|
|
(test (= -inf.0 +inf.0) #f)
|
|
(test (= -inf.0 -inf.0) #t)
|
|
(test (= +nan.0 +nan.0) #f)
|
|
|
|
(try-reals
|
|
(lambda (x)
|
|
(test (< -inf.0 x +inf.0) #t)
|
|
(test (> +inf.0 x -inf.0) #t))
|
|
'(+inf.0 -inf.0 +nan.0))
|
|
|
|
(try-complexes
|
|
(lambda (z)
|
|
(test (= +nan.0 x) #f))
|
|
'())
|
|
|
|
(try-reals
|
|
(lambda (x)
|
|
(test (< +nan.0 x) #f)
|
|
(test (> +nan.0 x) #f))
|
|
'())
|
|
|
|
(test (zero? +0.0) #t)
|
|
(test (zero? -0.0) #t)
|
|
(test (zero? 2.0) #f)
|
|
(test (zero? -2.0) #f)
|
|
(test (zero? +nan.0) #f)
|
|
(test (positive? 10) #t)
|
|
(test (positive? -10) #f)
|
|
(test (positive? +inf.0) #t)
|
|
(test (negative? -inf.0) #t)
|
|
(test (positive? +nan.0) #f)
|
|
(test (negative? 10) #f)
|
|
(test (negative? -10) #t)
|
|
(test (negative? +nan.0) #f)
|
|
(test (finite? +inf.0) #f)
|
|
(test (finite? 5) #t)
|
|
(test (finite? 5.0) #t)
|
|
(test (infinite? 5.0) #f)
|
|
(test (infinite? +inf.0) #t)
|
|
(test (nan? +nan.0) #t)
|
|
(test (nan? +inf.0) #f)
|
|
(test (nan? 1020.0) #f)
|
|
(test (nan? 1020/3) #f)
|
|
|
|
(test (odd? 5) #t)
|
|
(test (odd? 50) #f)
|
|
(test (odd? 5.0) #t)
|
|
(test (odd? 50.0) #f)
|
|
(test (even? 5) #f)
|
|
(test (even? 50) #t)
|
|
(test (even? 5.0) #f)
|
|
(test (even? 50.0) #t)
|
|
|
|
(test (max 3 4) 4)
|
|
(test (max 3.9 4) 4.0)
|
|
|
|
(try-reals
|
|
(lambda (x)
|
|
(test (max +inf.0 x) +inf.0)
|
|
(test (min -inf.0 x) -inf.0))
|
|
'(+nan.0))
|
|
|
|
(test (+ 3 4) 7)
|
|
(test (+ 3) 3)
|
|
(test (+) 0)
|
|
(test (+ 3.0 4) 7.0)
|
|
(test (+ +inf.0 +inf.0) +inf.0)
|
|
(test (+ +inf.0 -inf.0) +nan.0)
|
|
|
|
(test (* 4) 4)
|
|
(test (* 4 3) 12)
|
|
(test (* 4 3.0) 12.0)
|
|
(test (*) 1)
|
|
(test (* 5 +inf.0) +inf.0)
|
|
(test (* -5 +inf.0) -inf.0)
|
|
(test (* +inf.0 +inf.0) +inf.0)
|
|
(test (* +inf.0 -inf.0) -inf.0)
|
|
(test (zero-or-nan? (* 0 +inf.0)) #t)
|
|
(test (zero-or-nan? (* 0 +nan.0)) #t)
|
|
(test (zero? (* 1.0 0)) #t)
|
|
|
|
(try-reals
|
|
(lambda (x)
|
|
(test (+ +inf.0 x) +inf.0)
|
|
(test (+ -inf.0 x) -inf.0))
|
|
'(+inf.0 -inf.0 +nan.0))
|
|
|
|
(try-reals
|
|
(lambda (x)
|
|
(test (+ +nan.0 x) +nan.0))
|
|
'())
|
|
|
|
(try-reals
|
|
(lambda (x)
|
|
(test (* +nan.0 x) +nan.0))
|
|
'(0))
|
|
|
|
(test (+ 0.0 -0.0) 0.0)
|
|
(test (+ -0.0 0.0) 0.0)
|
|
(test (+ 0.0 0.0) 0.0)
|
|
(test (+ -0.0 -0.0) -0.0)
|
|
|
|
(test (- 3 4) -1)
|
|
(test (- 3 4 5) -6)
|
|
(test (- 3) -3)
|
|
(test (- +inf.0 +inf.0) +nan.0)
|
|
|
|
(test (- 0.0) -0.0)
|
|
(test (- -0.0) 0.0)
|
|
(test (- 0.0 -0.0) 0.0)
|
|
(test (- -0.0 0.0) -0.0)
|
|
(test (- 0.0 0.0) 0.0)
|
|
(test (- -0.0 -0.0) 0.0)
|
|
|
|
(test (/ 3 4 5) 3/20)
|
|
(test (/ 2 3) 2/3)
|
|
(test (/ 3 2.0) 1.5)
|
|
(test (/ 3) 1/3)
|
|
(test (/ 0.0) +inf.0)
|
|
(test (/ 1.0 0) +inf.0)
|
|
(test (/ -1 0.0) -inf.0)
|
|
(test (/ +inf.0) 0.0)
|
|
|
|
(test/exn (/ 0 0) &assertion)
|
|
(test/exn (/ 3 0) &assertion)
|
|
(test (/ 0 3.5) 0.0)
|
|
(test (/ 0 0.0) +nan.0)
|
|
(test (/ 0.0 0) +nan.0)
|
|
(test (/ 0.0 0.0) +nan.0)
|
|
|
|
(test (abs 7) 7)
|
|
(test (abs -7) 7)
|
|
(test (abs (- (expt 2 100))) (expt 2 100))
|
|
(test (abs -inf.0) +inf.0)
|
|
|
|
(test (div 123 10) 12)
|
|
(test (mod 123 10) 3)
|
|
(test (div 123 -10) -12)
|
|
(test (mod 123 -10) 3)
|
|
(test (div -123 10) -13)
|
|
(test (mod -123 10) 7)
|
|
(test (div -123 -10) 13)
|
|
(test (mod -123 -10) 7)
|
|
|
|
(test (div0 123 10) 12)
|
|
(test (mod0 123 10) 3)
|
|
(test (div0 123 -10) -12)
|
|
(test (mod0 123 -10) 3)
|
|
(test (div0 -123 10) -12)
|
|
(test (mod0 -123 10) -3)
|
|
(test (div0 -123 -10) 12)
|
|
(test (mod0 -123 -10) -3)
|
|
|
|
;; `divmod-test' cases originally from Ikarus:
|
|
|
|
(divmod-test +17 +3)
|
|
(divmod-test +17 -3)
|
|
(divmod-test -17 +3)
|
|
(divmod-test -17 -3)
|
|
(divmod-test +16 +3)
|
|
(divmod-test +16 -3)
|
|
(divmod-test -16 +3)
|
|
(divmod-test -16 -3)
|
|
(divmod-test +15 +3)
|
|
(divmod-test +15 -3)
|
|
(divmod-test -15 +3)
|
|
(divmod-test -15 -3)
|
|
(divmod-test +10 +4)
|
|
(divmod-test +10 -4)
|
|
(divmod-test -10 +4)
|
|
(divmod-test -10 -4)
|
|
|
|
(divmod-test +3 +5/6)
|
|
(divmod-test -3 +5/6)
|
|
(divmod-test +3 -5/6)
|
|
(divmod-test -3 -5/6)
|
|
|
|
(divmod-test +3 +7/11)
|
|
(divmod-test -3 +7/11)
|
|
(divmod-test +3 -7/11)
|
|
(divmod-test -3 -7/11)
|
|
|
|
(divmod-test (least-fixnum) +1)
|
|
(divmod-test (least-fixnum) -1)
|
|
(divmod-test (greatest-fixnum) +1)
|
|
(divmod-test (greatest-fixnum) -1)
|
|
(divmod-test (least-fixnum) +2)
|
|
(divmod-test (least-fixnum) -2)
|
|
(divmod-test (greatest-fixnum) +2)
|
|
(divmod-test (greatest-fixnum) -2)
|
|
|
|
(divmod-test 0 (least-fixnum))
|
|
(divmod-test 0 (greatest-fixnum))
|
|
(divmod-test +1 (least-fixnum))
|
|
(divmod-test +1 (greatest-fixnum))
|
|
(divmod-test -1 (least-fixnum))
|
|
(divmod-test -1 (greatest-fixnum))
|
|
(divmod-test +2 (least-fixnum))
|
|
(divmod-test +2 (greatest-fixnum))
|
|
(divmod-test -2 (least-fixnum))
|
|
(divmod-test -2 (greatest-fixnum))
|
|
|
|
(divmod-test (least-fixnum) (least-fixnum))
|
|
(divmod-test (greatest-fixnum) (least-fixnum))
|
|
(divmod-test (least-fixnum) (greatest-fixnum))
|
|
(divmod-test (greatest-fixnum) (greatest-fixnum))
|
|
|
|
(divmod-test +17.0 +3.0)
|
|
(divmod-test +17.0 -3.0)
|
|
(divmod-test -17.0 +3.0)
|
|
(divmod-test -17.0 -3.0)
|
|
(divmod-test +16.0 +3.0)
|
|
(divmod-test +16.0 -3.0)
|
|
(divmod-test -16.0 +3.0)
|
|
(divmod-test -16.0 -3.0)
|
|
(divmod-test +15.0 +3.0)
|
|
(divmod-test +15.0 -3.0)
|
|
(divmod-test -15.0 +3.0)
|
|
(divmod-test -15.0 -3.0)
|
|
(divmod-test +17.0 +3.5)
|
|
(divmod-test +17.0 -3.5)
|
|
(divmod-test -17.0 +3.5)
|
|
(divmod-test -17.0 -3.5)
|
|
(divmod-test +16.0 +3.5)
|
|
(divmod-test +16.0 -3.5)
|
|
(divmod-test -16.0 +3.5)
|
|
(divmod-test -16.0 -3.5)
|
|
(divmod-test +15.0 +3.5)
|
|
(divmod-test +15.0 -3.5)
|
|
(divmod-test -15.0 +3.5)
|
|
(divmod-test -15.0 -3.5)
|
|
(divmod-test/? +17.0 +nan.0)
|
|
(divmod-test/? -17.0 +nan.0)
|
|
(divmod-test/? +17.0 +inf.0)
|
|
(divmod-test/? +17.0 -inf.0)
|
|
(divmod-test/? -17.0 +inf.0)
|
|
(divmod-test/? -17.0 -inf.0)
|
|
|
|
(divmod-test +17.0 +3.0)
|
|
(divmod-test +17.0 -3.0)
|
|
(divmod-test -17.0 +3.0)
|
|
(divmod-test -17.0 -3.0)
|
|
(divmod-test +16.0 +3.0)
|
|
(divmod-test +16.0 -3.0)
|
|
(divmod-test -16.0 +3.0)
|
|
(divmod-test -16.0 -3.0)
|
|
(divmod-test +15.0 +3.0)
|
|
(divmod-test +15.0 -3.0)
|
|
(divmod-test -15.0 +3.0)
|
|
(divmod-test -15.0 -3.0)
|
|
(divmod-test +17.0 +3.5)
|
|
(divmod-test +17.0 -3.5)
|
|
(divmod-test -17.0 +3.5)
|
|
(divmod-test -17.0 -3.5)
|
|
(divmod-test +16.0 +3.5)
|
|
(divmod-test +16.0 -3.5)
|
|
(divmod-test -16.0 +3.5)
|
|
(divmod-test -16.0 -3.5)
|
|
(divmod-test +15.0 +3.5)
|
|
(divmod-test +15.0 -3.5)
|
|
(divmod-test -15.0 +3.5)
|
|
(divmod-test -15.0 -3.5)
|
|
(divmod-test +10.0 +4.0)
|
|
(divmod-test +10.0 -4.0)
|
|
(divmod-test -10.0 +4.0)
|
|
(divmod-test -10.0 -4.0)
|
|
(divmod-test/? +17.0 +nan.0)
|
|
(divmod-test/? -17.0 +nan.0)
|
|
(divmod-test/? +17.0 +inf.0)
|
|
(divmod-test/? +17.0 -inf.0)
|
|
(divmod-test/? -17.0 +inf.0)
|
|
(divmod-test/? -17.0 -inf.0)
|
|
|
|
(try-bad-divs div)
|
|
(try-bad-divs mod)
|
|
(try-bad-divs div-and-mod)
|
|
(try-bad-divs div0)
|
|
(try-bad-divs mod0)
|
|
(try-bad-divs div0-and-mod0)
|
|
|
|
(test (gcd 32 -36) 4)
|
|
(test (gcd) 0)
|
|
(test (lcm 32 -36) 288)
|
|
(test (lcm 32.0 -36) 288.0)
|
|
(test (lcm) 1)
|
|
|
|
(test (numerator 6) 6)
|
|
(test (numerator (/ 6 4)) 3)
|
|
(test (denominator (/ 6 4)) 2)
|
|
(test (denominator 6) 1)
|
|
(test (denominator (inexact (/ 6 4))) 2.0)
|
|
|
|
(test (floor -4.3) -5.0)
|
|
(test (ceiling -4.3) -4.0)
|
|
(test (truncate -4.3) -4.0)
|
|
(test (round -4.3) -4.0)
|
|
|
|
(test (floor 3.5) 3.0)
|
|
(test (ceiling 3.5) 4.0)
|
|
(test (truncate 3.5) 3.0)
|
|
(test (round 3.5) 4.0)
|
|
|
|
(test (round 7/2) 4)
|
|
(test (round 7) 7)
|
|
|
|
(test (floor +inf.0) +inf.0)
|
|
(test (ceiling -inf.0) -inf.0)
|
|
(test (round +nan.0) +nan.0)
|
|
|
|
(test (rationalize (exact .3) 1/10) 1/3)
|
|
(test/approx (rationalize .3 1/10) #i1/3)
|
|
|
|
(test (rationalize +inf.0 3) +inf.0)
|
|
(test (rationalize +inf.0 +inf.0) +nan.0)
|
|
(test (rationalize 3 +inf.0) 0.0)
|
|
|
|
(test/approx (exp 1) 2.718281828459045)
|
|
(test (exp +inf.0) +inf.0)
|
|
(test (exp -inf.0) 0.0)
|
|
(test/approx (log 2.718281828459045) 1.0)
|
|
(test (log +inf.0) +inf.0)
|
|
(test (log 0.0) -inf.0)
|
|
(test/approx (log 100 10) 2.0)
|
|
(test/approx (log 1125899906842624 2) 50.0)
|
|
|
|
(test/exn (log 0) &assertion)
|
|
|
|
(test/approx (log -inf.0) +inf.0+3.141592653589793i)
|
|
(test/approx (atan -inf.0) -1.5707963267948965)
|
|
(test/approx (atan +inf.0) 1.5707963267948965)
|
|
(test/approx (log -1.0+0.0i) 0.0+3.141592653589793i)
|
|
(unless (eqv? 0.0 -0.0)
|
|
(test/approx (log -1.0-0.0i) 0.0-3.141592653589793i))
|
|
|
|
(test/approx (sqrt 5) 2.23606797749979)
|
|
(test/approx (sqrt -5) 0.0+2.23606797749979i)
|
|
|
|
(test (sqrt +inf.0) +inf.0)
|
|
(test (sqrt -inf.0) +inf.0i)
|
|
|
|
(test/values (exact-integer-sqrt 0) 0 0)
|
|
(test/values (exact-integer-sqrt 4) 2 0)
|
|
(test/values (exact-integer-sqrt 5) 2 1)
|
|
|
|
(test (expt 5 3) 125)
|
|
(test (expt 5 -3) 1/125)
|
|
(test (expt 5 0) 1)
|
|
(test (expt 0 5) 0)
|
|
(test/approx (expt 0 5+.0000312i) 0.0) ; R6RS (Sept 2007) appears to be wrong; also, test that result is inexact?
|
|
(test/approx (expt 0.0 5+.0000312i) 0.0)
|
|
(test/approx (expt 0 0.0) 1.0)
|
|
(test/approx (expt 0.0 0.0) 1.0)
|
|
(test/unspec-or-exn (expt 0 -5) &implementation-restriction)
|
|
(test/unspec-or-exn (expt 0 -5+.0000312i) &implementation-restriction)
|
|
(test (expt 0 0) 1)
|
|
(test (expt 0.0 0.0) 1.0)
|
|
|
|
|
|
(test/approx (make-rectangular 1.1 0.0) 1.1+0.0i)
|
|
(test/approx (make-rectangular 1.1 2.2) 1.1+2.2i)
|
|
(test/approx (make-polar 1.1 0.0) 1.1+0.0i)
|
|
(test/approx (make-polar 1.1 2.2) 1.1@2.2)
|
|
|
|
(test/approx (real-part 1.1+2.2i) 1.1)
|
|
(test/approx (imag-part 1.1+2.2i) 2.2)
|
|
(test/approx (magnitude 1.1@2.2) 1.1)
|
|
|
|
(test (exact? (imag-part 0.0)) #t)
|
|
(test (exact? (imag-part 1.0)) #t)
|
|
(test (exact? (imag-part 1.1)) #t)
|
|
(test (exact? (imag-part +nan.0)) #t)
|
|
(test (exact? (imag-part +inf.0)) #t)
|
|
(test (exact? (imag-part -inf.0)) #t)
|
|
|
|
(test (zero? (imag-part 0.0)) #t)
|
|
(test (zero? (imag-part 1.0)) #t)
|
|
(test (zero? (imag-part 1.1)) #t)
|
|
(test (zero? (imag-part +nan.0)) #t)
|
|
(test (zero? (imag-part +inf.0)) #t)
|
|
(test (zero? (imag-part -inf.0)) #t)
|
|
|
|
(test/approx (angle 1.1@2.2) 2.2)
|
|
|
|
(test/approx (angle -1.0) 3.141592653589793)
|
|
(test/approx (angle -1.0+0.0i) 3.141592653589793)
|
|
(unless (eqv? 0.0 -0.0)
|
|
(test/approx (angle -1.0-0.0i) -3.141592653589793))
|
|
(test (angle +inf.0) 0.0)
|
|
(test/approx (angle -inf.0) 3.141592653589793)
|
|
|
|
(test (magnitude (make-rectangular +inf.0 1)) +inf.0)
|
|
(test (magnitude (make-rectangular -inf.0 1)) +inf.0)
|
|
(test (magnitude (make-rectangular 1 +inf.0)) +inf.0)
|
|
(test (magnitude (make-rectangular 1 -inf.0)) +inf.0)
|
|
|
|
(test/approx (angle -1) 3.141592653589793)
|
|
|
|
(for-each
|
|
(lambda (n)
|
|
(test (string->number (number->string n)) n)
|
|
(test (string->number (number->string n 10 5)) n)
|
|
(when (exact? n)
|
|
(test (string->number (number->string n 16) 16) n)
|
|
(test (string->number (string-append "#x" (number->string n 16))) n)
|
|
(test (string->number (number->string n 8) 8) n)
|
|
(test (string->number (string-append "#o" (number->string n 8))) n)
|
|
(test (string->number (number->string n 2) 2) n)
|
|
(test (string->number (string-append "#b" (number->string n 2))) n)
|
|
(test (string->number (number->string n 10) 10) n)
|
|
(test (string->number (string-append "#d" (number->string n 10))) n)))
|
|
'(1 15 1023 -5 2.0 1/2 2e200 1+2i))
|
|
(test (string->number "nope") #f)
|
|
|
|
(test (string->number "100") 100)
|
|
(test (string->number "100" 16) 256)
|
|
(test (string->number "1e2") 100.0)
|
|
(test (string->number "0/0") #f)
|
|
(test (string->number "+inf.0") +inf.0)
|
|
(test (string->number "-inf.0") -inf.0)
|
|
(test (string->number "+nan.0") +nan.0)
|
|
|
|
;; Originally from Ikarus:
|
|
(test-string-to-number
|
|
("10" 10)
|
|
("1" 1)
|
|
("-17" -17)
|
|
("+13476238746782364786237846872346782364876238477"
|
|
13476238746782364786237846872346782364876238477)
|
|
("1/2" (/ 1 2))
|
|
("-1/2" (/ 1 -2))
|
|
("#x24" 36)
|
|
("#x-24" -36)
|
|
("#b+00000110110" 54)
|
|
("#b-00000110110/10" -27)
|
|
("#e10" 10)
|
|
("#e1" 1)
|
|
("#e-17" -17)
|
|
("#e#x24" 36)
|
|
("#e#x-24" -36)
|
|
("#e#b+00000110110" 54)
|
|
("#e#b-00000110110/10" -27)
|
|
("#x#e24" 36)
|
|
("#x#e-24" -36)
|
|
("#b#e+00000110110" 54)
|
|
("#b#e-00000110110/10" -27)
|
|
("#e1e1000" (expt 10 1000))
|
|
("#e-1e1000" (- (expt 10 1000)))
|
|
("#e1e-1000" (expt 10 -1000))
|
|
("#e-1e-1000" (- (expt 10 -1000)))
|
|
("#i1e100" (inexact (expt 10 100)))
|
|
("#i1e1000" (inexact (expt 10 1000)))
|
|
("#i-1e1000" (inexact (- (expt 10 1000))))
|
|
("1e100" (inexact (expt 10 100)))
|
|
("1.0e100" (inexact (expt 10 100)))
|
|
("1.e100" (inexact (expt 10 100)))
|
|
("0.1e100" (inexact (expt 10 99)))
|
|
(".1e100" (inexact (expt 10 99)))
|
|
("+1e100" (inexact (expt 10 100)))
|
|
("+1.0e100" (inexact (expt 10 100)))
|
|
("+1.e100" (inexact (expt 10 100)))
|
|
("+0.1e100" (inexact (expt 10 99)))
|
|
("+.1e100" (inexact (expt 10 99)))
|
|
("-1e100" (inexact (- (expt 10 100))))
|
|
("-1.0e100" (inexact (- (expt 10 100))))
|
|
("-1.e100" (inexact (- (expt 10 100))))
|
|
("-0.1e100" (inexact (- (expt 10 99))))
|
|
("-.1e100" (inexact (- (expt 10 99)))))
|
|
|
|
;; 11.8
|
|
(test (not #t) #f)
|
|
(test (not 3) #f)
|
|
(test (not (list 3)) #f)
|
|
(test (not #f) #t)
|
|
(test (not '()) #f)
|
|
(test (not (list)) #f)
|
|
(test (not 'nil) #f)
|
|
|
|
(test (boolean? #f) #t)
|
|
(test (boolean? 0) #f)
|
|
(test (boolean? '()) #f)
|
|
|
|
(test (boolean=? #f #f) #t)
|
|
(test (boolean=? #t #t) #t)
|
|
(test (boolean=? #t #f) #f)
|
|
(test (boolean=? #f #t) #f)
|
|
|
|
;; 11.9
|
|
(test (pair? '(a . b)) #t)
|
|
(test (pair? '(a b c)) #t)
|
|
(test (pair? '()) #f)
|
|
(test (pair? '#(a b)) #f)
|
|
|
|
(test (cons 'a '()) '(a))
|
|
(test (cons '(a) '(b c d)) '((a) b c d))
|
|
(test (cons "a" '(b c)) '("a" b c))
|
|
(test (cons 'a 3) '(a . 3))
|
|
(test (cons '(a b) 'c) '((a b) . c))
|
|
|
|
(test (car '(a b c)) 'a)
|
|
(test (car '((a) b c d)) '(a))
|
|
(test (car '(1 . 2)) 1)
|
|
(test/exn (car '()) &assertion)
|
|
|
|
(test (cdr '((a) b c d)) '(b c d))
|
|
(test (cdr '(1 . 2)) 2)
|
|
(test/exn (cdr '()) &assertion)
|
|
|
|
(test (cadr '(1 2)) 2)
|
|
(test (cddr '(1 2)) '())
|
|
(test (cdar '((1) 2)) '())
|
|
(test (caar '((1) 2)) 1)
|
|
|
|
(test (cadar '((1 2))) 2)
|
|
(test (cddar '((1 2))) '())
|
|
(test (cdaar '(((1) 2))) '())
|
|
(test (caaar '(((1) 2))) 1)
|
|
(test (caddr '(0 1 2)) 2)
|
|
(test (cdddr '(0 1 2)) '())
|
|
(test (cdadr '(0 (1) 2)) '())
|
|
(test (caadr '(0 (1) 2)) 1)
|
|
|
|
(test (cadaar '(((1 2)))) 2)
|
|
(test (cddaar '(((1 2)))) '())
|
|
(test (cdaaar '((((1) 2)))) '())
|
|
(test (caaaar '((((1) 2)))) 1)
|
|
(test (caddar '((0 1 2))) 2)
|
|
(test (cdddar '((0 1 2))) '())
|
|
(test (cdadar '((0 (1) 2))) '())
|
|
(test (caadar '((0 (1) 2))) 1)
|
|
(test (cadadr '(- (1 2))) 2)
|
|
(test (cddadr '(- (1 2))) '())
|
|
(test (cdaadr '(- ((1) 2))) '())
|
|
(test (caaadr '(- ((1) 2))) 1)
|
|
(test (cadddr '(- 0 1 2)) 2)
|
|
(test (cddddr '(- 0 1 2)) '())
|
|
(test (cdaddr '(- 0 (1) 2)) '())
|
|
(test (caaddr '(- 0 (1) 2)) 1)
|
|
|
|
(test (null? '()) #t)
|
|
(test (null? '(1)) #f)
|
|
(test (null? #f) #f)
|
|
|
|
(test (list? '(a b c)) #t)
|
|
(test (list? '()) #t)
|
|
(test (list? '(a . b)) #f)
|
|
|
|
(test (list 'a (+ 3 4) 'c) '(a 7 c))
|
|
(test (list) '())
|
|
|
|
(test (length '(a b c)) 3)
|
|
(test (length '(a (b) (c d e))) 3)
|
|
(test (length '()) 0)
|
|
|
|
(test (append '(x) '(y)) '(x y))
|
|
(test (append '(a) '(b c d)) '(a b c d))
|
|
(test (append '(a (b)) '((c))) '(a (b) (c)))
|
|
(test (append '(a b) '(c . d)) '(a b c . d))
|
|
(test (append '() 'a) 'a)
|
|
|
|
(test (reverse '(a b c)) '(c b a))
|
|
(test (reverse '(a (b c) d (e (f)))) '((e (f)) d (b c) a))
|
|
|
|
(test (list-tail '(a b c d) 2) '(c d))
|
|
(test (list-tail '(a b . c) 2) 'c)
|
|
|
|
(test (list-ref '(a b c d) 2) 'c)
|
|
(test (list-ref '(a b c . d) 2) 'c)
|
|
|
|
(test (map cadr '((a b) (d e) (g h))) '(b e h))
|
|
|
|
(test (map (lambda (n) (expt n n))
|
|
'(1 2 3 4 5))
|
|
'(1 4 27 256 3125))
|
|
|
|
(test (map + '(1 2 3) '(4 5 6)) '(5 7 9))
|
|
|
|
(test (one-two-or-two-one?
|
|
(let ((count 0))
|
|
(map (lambda (ignored)
|
|
(set! count (+ count 1))
|
|
count)
|
|
'(a b))))
|
|
#t)
|
|
|
|
(test (let ((v (make-vector 5)))
|
|
(for-each (lambda (i)
|
|
(vector-set! v i (* i i)))
|
|
'(0 1 2 3 4))
|
|
v)
|
|
'#(0 1 4 9 16))
|
|
|
|
(test/unspec (for-each (lambda (x) x) '(1 2 3 4)))
|
|
|
|
(test/unspec (for-each even? '()))
|
|
|
|
;; 11.10
|
|
(test (symbol? 'foo) #t)
|
|
(test (symbol? (car '(a b))) #t)
|
|
(test (symbol? "bar") #f)
|
|
(test (symbol? 'nil) #t)
|
|
(test (symbol? '()) #f)
|
|
(test (symbol? #f) #f)
|
|
|
|
(test (symbol=? 'a 'a) #t)
|
|
(test (symbol=? 'a 'A) #f)
|
|
(test (symbol=? 'a 'b) #f)
|
|
|
|
(test (symbol->string 'flying-fish)
|
|
"flying-fish")
|
|
(test (symbol->string 'Martin) "Martin")
|
|
(test (symbol->string
|
|
(string->symbol "Malvina"))
|
|
"Malvina")
|
|
|
|
(test (eq? 'mISSISSIppi 'mississippi) #f)
|
|
(test (string->symbol "mISSISSIppi")
|
|
'mISSISSIppi)
|
|
(test (eq? 'bitBlt (string->symbol "bitBlt")) #t)
|
|
(test (eq? 'JollyWog
|
|
(string->symbol
|
|
(symbol->string 'JollyWog))) #t)
|
|
(test (string=? "K. Harper, M.D."
|
|
(symbol->string
|
|
(string->symbol "K. Harper, M.D.")))
|
|
#t)
|
|
|
|
;; 11.11
|
|
(test (char? #\a) #t)
|
|
(test (char? 'a) #f)
|
|
(test (char? 65) #f)
|
|
|
|
(test (integer->char 32) #\space)
|
|
(test (integer->char #xDF) #\xDF)
|
|
(test (integer->char #x10AAAA) #\x10AAAA)
|
|
(test (char->integer (integer->char 5000))
|
|
5000)
|
|
(test/exn (integer->char #xD800) &assertion)
|
|
(test (char=? #\z #\xDF) #f)
|
|
(test (char=? #\z #\z) #t)
|
|
(test (char<? #\z #\z) #f)
|
|
(test (char<? #\z #\xDF) #t)
|
|
(test (char<? #\xDF #\z) #f)
|
|
(test (char<? #\z #\Z) #f)
|
|
(test (char<=? #\z #\z) #t)
|
|
(test (char<=? #\z #\xDF) #t)
|
|
(test (char<=? #\xDF #\z) #f)
|
|
(test (char<=? #\z #\Z) #f)
|
|
(test (char>? #\z #\z) #f)
|
|
(test (char>? #\z #\xDF) #f)
|
|
(test (char>? #\xDF #\z) #t)
|
|
(test (char>? #\z #\Z) #t)
|
|
(test (char>=? #\z #\z) #t)
|
|
(test (char>=? #\z #\xDF) #f)
|
|
(test (char>=? #\xDF #\z) #t)
|
|
(test (char>=? #\z #\Z) #t)
|
|
|
|
;; 11.12
|
|
(test (string? "apple") #t)
|
|
(test (string? #vu8(1 2)) #f)
|
|
(test (string? #\a) #f)
|
|
(test (string? 77) #f)
|
|
|
|
(test (string-length (make-string 10)) 10)
|
|
(test (string-length (make-string 10 #\a)) 10)
|
|
(test (string-ref (make-string 10 #\a) 0) #\a)
|
|
(test (string-ref (make-string 10 #\a) 5) #\a)
|
|
(test (string-ref (make-string 10 #\a) 9) #\a)
|
|
|
|
(test (string=? "Strasse" "Strasse") #t)
|
|
(test (string=? "Stra\xDF;e" "Strasse") #f)
|
|
(test (string=? "Strasse" "Strasse" "Stra\xDF;e") #f)
|
|
(test (string=? "Strasse" "Stra\xDF;e" "Strasse") #f)
|
|
(test (string=? "Stra\xDF;e" "Strasse" "Strasse") #f)
|
|
(test (string=? "Strasse" "Strasse" "Strasse") #t)
|
|
|
|
(test (string<? "z" "z") #f)
|
|
(test (string<? "z" "\xDF;") #t)
|
|
(test (string<? "\xDF;" "z") #f)
|
|
(test (string<? "z" "zz") #t)
|
|
(test (string<? "z" "Z") #f)
|
|
(test (string<=? "z" "\xDF;") #t)
|
|
(test (string<=? "\xDF;" "z") #f)
|
|
(test (string<=? "z" "zz") #t)
|
|
(test (string<=? "z" "Z") #f)
|
|
(test (string<=? "z" "z") #t)
|
|
|
|
(test (string<? "z" "z") #f)
|
|
(test (string>? "z" "\xDF;") #f)
|
|
(test (string>? "\xDF;" "z") #t)
|
|
(test (string>? "z" "zz") #f)
|
|
(test (string>? "z" "Z") #t)
|
|
(test (string>=? "z" "\xDF;") #f)
|
|
(test (string>=? "\xDF;" "z") #t)
|
|
(test (string>=? "z" "zz") #f)
|
|
(test (string>=? "z" "Z") #t)
|
|
(test (string>=? "z" "z") #t)
|
|
|
|
(test (substring "apple" 0 3) "app")
|
|
(test (substring "apple" 1 3) "pp")
|
|
(test (substring "apple" 3 5) "le")
|
|
|
|
(test (string-append "apple") "apple")
|
|
(test (string-append "apple" "banana") "applebanana")
|
|
(test (string-append "apple" "banana" "cherry") "applebananacherry")
|
|
|
|
(test (string->list "apple") (list #\a #\p #\p #\l #\e))
|
|
(test (list->string (list #\a #\p #\p #\l #\e)) "apple")
|
|
|
|
(let ([accum '()])
|
|
(test/unspec (string-for-each (lambda (a) (set! accum (cons a accum)))
|
|
"elppa"))
|
|
(test accum '(#\a #\p #\p #\l #\e))
|
|
(test/unspec (string-for-each (lambda (a b) (set! accum (cons (list a b) accum)))
|
|
"elppa"
|
|
"ananb"))
|
|
(test accum '((#\a #\b) (#\p #\n) (#\p #\a) (#\l #\n) (#\e #\a)
|
|
#\a #\p #\p #\l #\e))
|
|
(test/unspec (string-for-each (lambda (a b c) (set! accum c))
|
|
"elppa"
|
|
"ananb"
|
|
"chery"))
|
|
(test accum #\y))
|
|
|
|
(test "apple" (string-copy "apple"))
|
|
(let ([s "apple"])
|
|
(test (eq? s (string-copy s)) #f))
|
|
|
|
;; 11.13
|
|
(test (vector? '#(1 2 3)) #t)
|
|
(test (vector? "apple") #f)
|
|
|
|
(test (vector-length (make-vector 10)) 10)
|
|
(test (vector-length (make-vector 10 'x)) 10)
|
|
(test (vector-ref (make-vector 10 'x) 0) 'x)
|
|
(test (vector-ref (make-vector 10 'x) 5) 'x)
|
|
(test (vector-ref (make-vector 10 'x) 9) 'x)
|
|
|
|
(test '#(0 (2 2 2 2) "Anna") (vector 0 '(2 2 2 2) "Anna"))
|
|
(test (vector 'a 'b 'c) '#(a b c))
|
|
(test (vector-ref '#(1 1 2 3 5 8 13 21) 5) 8)
|
|
|
|
(test (let ((vec (vector 0 '(2 2 2 2) "Anna")))
|
|
(vector-set! vec 1 '("Sue" "Sue"))
|
|
vec)
|
|
'#(0 ("Sue" "Sue") "Anna"))
|
|
|
|
(test/unspec-or-exn (vector-set! '#(0 1 2) 1 "doe") &assertion)
|
|
|
|
(test (vector->list '#(dah dah didah)) '(dah dah didah))
|
|
(test (list->vector '(dididit dah)) '#(dididit dah))
|
|
|
|
(let ([vec (vector 'x 'y 'z)])
|
|
(vector-fill! vec 10.1)
|
|
(test vec '#(10.1 10.1 10.1)))
|
|
|
|
(test (vector-map (lambda (x) (+ 1 x))
|
|
'#(1 2 3))
|
|
'#(2 3 4))
|
|
(test (vector-map (lambda (x y) (- x y))
|
|
'#(3 4 5)
|
|
'#(0 -1 2))
|
|
'#(3 5 3))
|
|
(test (vector-map (lambda (x y f) (f (- x y)))
|
|
'#(3 4 5)
|
|
'#(0 -1 2)
|
|
(vector - * /))
|
|
'#(-3 5 1/3))
|
|
|
|
(let ([accum '()])
|
|
(test/unspec (vector-for-each (lambda (a) (set! accum (cons a accum)))
|
|
'#(e l p p a)))
|
|
(test accum '(a p p l e))
|
|
(test/unspec (vector-for-each (lambda (a b) (set! accum (cons (list a b) accum)))
|
|
'#(e l p p a)
|
|
'#(a n a n b)))
|
|
(test accum '((a b) (p n) (p a) (l n) (e a)
|
|
a p p l e))
|
|
(test/unspec (vector-for-each (lambda (a b c) (set! accum c))
|
|
'#(e l p p a)
|
|
'#(a n a n b)
|
|
'#(c h e r y)))
|
|
(test accum 'y))
|
|
|
|
;; 11.14
|
|
(for-each
|
|
(lambda (error)
|
|
(test/exn (error 'apple "bad" 'worm) &who)
|
|
(test/exn (error #f "bad" 'worm) &message)
|
|
(test/exn (error 'apple "bad" 'worm) &irritants)
|
|
(test/exn (error 'apple "bad") &irritants))
|
|
(list error assertion-violation))
|
|
(test/exn (error 'apple "bad" 'worm) &error)
|
|
(test/exn (assertion-violation 'apple "bad" 'worm) &assertion)
|
|
|
|
(test (condition-message
|
|
(guard (v [#t v])
|
|
(assertion-violation 'apple "bad" 'worm)))
|
|
"bad")
|
|
(test (condition-who
|
|
(guard (v [#t v])
|
|
(assertion-violation 'apple "bad" 'worm)))
|
|
'apple)
|
|
(test (condition-irritants
|
|
(guard (v [#t v])
|
|
(assertion-violation 'apple "bad" 'worm)))
|
|
'(worm))
|
|
(test (who-condition?
|
|
(guard (v [#t v])
|
|
(assertion-violation #f "bad" 'worm)))
|
|
#f)
|
|
(test (error?
|
|
(guard (v [#t v])
|
|
(assertion-violation #f "bad" 'worm)))
|
|
#f)
|
|
(test (error?
|
|
(guard (v [#t v])
|
|
(error #f "bad" 'worm)))
|
|
#t)
|
|
|
|
(test (fac 5) 120)
|
|
(test/exn (fac 4.5) &assertion)
|
|
(test/exn (fac -3) &assertion)
|
|
(test/exn (fac -3) &message)
|
|
|
|
;; 11.15
|
|
(test (apply + (list 3 4)) 7)
|
|
(test/approx ((compose sqrt *) 12 75) 30)
|
|
|
|
(test (call-with-current-continuation
|
|
(lambda (exit)
|
|
(for-each (lambda (x)
|
|
(if (negative? x)
|
|
(exit x)))
|
|
'(54 0 37 -3 245 19))
|
|
#t))
|
|
-3)
|
|
(test (call/cc
|
|
(lambda (exit)
|
|
(for-each (lambda (x)
|
|
(if (negative? x)
|
|
(exit x)))
|
|
'(54 0 37 -3 245 19))
|
|
#t))
|
|
-3)
|
|
|
|
(test (list-length '(1 2 3 4)) 4)
|
|
|
|
(test (list-length '(a b . c)) #f)
|
|
|
|
(test/values (values))
|
|
(test (values 1) 1)
|
|
(test/values (values 1 2 3) 1 2 3)
|
|
|
|
(test (call-with-current-continuation procedure?) #t)
|
|
|
|
(test (call-with-values (lambda () (values 4 5))
|
|
(lambda (a b) b))
|
|
5)
|
|
|
|
(test (call-with-values * -) -1)
|
|
|
|
(test (let ((path '())
|
|
(c #f))
|
|
(let ((add (lambda (s)
|
|
(set! path (cons s path)))))
|
|
(dynamic-wind
|
|
(lambda () (add 'connect))
|
|
(lambda ()
|
|
(add (call-with-current-continuation
|
|
(lambda (c0)
|
|
(set! c c0)
|
|
'talk1))))
|
|
(lambda () (add 'disconnect)))
|
|
(if (< (length path) 4)
|
|
(c 'talk2)
|
|
(reverse path))))
|
|
'(connect talk1 disconnect
|
|
connect talk2 disconnect))
|
|
|
|
(test (let ((n 0))
|
|
(call-with-current-continuation
|
|
(lambda (k)
|
|
(dynamic-wind
|
|
(lambda ()
|
|
(set! n (+ n 1))
|
|
(k))
|
|
(lambda ()
|
|
(set! n (+ n 2)))
|
|
(lambda ()
|
|
(set! n (+ n 4))))))
|
|
n)
|
|
1)
|
|
|
|
(test (let ((n 0))
|
|
(call-with-current-continuation
|
|
(lambda (k)
|
|
(dynamic-wind
|
|
values
|
|
(lambda ()
|
|
(dynamic-wind
|
|
values
|
|
(lambda ()
|
|
(set! n (+ n 1))
|
|
(k))
|
|
(lambda ()
|
|
(set! n (+ n 2))
|
|
(k))))
|
|
(lambda ()
|
|
(set! n (+ n 4))))))
|
|
n)
|
|
7)
|
|
|
|
;; 11.16
|
|
(test (let loop ((numbers '(3 -2 1 6 -5))
|
|
(nonneg '())
|
|
(neg '()))
|
|
(cond ((null? numbers) (list nonneg neg))
|
|
((>= (car numbers) 0)
|
|
(loop (cdr numbers)
|
|
(cons (car numbers) nonneg)
|
|
neg))
|
|
((< (car numbers) 0)
|
|
(loop (cdr numbers)
|
|
nonneg
|
|
(cons (car numbers) neg)))))
|
|
'((6 1 3) (-5 -2)))
|
|
|
|
;; 11.17
|
|
(test `(list ,(+ 1 2) 4) '(list 3 4))
|
|
(test (let ((name 'a)) `(list ,name ',name))
|
|
'(list a (quote a)))
|
|
(test `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b)
|
|
'(a 3 4 5 6 b))
|
|
|
|
(test `((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons)))
|
|
'((foo 7) . cons))
|
|
(test `#(10 5 ,(- 4) ,@(map - '(16 9)) 8)
|
|
'#(10 5 -4 -16 -9 8))
|
|
(test (let ((name 'foo))
|
|
`((unquote name name name)))
|
|
'(foo foo foo))
|
|
(test (let ((name '(foo)))
|
|
`((unquote-splicing name name name)))
|
|
'(foo foo foo))
|
|
(test (let ((q '((append x y) (sqrt 9))))
|
|
``(foo ,,@q))
|
|
'`(foo (unquote (append x y) (sqrt 9))))
|
|
(test (let ((x '(2 3))
|
|
(y '(4 5)))
|
|
`(foo (unquote (append x y) (- 9))))
|
|
'(foo (2 3 4 5) -9))
|
|
|
|
(test `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f)
|
|
'(a `(b ,(+ 1 2) ,(foo 4 d) e) f))
|
|
(test (let ((name1 'x)
|
|
(name2 'y))
|
|
`(a `(b ,,name1 ,',name2 d) e))
|
|
'(a `(b ,x ,'y d) e))
|
|
|
|
(test (let ((a 3)) `((1 2) ,a ,4 ,'five 6))
|
|
'((1 2) 3 4 five 6))
|
|
(test (let ((a 3)) `((1 2) ,a ,4 ,'five 6))
|
|
(let ((a 3))
|
|
(cons '(1 2)
|
|
(cons a (cons 4 (cons 'five '(6)))))))
|
|
|
|
;; 11.18
|
|
(test (let-syntax ((when (syntax-rules ()
|
|
((when test stmt1 stmt2 ...)
|
|
(if test
|
|
(begin stmt1
|
|
stmt2 ...))))))
|
|
(let ((if #t))
|
|
(when if (set! if 'now))
|
|
if))
|
|
'now)
|
|
|
|
(test (let ((x 'outer))
|
|
(let-syntax ((m (syntax-rules () ((m) x))))
|
|
(let ((x 'inner))
|
|
(m))))
|
|
'outer)
|
|
|
|
(test (let ()
|
|
(let-syntax ((def (syntax-rules ()
|
|
((def stuff ...) (define stuff ...)))))
|
|
(def foo 42))
|
|
foo)
|
|
42)
|
|
|
|
(test (let ()
|
|
(let-syntax ())
|
|
5)
|
|
5)
|
|
|
|
(test (letrec-syntax
|
|
((my-or (syntax-rules ()
|
|
((my-or) #f)
|
|
((my-or e) e)
|
|
((my-or e1 e2 ...)
|
|
(let ((temp e1))
|
|
(if temp
|
|
temp
|
|
(my-or e2 ...)))))))
|
|
(let ((x #f)
|
|
(y 7)
|
|
(temp 8)
|
|
(let odd?)
|
|
(if even?))
|
|
(my-or x
|
|
(let temp)
|
|
(if y)
|
|
y)))
|
|
7)
|
|
|
|
(test (let ((f (lambda (x) (+ x 1))))
|
|
(let-syntax ((f (syntax-rules ()
|
|
((f x) x)))
|
|
(g (syntax-rules ()
|
|
((g x) (f x)))))
|
|
(list (f 1) (g 1))))
|
|
'(1 2))
|
|
|
|
(test (let ((f (lambda (x) (+ x 1))))
|
|
(letrec-syntax ((f (syntax-rules ()
|
|
((f x) x)))
|
|
(g (syntax-rules ()
|
|
((g x) (f x)))))
|
|
(list (f 1) (g 1))))
|
|
'(1 1))
|
|
|
|
(test (sequence 1 2 3 4) 4)
|
|
|
|
(test (let ((=> #f))
|
|
(cond (#t => 'ok)))
|
|
'ok)
|
|
|
|
(test p.car 4)
|
|
; (test/exn (set! p.car 15) &syntax) - not a runtime test
|
|
|
|
(test/unspec (set! p2.car 15))
|
|
(test p2.car 15)
|
|
(test p '(15 . 5))
|
|
|
|
(test (kons 1 2) '(1 . 2))
|
|
|
|
;;;
|
|
))
|