From 369a4b01fb3edc46c35c9ed820f54294c60196fa Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Fri, 2 Nov 2012 00:04:32 +0900 Subject: [PATCH] Updating R7RS tests. --- tests/r7rs-tests.scm | 739 ++++++++++++++++++++++++++++++++++++++----- 1 file changed, 665 insertions(+), 74 deletions(-) diff --git a/tests/r7rs-tests.scm b/tests/r7rs-tests.scm index dafb7ac9..18e40317 100644 --- a/tests/r7rs-tests.scm +++ b/tests/r7rs-tests.scm @@ -1,7 +1,9 @@ +;; -*- coding: utf-8 -*- (import (scheme base) (scheme char) (scheme division) (scheme lazy) (scheme inexact) (scheme complex) (scheme time) (scheme eval) (scheme file) (scheme read) (scheme write) (scheme case-lambda) + (scheme process-context) (chibi test)) (test-begin "r7rs") @@ -305,6 +307,11 @@ ;; (string=? (symbol->string \vari{obj}) ;; (symbol->string \varii{obj}))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 6 Standard Procedures + +;; 6.1 Equivalence Predicates + (test #t (eqv? 'a 'a)) (test #f (eqv? 'a 'b)) (test #t (eqv? 2 2)) @@ -386,6 +393,8 @@ ;; (test \unspecified (equal? (lambda (x) x) ;; (lambda (y) y))) +;; 6.2 Numbers + (test #t (complex? 3+4i)) (test #t (complex? 3)) (test #t (real? 3)) @@ -410,15 +419,72 @@ (test #t (finite? 3)) (test #f (finite? +inf.0)) -;; (test #f (finite? 3.0+inf.0i)) +(test #f (finite? 3.0+inf.0i)) + +(test #f (infinite? 3)) +(test #t (infinite? +inf.0)) +(test #f (infinite? +nan.0)) +(test #t (infinite? 3.0+inf.0i)) (test #t (nan? +nan.0)) (test #f (nan? 32)) ;; (test #t (nan? +nan.0+5.0i)) (test #f (nan? 1+2i)) -(test 4 (max 3 4)) ; exact -(test 4.0 (max 3.9 4)) ; inexact% +(test #t (= 1 1.0 1.0+0.0i)) +(test #f (= 1.0 1.0+1.0i)) +(test #t (< 1 2 3)) +(test #f (< 1 1 2)) +(test #t (> 3.0 2.0 1.0)) +(test #f (> -3.0 2.0 1.0)) +(test #t (<= 1 1 2)) +(test #f (<= 1 2 1)) +(test #t (>= 2 1 1)) +(test #f (>= 1 2 1)) + +(test #t (zero? 0)) +(test #t (zero? 0.0)) +(test #t (zero? 0.0+0.0i)) +(test #f (zero? 1)) +(test #f (zero? -1)) + +(test #f (positive? 0)) +(test #f (positive? 0.0)) +(test #t (positive? 1)) +(test #t (positive? 1.0)) +(test #f (positive? -1)) +(test #f (positive? -1.0)) +(test #t (positive? +inf.0)) +(test #f (positive? -inf.0)) + +(test #f (negative? 0)) +(test #f (negative? 0.0)) +(test #f (negative? 1)) +(test #f (negative? 1.0)) +(test #t (negative? -1)) +(test #t (negative? -1.0)) +(test #f (negative? +inf.0)) +(test #t (negative? -inf.0)) + +(test #f (odd? 0)) +(test #t (odd? 1)) +(test #t (odd? -1)) +(test #f (odd? 102)) + +(test #t (even? 0)) +(test #f (even? 1)) +(test #t (even? -2)) +(test #t (even? 102)) + +(test 3 (max 3)) +(test 4 (max 3 4)) +(test 4.0 (max 3.9 4)) +(test 5.0 (max 5 3.9 4)) +(test +inf.0 (max 100 +inf.0)) +(test 3 (min 3)) +(test 3 (min 3 4)) +(test 3.0 (min 3 3.1)) +(test -inf.0 (min -inf.0 -100)) (test 7 (+ 3 4)) (test 3 (+ 3)) @@ -433,6 +499,7 @@ (test 1/3 (/ 3)) (test 7 (abs -7)) +(test 7 (abs 7)) ;; (test \vr (\hyper{operator}/ \vri{n} \vrii{n})) ;; {n_r} @@ -445,6 +512,16 @@ ;; (= \vri{n} (+ (* \vrii{n} (\hyper{operator}-quotient \vri{n} \vrii{n})) ;; (\hyper{operator}-remainder \vri{n} \vrii{n})))) +(test-values (values 2 1) (floor/ 5 2)) +(test-values (values -3 1) (floor/ -5 2)) +(test-values (values -3 -1) (floor/ 5 -2)) +(test-values (values 2 -1) (floor/ -5 -2)) +(test-values (values 2 1) (truncate/ 5 2)) +(test-values (values -2 -1) (truncate/ -5 2)) +(test-values (values -2 1) (truncate/ 5 -2)) +(test-values (values 2 -1) (truncate/ -5 -2)) +(test-values (values 2.0 -1.0) (truncate/ -5.0 -2)) + (test 1 (modulo 13 4)) (test 1 (remainder 13 4)) @@ -487,31 +564,55 @@ (exact .3) 1/10)) ; exact ;; (test #i1/3 (rationalize .3 1/10)) ; inexact% +(test 0.0 (atan 0.0 1.0)) +(test -0.0 (atan -0.0 1.0)) +(test 0.785398163397448 (atan 1.0 1.0)) +(test 1.5707963267949 (atan 1.0 0.0)) +(test 2.35619449019234 (atan 1.0 -1.0)) +(test 3.14159265358979 (atan 0.0 -1.0)) +(test -3.14159265358979 (atan -0.0 -1.0)) ; +(test -2.35619449019234 (atan -1.0 -1.0)) +(test -1.5707963267949 (atan -1.0 0.0)) +(test -0.785398163397448 (atan -1.0 1.0)) +;;(test undefined (atan 0.0 0.0)) + +(test 1764 (square 42)) +(test 4.0 (square 2)) + +(test +i (sqrt -1)) + (test '(2 0) (call-with-values (lambda () (exact-integer-sqrt 4)) list)) (test '(2 1) (call-with-values (lambda () (exact-integer-sqrt 5)) list)) -;; (test \vr (make-rectangular \vri{x} \vrii{x})) -;; {z} -;; (test \vr (make-polar \vriii{x} \vriv{x})) -;; {z} -;; (test \vri (real-part \vr{z})) -;; {x} -;; (test \vrii (imag-part \vr{z})) -;; {x} -;; (test $ (magnitude \vr{z})) -;; $ -;; (test $x_ (angle \vr{z})) -;; (let ((number \vr{number}) -;; (radix \vr{radix})) -;; (eqv? number -;; (string->number (number->string number -;; radix) -;; radix))) +(test 27 (expt 3 3)) +(test 1 (expt 0 0)) +(test 0 (expt 0 1)) +(test 1.0 (expt 0.0 0)) +(test 0.0 (expt 0 1.0)) + +(test 1+2i (make-rectangular 1 2)) + +(test 0.54030230586814+0.841470984807897i (make-polar 1 1)) + +(test 1 (real-part 1+2i)) + +(test 2 (imag-part 1+2i)) + +(test 2.23606797749979 (magnitude 1+2i)) + +(test 1.10714871779409 (angle 1+2i)) + +(test 1.0 (inexact 1)) +(test #t (inexact? (inexact 1))) +(test 1 (exact 1.0)) +(test #t (exact? (exact 1.0))) (test 100 (string->number "100")) (test 256 (string->number "100" 16)) (test 100.0 (string->number "1e2")) +;; 6.3 Booleans + (test #t #t) (test #f #f) (test #f '#f) @@ -527,16 +628,23 @@ (test #t (boolean? #f)) (test #f (boolean? 0)) (test #f (boolean? '())) -;; (define y x) -;; (test '(a b c) y) -;; (test #t (list? y)) -;; (test \unspecified (set-cdr! x 4)) -;; (test '(a . 4) x) -;; (test #t (eqv? x y)) -;; (test '(a . 4) y) -;; (test #f (list? y)) -;; (test \unspecified (set-cdr! x x)) -;; (test #f (list? x)) + +(test #t (boolean=? #t #t)) +(test #t (boolean=? #f #f)) +(test #f (boolean=? #t #f)) + +;; 6.4 Lists + +(let* ((x (list 'a 'b 'c)) + (y x)) + (test '(a b c) (values y)) + (test #t (list? y)) + (set-cdr! x 4) + (test '(a . 4) (values x)) + (test #t (eqv? x y)) + (test #f (list? y)) + (set-cdr! x x) + (test #f (list? x))) (test #t (pair? '(a . b))) (test #t (pair? '(a b c))) @@ -585,6 +693,8 @@ (test '(c b a) (reverse '(a b c))) (test '((e (f)) d (b c) a) (reverse '(a (b c) d (e (f))))) +(test '(d e) (list-tail '(a b c d e) 3)) + (test 'c (list-ref '(a b c d) 2)) (test 'c (list-ref '(a b c d) (exact (round 1.8)))) @@ -622,6 +732,10 @@ (test '(5 7) (assv 5 '((2 3) (5 7) (11 13)))) +(test '(1 2 3) (list-copy '(1 2 3))) + +;; 6.5 Symbols + (test #t (symbol? 'foo)) (test #t (symbol? (car '(a b)))) (test #f (symbol? "bar")) @@ -629,6 +743,9 @@ (test #f (symbol? '())) (test #f (symbol? #f)) +(test #t (symbol=? 'a 'a)) +(test #f (symbol=? 'a 'A)) + (test "flying-fish" (symbol->string 'flying-fish)) (test "Martin" (symbol->string 'Martin)) @@ -636,26 +753,239 @@ (test 'mISSISSIppi (string->symbol "mISSISSIppi")) (test #t (eq? 'bitBlt (string->symbol "bitBlt"))) -(test #t (eq? 'JollyWog (string->symbol (symbol->string 'JollyWog)))) +(test #t (eq? 'LollyPop (string->symbol (symbol->string 'LollyPop)))) (test #t (string=? "K. Harper, M.D." (symbol->string (string->symbol "K. Harper, M.D.")))) -;; (test 3 (digit-value #\backwhack{}3)) -;; (test 4 (digit-value #\backwhack{}x0664)) -;; (test 0 (digit-value #\backwhack{}x0EA6)) -;; (define (g) "***") -;; (test \unspecified (string-set! (f) 0 #\backwhack{}?)) -;; (test \scherror (string-set! (g) 0 #\backwhack{}?)) -;; (test \scherror (string-set! (symbol->string 'immutable) -;; 0 -;; #\backwhack{}?)) +;; 6.6 Characters + +(test #t (char? #\a)) +(test #f (char? "a")) +(test #f (char? 'a)) +(test #f (char? 0)) + +(test #t (char=? #\a #\a)) +(test #f (char=? #\a #\A)) +(test #t (char? #\a #\b)) +(test #f (char>? #\a #\a)) +(test #t (char>? #\b #\a)) +(test #t (char<=? #\a #\b)) +(test #t (char<=? #\a #\a)) +(test #f (char<=? #\b #\a)) +(test #f (char>=? #\a #\b)) +(test #t (char>=? #\a #\a)) +(test #t (char>=? #\b #\a)) + +(test #t (char-ci=? #\a #\a)) +(test #t (char-ci=? #\a #\A)) +(test #f (char-ci=? #\a #\b)) +(test #t (char-ci? #\A #\b)) +(test #f (char-ci>? #\a #\A)) +(test #t (char-ci>? #\B #\a)) +(test #t (char-ci<=? #\a #\B)) +(test #t (char-ci<=? #\A #\a)) +(test #f (char-ci<=? #\b #\A)) +(test #f (char-ci>=? #\A #\b)) +(test #t (char-ci>=? #\a #\A)) +(test #t (char-ci>=? #\B #\a)) + +(test #t (char-alphabetic? #\a)) +(test #f (char-alphabetic? #\space)) +(test #t (char-numeric? #\0)) +(test #f (char-numeric? #\.)) +(test #f (char-numeric? #\a)) +(test #t (char-whitespace? #\space)) +(test #t (char-whitespace? #\tab)) +(test #t (char-whitespace? #\newline)) +(test #f (char-whitespace? #\_)) +(test #f (char-whitespace? #\a)) +(test #t (char-upper-case? #\A)) +(test #f (char-upper-case? #\a)) +(test #f (char-upper-case? #\3)) +(test #t (char-lower-case? #\a)) +(test #f (char-lower-case? #\A)) +(test #f (char-lower-case? #\3)) + +(test 3 (digit-value #\3)) +;; (test 4 (digit-value #\x0664)) +;; (test 0 (digit-value #\x0EA6)) + +(test 97 (char->integer #\a)) +(test #\a (integer->char 97)) + +(test #\A (char-upcase #\a)) +(test #\A (char-upcase #\A)) +(test #\a (char-downcase #\a)) +(test #\a (char-downcase #\A)) +(test #\a (char-foldcase #\a)) +(test #\a (char-foldcase #\A)) + +(test #\Λ (char-upcase #\λ)) +(test #\Λ (char-upcase #\Λ)) +(test #\λ (char-downcase #\λ)) +(test #\λ (char-downcase #\Λ)) +(test #\λ (char-foldcase #\λ)) +(test #\λ (char-foldcase #\Λ)) + +;; 6.7 Strings + +(test #t (string? "")) +(test #t (string? " ")) +(test #f (string? 'a)) +(test #f (string? #\a)) + +(test 3 (string-length (make-string 3))) +(test "---" (make-string 3 #\-)) + +(test "" (string)) +(test "---" (string #\- #\- #\-)) +(test "kitten" (string #\k #\i #\t #\t #\e #\n)) + +(test 0 (string-length "")) +(test 1 (string-length "a")) +(test 3 (string-length "abc")) + +(test #\a (string-ref "abc" 0)) +(test #\b (string-ref "abc" 1)) +(test #\c (string-ref "abc" 2)) + +(test "a-c" (let ((str (string #\a #\b #\c))) (string-set! str 1 #\-) str)) + +(test #t (string=? "" "")) +(test #t (string=? "abc" "abc")) +(test #f (string=? "" "abc")) +(test #f (string=? "abc" "aBc")) + +(test #f (string? "" "")) +(test #f (string>? "abc" "abc")) +(test #f (string>? "abc" "abcd")) +(test #t (string>? "abcd" "abc")) +(test #f (string>? "abc" "bbc")) + +(test #t (string<=? "" "")) +(test #t (string<=? "abc" "abc")) +(test #t (string<=? "abc" "abcd")) +(test #f (string<=? "abcd" "abc")) +(test #t (string<=? "abc" "bbc")) + +(test #t (string>=? "" "")) +(test #t (string>=? "abc" "abc")) +(test #f (string>=? "abc" "abcd")) +(test #t (string>=? "abcd" "abc")) +(test #f (string>=? "abc" "bbc")) + +(test #t (string-ci=? "" "")) +(test #t (string-ci=? "abc" "abc")) +(test #f (string-ci=? "" "abc")) +(test #t (string-ci=? "abc" "aBc")) +(test #f (string-ci=? "abc" "aBcD")) + +(test #f (string-ci? "abc" "aBc")) +(test #f (string-ci>? "abc" "aBcD")) +(test #t (string-ci>? "ABCd" "aBc")) + +(test #t (string-ci<=? "abc" "aBc")) +(test #t (string-ci<=? "abc" "aBcD")) +(test #f (string-ci<=? "ABCd" "aBc")) + +(test #t (string-ci>=? "abc" "aBc")) +(test #f (string-ci>=? "abc" "aBcD")) +(test #t (string-ci>=? "ABCd" "aBc")) + +(test "ABC" (string-upcase "abc")) +(test "ABC" (string-upcase "ABC")) +(test "abc" (string-downcase "abc")) +(test "abc" (string-downcase "ABC")) +(test "abc" (string-foldcase "abc")) +(test "abc" (string-foldcase "ABC")) + +(test "ΑΒΓ" (string-upcase "αβγ")) +(test "ΑΒΓ" (string-upcase "ΑΒΓ")) +(test "αβγ" (string-downcase "αβγ")) +(test "αβγ" (string-downcase "ΑΒΓ")) +(test "αβγ" (string-foldcase "αβγ")) +(test "αβγ" (string-foldcase "ΑΒΓ")) + +(test "" (substring "" 0 0)) +(test "" (substring "a" 0 0)) +(test "" (substring "abc" 1 1)) +(test "ab" (substring "abc" 0 2)) +(test "bc" (substring "abc" 1 3)) + +(test "" (string-append "")) +(test "" (string-append "" "")) +(test "abc" (string-append "" "abc")) +(test "abc" (string-append "abc" "")) +(test "abcde" (string-append "abc" "de")) +(test "abcdef" (string-append "abc" "de" "f")) + +(test '() (string->list "")) +(test '(#\a) (string->list "a")) +(test '(#\a #\b #\c) (string->list "abc")) +(test '(#\a #\b #\c) (string->list "abc" 0)) +(test '(#\b #\c) (string->list "abc" 1)) +(test '(#\b #\c) (string->list "abc" 1 3)) + +(test "" (list->string '())) +(test "abc" (list->string '(#\a #\b #\c))) + +(test "" (string-copy "")) +(test "" (string-copy "" 0)) +(test "" (string-copy "" 0 0)) +(test "abc" (string-copy "abc")) +(test "abc" (string-copy "abc" 0)) +(test "bc" (string-copy "abc" 1)) +(test "b" (string-copy "abc" 1 2)) +(test "bc" (string-copy "abc" 1 3)) + +(test "-----" + (let ((str (make-string 5 #\x))) (string-fill! str #\-) str)) +(test "xx---" + (let ((str (make-string 5 #\x))) (string-fill! str #\- 2) str)) +(test "xx-xx" + (let ((str (make-string 5 #\x))) (string-fill! str #\- 2 3) str)) + +(test "a12de" + (let ((str (string-copy "abcde"))) (string-copy! str 1 "12345" 0 2) str)) +(test "-----" + (let ((str (make-string 5 #\x))) (string-copy! str 0 "-----") str)) +(test "---xx" + (let ((str (make-string 5 #\x))) (string-copy! str 0 "-----" 2) str)) +(test "xx---" + (let ((str (make-string 5 #\x))) (string-copy! str 2 "-----") str)) +(test "xx-xx" + (let ((str (make-string 5 #\x))) (string-copy! str 2 "-----" 2 3) str)) + +;; 6.8 Vectors + +(test #t (vector? #())) +(test #t (vector? #(1 2 3))) +(test #t (vector? '#(1 2 3))) + +(test 0 (vector-length (make-vector 0))) +(test 1000 (vector-length (make-vector 1000))) (test #(0 (2 2 2 2) "Anna") '#(0 (2 2 2 2) "Anna")) (test #(a b c) (vector 'a 'b 'c)) -(test 8 (vector-ref '#(1 1 2 3 5 8 13 21) - 5)) +(test 8 (vector-ref '#(1 1 2 3 5 8 13 21) 5)) (test 13 (vector-ref '#(1 1 2 3 5 8 13 21) (let ((i (round (* 2 (acos -1))))) (if (inexact? i) @@ -666,18 +996,115 @@ (vector-set! vec 1 '("Sue" "Sue")) vec)) -;; (test \scherror (vector-set! '#(0 1 2) 1 "doe")) ; constant vector% +(test-error (vector-set! '#(0 1 2) 1 "doe")) ; constant vector% (test '(dah dah didah) (vector->list '#(dah dah didah))) +(test '(dah didah) (vector->list '#(dah dah didah) 1)) +(test '(dah) (vector->list '#(dah dah didah) 1 2)) (test #(dididit dah) (list->vector '(dididit dah))) -;; (test #(#\backwhack{}A #\backwhack{}B #\backwhack{}C) (string->vector "ABC")) -;; vector->string -;; (test "123" #(#\backwhack{}1 #\backwhack{}2 #\backwhack{}3)) +(test #() (string->vector "")) +(test #(#\A #\B #\C) (string->vector "ABC")) +(test #(#\B #\C) (string->vector "ABC" 1)) +(test #(#\B) (string->vector "ABC" 1 2)) + +(test "" (vector->string #())) +(test "123" (vector->string #(#\1 #\2 #\3))) +(test "23" (vector->string #(#\1 #\2 #\3) 1)) +(test "2" (vector->string #(#\1 #\2 #\3) 1 2)) + +(test #() (vector-copy #())) +(test #(a b c) (vector-copy #(a b c))) +(test #(b c) (vector-copy #(a b c) 1)) +(test #(b) (vector-copy #(a b c) 1 2)) + +(test #() (vector-append #())) +(test #() (vector-append #() #())) +(test #(a b c) (vector-append #() #(a b c))) +(test #(a b c) (vector-append #(a b c) #())) +(test #(a b c d e) (vector-append #(a b c) #(d e))) +(test #(a b c d e f) (vector-append #(a b c) #(d e) #(f))) + +(test #(1 2 smash smash 5) + (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'smash 2 4) vec)) +(test #(x x x x x) + (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'x) vec)) +(test #(1 2 x x x) + (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'x 2) vec)) +(test #(1 2 x 4 5) + (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'x 2 3) vec)) + +(test #(1 a b 4 5) + (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 1 #(a b c d e) 0 2) vec)) +(test #(a b c d e) + (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 0 #(a b c d e)) vec)) +(test #(c d e 4 5) + (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 0 #(a b c d e) 2) vec)) +(test #(1 2 a b c) + (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 2 #(a b c d e)) vec)) +(test #(1 2 c 4 5) + (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 2 #(a b c d e) 2 3) vec)) + +;; 6.9 Bytevectors + +(test #t (bytevector? #u8())) +(test #t (bytevector? #u8(0 1 2))) +(test #f (bytevector? #())) +(test #f (bytevector? #(0 1 2))) +(test #f (bytevector? '())) +(test #t (bytevector? (make-bytevector 0))) + +(test 0 (bytevector-length (make-bytevector 0))) +(test 1024 (bytevector-length (make-bytevector 1024))) +(test 1024 (bytevector-length (make-bytevector 1024 255))) + +(test 3 (bytevector-length (bytevector 0 1 2))) + +(test 0 (bytevector-u8-ref (bytevector 0 1 2) 0)) +(test 1 (bytevector-u8-ref (bytevector 0 1 2) 1)) +(test 2 (bytevector-u8-ref (bytevector 0 1 2) 2)) + +(test #u8(0 255 2) + (let ((bv (bytevector 0 1 2))) (bytevector-u8-set! bv 1 255) bv)) + +(test #u8() (bytevector-copy #u8())) +(test #u8(0 1 2) (bytevector-copy #u8(0 1 2))) +(test #u8(1 2) (bytevector-copy #u8(0 1 2) 1)) +(test #u8(1) (bytevector-copy #u8(0 1 2) 1 2)) + +(test #u8(1 6 7 4 5) + (let ((bv (bytevector 1 2 3 4 5))) + (bytevector-copy! bv 1 #u8(6 7 8 9 10) 0 2) + bv)) +(test #u8(6 7 8 9 10) + (let ((bv (bytevector 1 2 3 4 5))) + (bytevector-copy! bv 0 #u8(6 7 8 9 10)) + bv)) +(test #u8(8 9 10 4 5) + (let ((bv (bytevector 1 2 3 4 5))) + (bytevector-copy! bv 0 #u8(6 7 8 9 10) 2) + bv)) +(test #u8(1 2 6 7 8) + (let ((bv (bytevector 1 2 3 4 5))) + (bytevector-copy! bv 2 #u8(6 7 8 9 10)) + bv)) +(test #u8(1 2 8 4 5) + (let ((bv (bytevector 1 2 3 4 5))) + (bytevector-copy! bv 2 #u8(6 7 8 9 10) 2 3) + bv)) + +(test #u8() (bytevector-append #u8())) +(test #u8() (bytevector-append #u8() #u8())) +(test #u8(0 1 2) (bytevector-append #u8() #u8(0 1 2))) +(test #u8(0 1 2) (bytevector-append #u8(0 1 2) #u8())) +(test #u8(0 1 2 3 4) (bytevector-append #u8(0 1 2) #u8(3 4))) +(test #u8(0 1 2 3 4 5) (bytevector-append #u8(0 1 2) #u8(3 4) #u8(5))) (test "A" (utf8->string #u8(#x41))) (test #u8(#xCE #xBB) (string->utf8 "λ")) +;; 6.10 Control Features + (test #t (procedure? car)) (test #f (procedure? 'car)) (test #t (procedure? (lambda (x) (* x x)))) @@ -685,11 +1112,11 @@ (test #t (call-with-current-continuation procedure?)) (test 7 (apply + (list 3 4))) + (define compose (lambda (f g) (lambda args (f (apply g args))))) - (test 30 ((compose sqrt *) 12 75)) (test '(b e h) (map cadr '((a b) (d e) (g h)))) @@ -699,11 +1126,12 @@ (test '(5 7 9) (map + '(1 2 3) '(4 5 6 7))) -(test '(1 2) (let ((count 0)) - (map (lambda (ignored) - (set! count (+ count 1)) - count) - '(a b)))) +(test '(1 2) ; or '(2 1) + (let ((count 0)) + (map (lambda (ignored) + (set! count (+ count 1)) + count) + '(a b)))) (test "abdegh" (string-map char-foldcase "AbdEgH")) @@ -778,39 +1206,199 @@ ;; (lambda (cont) (apply cont things)))) (test 5 -(call-with-values (lambda () (values 4 5)) - (lambda (a b) b))) + (call-with-values (lambda () (values 4 5)) + (lambda (a b) b))) (test -1 (call-with-values * -)) (test '(connect talk1 disconnect - connect talk2 disconnect) -(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 talk2 disconnect) + (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))))) -(test 21 (eval '(* 7 3) (scheme-report-environment 7))) +;; 6.11 Exceptions + +(test 65 + (with-exception-handler + (lambda (con) 42) + (lambda () + (+ (raise-continuable "should be a number") + 23)))) + +(test #t + (error-object? (guard (exn (else exn)) (error "BOOM!" 1 2 3)))) +(test "BOOM!" + (error-object-message (guard (exn (else exn)) (error "BOOM!" 1 2 3)))) +(test '(1 2 3) + (error-object-irritants (guard (exn (else exn)) (error "BOOM!" 1 2 3)))) + +(test #f + (file-error? (guard (exn (else exn)) (error "BOOM!")))) +(test #t + (file-error? (guard (exn (else exn)) (open-input-file " no such file ")))) + +(test #f + (read-error? (guard (exn (else exn)) (error "BOOM!")))) +(test #t + (read-error? (guard (exn (else exn)) (read (open-input-string ")"))))) + +;; 6.12 Environments and evaluation + +(test 21 (eval '(* 7 3) (scheme-report-environment 5))) (test 20 -(let ((f (eval '(lambda (f x) (f x x)) - (null-environment 7)))) - (f + 10))) + (let ((f (eval '(lambda (f x) (f x x)) (null-environment 5)))) + (f + 10))) + +;; 6.13 Input and output + +(test #t (port? (current-input-port))) +(test #t (input-port? (current-input-port))) +(test #t (output-port? (current-output-port))) +(test #t (output-port? (current-error-port))) +(test #t (input-port? (open-input-string "abc"))) +(test #t (output-port? (open-output-string))) + +(test #t (textual-port? (open-input-string "abc"))) +(test #t (textual-port? (open-output-string))) +(test #t (binary-port? (open-input-bytevector #u8(0 1 2)))) +(test #t (binary-port? (open-output-bytevector))) + +(test #t (input-port-open? (open-input-string "abc"))) +(test #t (output-port-open? (open-output-string))) + +(test #f + (let ((in (open-input-string "abc"))) + (close-input-port in) + (input-port-open? in))) + +(test #f + (let ((out (open-output-string))) + (close-output-port out) + (output-port-open? out))) + +(test #f + (let ((out (open-output-string))) + (close-port out) + (output-port-open? out))) + +(test #t (eof-object? (read (open-input-string "")))) +(test 42 (read (open-input-string " 42 "))) + +(test #t (eof-object? (read-char (open-input-string "")))) +(test #\a (read-char (open-input-string "abc"))) + +(test #t (eof-object? (read-line (open-input-string "")))) +(test "abc" (read-line (open-input-string "abc"))) +(test "abc" (read-line (open-input-string "abc\ndef\n"))) + +(test #t (eof-object? (read-string 3 (open-input-string "")))) +(test "abc" (read-string 3 (open-input-string "abcd"))) +(test "abc" (read-string 3 (open-input-string "abc\ndef\n"))) + +(test "abc" + (let ((out (open-output-string))) + (write 'abc out) + (get-output-string out))) + +(test #t (eof-object? (read-u8 (open-input-bytevector #u8())))) +(test 1 (read-u8 (open-input-bytevector #u8(1 2 3)))) + +(test #t (eof-object? (read-bytevector 3 (open-input-bytevector #u8())))) +(test #u8(1) (read-bytevector 3 (open-input-bytevector #u8(1)))) +(test #u8(1 2) (read-bytevector 3 (open-input-bytevector #u8(1 2)))) +(test #u8(1 2 3) (read-bytevector 3 (open-input-bytevector #u8(1 2 3)))) +(test #u8(1 2 3) (read-bytevector 3 (open-input-bytevector #u8(1 2 3 4)))) + +(test #u8(6 7 8 9 10) + (let ((bv (bytevector 1 2 3 4 5))) + (read-bytevector! bv 0 5 (open-input-bytevector #u8(6 7 8 9 10))) + bv)) + +(test #u8(6 7 8 4 5) + (let ((bv (bytevector 1 2 3 4 5))) + (read-bytevector! bv 0 3 (open-input-bytevector #u8(6 7 8 9 10))) + bv)) + +(test #u8(1 2 3 6 5) + (let ((bv (bytevector 1 2 3 4 5))) + (read-bytevector! bv 3 4 (open-input-bytevector #u8(6 7 8 9 10))) + bv)) + +(test #u8(1 2 3) + (let ((out (open-output-bytevector))) + (write-u8 1 out) + (write-u8 2 out) + (write-u8 3 out) + (get-output-bytevector out))) + +(test #t (read (open-input-string "#t"))) +(test #t (read (open-input-string "#true"))) +(test #f (read (open-input-string "#f"))) +(test #f (read (open-input-string "#false"))) + +(test '() (read (open-input-string "()"))) +(test '(1 2) (read (open-input-string "(1 2)"))) +(test '(1 . 2) (read (open-input-string "(1 . 2)"))) +(test '(1 2) (read (open-input-string "(1 . (2))"))) +(test '(1 2 3 4 5) (read (open-input-string "(1 . (2 3 4 . (5)))"))) + +(test 'abc (read (open-input-string "abc"))) +(test 'abc (read (open-input-string "abc def"))) +(test 'ABC (read (open-input-string "ABC"))) +(test 'Hello (read (open-input-string "|H\\x65;llo|"))) + +(test #\a (read (open-input-string "#\\a"))) +(test #\space (read (open-input-string "#\\space"))) +(test #\alarm (read (open-input-string "#\\alarm"))) +(test #\λ (read (open-input-string "#\\x03BB"))) + +(test "abc" (read (open-input-string "\"abc\""))) +(test "abc" (read (open-input-string "\"abc\" \"def\""))) +(test "ABC" (read (open-input-string "\"ABC\""))) +(test "Hello" (read (open-input-string "\"H\\x65;llo\""))) +(test "line 1\nline 2\n" (read (open-input-string "\"line 1\nline 2\n\""))) + +;; 6.14 System interface ;; (test "/usr/local/bin:/usr/bin:/bin" (get-environment-variable "PATH")) +(test #t (string? (get-environment-variable "PATH"))) + ;; (test '(("USER" . "root") ("HOME" . "/")) (get-environment-variables)) + +(let ((env (get-environment-variables))) + (define (env-pair? x) + (and (pair? x) (string? (car x)) (string? (cdr x)))) + (define (all? pred ls) + (or (null? ls) (and (pred (car ls)) (all? pred (cdr ls))))) + (test #t (list? env)) + (test #t (all? env-pair? env))) + +(test #t (list? (command-line))) + +(test #t (real? (current-second))) +(test #t (inexact? (current-second))) +(test #t (exact? (current-jiffy))) +(test #t (exact? (jiffies-per-second))) + +(test #t (list? (features))) + +;; Definitions + (define add3 (lambda (x) (+ x 3))) (test 6 (add3 3)) @@ -835,6 +1423,9 @@ (set! b tmp))))) (swap! x y) (list x y))) + +;; Records + (define-record-type (kons x y) pare?