Author: yamakenz Date: Fri Jul 20 07:48:59 2007 New Revision: 4756 Added: vendor/misc/r4rstest.scm Modified: vendor/misc/README
Log: * vendor/misc/r4rstest.scm - New file imported from http://cvs.savannah.gnu.org/viewvc/*checkout*/scm/scm/r4rstest.scm?revision=HEAD * vendor/misc/README - Add entry for r4rstest.scm Modified: vendor/misc/README ============================================================================== --- vendor/misc/README (original) +++ vendor/misc/README Fri Jul 20 07:48:59 2007 @@ -64,3 +64,25 @@ created January 8, 1999 last revised January 13, 1999 ------------------------------------------------------------------------------ +File: r4rstest.scm +URL: http://cvs.savannah.gnu.org/viewvc/*checkout*/scm/scm/r4rstest.scm?revision=HEAD +Revision: 1.47 +License type: GPL2 +License terms: + Copyright (C) 1991, 1992, 1993, 1994, 1995, 2000, 2003, 2004, 2006, 2007 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by the + Free Software Foundation; either version 2, or (at your option) any + later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + To receive a copy of the GNU General Public License, write to the + Free Software Foundation, Inc., 59 Temple Place - Suite 330, + Boston, MA 02111-1307, USA; or view + http://swiss.csail.mit.edu/~jaffer/GPL.html +------------------------------------------------------------------------------ Added: vendor/misc/r4rstest.scm ============================================================================== --- (empty file) +++ vendor/misc/r4rstest.scm Fri Jul 20 07:48:59 2007 @@ -0,0 +1,1307 @@ +;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 2000, 2003, 2004, 2006, 2007 Free Software Foundation, Inc. +;; +;; This program is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by the +;; Free Software Foundation; either version 2, or (at your option) any +;; later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; To receive a copy of the GNU General Public License, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA; or view +;; http://swiss.csail.mit.edu/~jaffer/GPL.html + +;;;;"r4rstest.scm": Test R4RS correctness of scheme implementations. +;;; Author: Aubrey Jaffer +;;; Home-page: http://swiss.csail.mit.edu/~jaffer/Scheme +;;; Current version: http://swiss.csail.mit.edu/ftpdir/scm/r4rstest.scm +;;; CVS Head: +;;; http://savannah.gnu.org/cgi-bin/viewcvs/scm/scm/r4rstest.scm?rev=HEAD&only_with_tag=HEAD&content-type=text/vnd.viewcvs-markup + +;;; This includes examples from +;;; William Clinger and Jonathan Rees, editors. +;;; Revised^4 Report on the Algorithmic Language Scheme +;;; and the IEEE specification. + +;;; The input tests read this file expecting it to be named "r4rstest.scm". +;;; Files `tmp1', `tmp2' and `tmp3' will be created in the course of running +;;; these tests. You may need to delete them in order to run +;;; "r4rstest.scm" more than once. + +;;; There are three optional tests: +;;; (TEST-CONT) tests multiple returns from call-with-current-continuation +;;; +;;; (TEST-SC4) tests procedures required by R4RS but not by IEEE +;;; +;;; (TEST-DELAY) tests DELAY and FORCE, which are not required by +;;; either standard. + +;;; If you are testing a R3RS version which does not have `list?' do: +;;; (define list? #f) + +;;; send corrections or additions to agj @ alum.mit.edu + +(define cur-section '())(define errs '()) +(define SECTION (lambda args + (display "SECTION") (write args) (newline) + (set! cur-section args) #t)) +(define record-error (lambda (e) (set! errs (cons (list cur-section e) errs)))) + +(define test + (lambda (expect fun . args) + (write (cons fun args)) + (display " ==> ") + ((lambda (res) + (write res) + (newline) + (cond ((not (equal? expect res)) + (record-error (list res expect (cons fun args))) + (display " BUT EXPECTED ") + (write expect) + (newline) + #f) + (else #t))) + (if (procedure? fun) (apply fun args) (car args))))) +(define (report-errs) + (newline) + (if (null? errs) (display "Passed all tests") + (begin + (display "errors were:") + (newline) + (display "(SECTION (got expected (call)))") + (newline) + (for-each (lambda (l) (write l) (newline)) + errs))) + (newline)) + +(SECTION 2 1);; test that all symbol characters are supported. +'(+ - ... !.. $.+ %.- &.! *.: /:. :+. <-. =. >. ?. ~. _. ^.) + +(SECTION 3 4) +(define disjoint-type-functions + (list boolean? char? null? number? pair? procedure? string? symbol? vector?)) +(define type-examples + (list + #t #f #\a '() 9739 '(test) record-error "test" "" 'test '#() '#(a b c) )) +(define i 1) +(for-each (lambda (x) (display (make-string i #\space)) + (set! i (+ 3 i)) + (write x) + (newline)) + disjoint-type-functions) +(define type-matrix + (map (lambda (x) + (let ((t (map (lambda (f) (f x)) disjoint-type-functions))) + (write t) + (write x) + (newline) + t)) + type-examples)) +(set! i 0) +(define j 0) +(for-each (lambda (x y) + (set! j (+ 1 j)) + (set! i 0) + (for-each (lambda (f) + (set! i (+ 1 i)) + (cond ((and (= i j)) + (cond ((not (f x)) (test #t f x)))) + ((f x) (test #f f x))) + (cond ((and (= i j)) + (cond ((not (f y)) (test #t f y)))) + ((f y) (test #f f y)))) + disjoint-type-functions)) + (list #t #\a '() 9739 '(test) record-error "test" 'car '#(a b c)) + (list #f #\newline '() -3252 '(t . t) car "" 'nil '#())) +(SECTION 4 1 2) +(test '(quote a) 'quote (quote 'a)) +(test '(quote a) 'quote ''a) +(SECTION 4 1 3) +(test 12 (if #f + *) 3 4) +(SECTION 4 1 4) +(test 8 (lambda (x) (+ x x)) 4) +(define reverse-subtract + (lambda (x y) (- y x))) +(test 3 reverse-subtract 7 10) +(define add4 + (let ((x 4)) + (lambda (y) (+ x y)))) +(test 10 add4 6) +(test '(3 4 5 6) (lambda x x) 3 4 5 6) +(test '(5 6) (lambda (x y . z) z) 3 4 5 6) +(SECTION 4 1 5) +(test 'yes 'if (if (> 3 2) 'yes 'no)) +(test 'no 'if (if (> 2 3) 'yes 'no)) +(test '1 'if (if (> 3 2) (- 3 2) (+ 3 2))) +(SECTION 4 1 6) +(define x 2) +(test 3 'define (+ x 1)) +(set! x 4) +(test 5 'set! (+ x 1)) +(SECTION 4 2 1) +(test 'greater 'cond (cond ((> 3 2) 'greater) + ((< 3 2) 'less))) +(test 'equal 'cond (cond ((> 3 3) 'greater) + ((< 3 3) 'less) + (else 'equal))) +(test 2 'cond (cond ((assv 'b '((a 1) (b 2))) => cadr) + (else #f))) +(test 'composite 'case (case (* 2 3) + ((2 3 5 7) 'prime) + ((1 4 6 8 9) 'composite))) +(test 'consonant 'case (case (car '(c d)) + ((a e i o u) 'vowel) + ((w y) 'semivowel) + (else 'consonant))) +(test #t 'and (and (= 2 2) (> 2 1))) +(test #f 'and (and (= 2 2) (< 2 1))) +(test '(f g) 'and (and 1 2 'c '(f g))) +(test #t 'and (and)) +(test #t 'or (or (= 2 2) (> 2 1))) +(test #t 'or (or (= 2 2) (< 2 1))) +(test #f 'or (or #f #f #f)) +(test #f 'or (or)) +(test '(b c) 'or (or (memq 'b '(a b c)) (+ 3 0))) +(SECTION 4 2 2) +(test 6 'let (let ((x 2) (y 3)) (* x y))) +(test 35 'let (let ((x 2) (y 3)) (let ((x 7) (z (+ x y))) (* z x)))) +(test 70 'let* (let ((x 2) (y 3)) (let* ((x 7) (z (+ x y))) (* z x)))) +(test #t 'letrec (letrec ((even? + (lambda (n) (if (zero? n) #t (odd? (- n 1))))) + (odd? + (lambda (n) (if (zero? n) #f (even? (- n 1)))))) + (even? 88))) +(define x 34) +(test 5 'let (let ((x 3)) (define x 5) x)) +(test 34 'let x) +(test 6 'let (let () (define x 6) x)) +(test 34 'let x) +(test 34 'let (let ((x x)) x)) +(test 7 'let* (let* ((x 3)) (define x 7) x)) +(test 34 'let* x) +(test 8 'let* (let* () (define x 8) x)) +(test 34 'let* x) +(test 9 'letrec (letrec () (define x 9) x)) +(test 34 'letrec x) +(test 10 'letrec (letrec ((x 3)) (define x 10) x)) +(test 34 'letrec x) +(define (s x) (if x (let () (set! s x) (set! x s)))) +(SECTION 4 2 3) +(define x 0) +(test 6 'begin (begin (set! x (begin (begin 5))) + (begin ((begin +) (begin x) (begin (begin 1)))))) +(SECTION 4 2 4) +(test '#(0 1 2 3 4) 'do (do ((vec (make-vector 5)) + (i 0 (+ i 1))) + ((= i 5) vec) + (vector-set! vec i i))) +(test 25 'do (let ((x '(1 3 5 7 9))) + (do ((x x (cdr x)) + (sum 0 (+ sum (car x)))) + ((null? x) sum)))) +(test 1 'let (let foo () 1)) +(test '((6 1 3) (-5 -2)) 'let + (let loop ((numbers '(3 -2 1 6 -5)) + (nonneg '()) + (neg '())) + (cond ((null? numbers) (list nonneg neg)) + ((negative? (car numbers)) + (loop (cdr numbers) + nonneg + (cons (car numbers) neg))) + (else + (loop (cdr numbers) + (cons (car numbers) nonneg) + neg))))) +;;From: Allegro Petrofsky <[EMAIL PROTECTED]> +(test -1 'let (let ((f -)) (let f ((n (f 1))) n))) + +(SECTION 4 2 6) +(test '(list 3 4) 'quasiquote `(list ,(+ 1 2) 4)) +(test '(list a (quote a)) 'quasiquote (let ((name 'a)) `(list ,name ',name))) +(test '(a 3 4 5 6 b) 'quasiquote `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b)) +(test '((foo 7) . cons) + 'quasiquote + `((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons)))) + +;;; sqt is defined here because not all implementations are required to +;;; support it. +(define (sqt x) + (do ((i 0 (+ i 1))) + ((> (* i i) x) (- i 1)))) + +(test '#(10 5 2 4 3 8) 'quasiquote `#(10 5 ,(sqt 4) ,@(map sqt '(16 9)) 8)) +(test 5 'quasiquote `,(+ 2 3)) +(test '(a `(b ,(+ 1 2) ,(foo 4 d) e) f) + 'quasiquote `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f)) +(test '(a `(b ,x ,'y d) e) 'quasiquote + (let ((name1 'x) (name2 'y)) `(a `(b ,,name1 ,',name2 d) e))) +(test '(list 3 4) 'quasiquote (quasiquote (list (unquote (+ 1 2)) 4))) +(test '`(list ,(+ 1 2) 4) 'quasiquote '(quasiquote (list (unquote (+ 1 2)) 4))) +(SECTION 5 2 1) +(define (tprint x) #t) +(test #t 'tprint (tprint 56)) +(define add3 (lambda (x) (+ x 3))) +(test 6 'define (add3 3)) +(define first car) +(test 1 'define (first '(1 2))) +(define foo (lambda () 9)) +(test 9 'define (foo)) +(define foo foo) +(test 9 'define (foo)) +(define foo (let ((foo foo)) (lambda () (+ 1 (foo))))) +(test 10 'define (foo)) +(define old-+ +) +(begin (begin (begin) + (begin (begin (begin) (define + (lambda (x y) (list y x))) + (begin))) + (begin)) + (begin) + (begin (begin (begin) (test '(3 6) add3 6) + (begin)))) +(set! + old-+) +(test 9 add3 6) +(begin) +(begin (begin)) +(begin (begin (begin (begin)))) +(SECTION 5 2 2) +(test 45 'define + (let ((x 5)) + (begin (begin (begin) + (begin (begin (begin) (define foo (lambda (y) (bar x y))) + (begin))) + (begin)) + (begin) + (begin) + (begin (define bar (lambda (a b) (+ (* a b) a)))) + (begin)) + (begin) + (begin (foo (+ x 3))))) +(define x 34) +(define (foo) (define x 5) x) +(test 5 foo) +(test 34 'define x) +(define foo (lambda () (define x 5) x)) +(test 5 foo) +(test 34 'define x) +(define (foo x) ((lambda () (define x 5) x)) x) +(test 88 foo 88) +(test 4 foo 4) +(test 34 'define x) +(test 99 'internal-define (letrec ((foo (lambda (arg) + (or arg (and (procedure? foo) + (foo 99)))))) + (define bar (foo #f)) + (foo #f))) +(test 77 'internal-define (letrec ((foo 77) + (bar #f) + (retfoo (lambda () foo))) + (define baz (retfoo)) + (retfoo))) +(SECTION 6 1) +(test #f not #t) +(test #f not 3) +(test #f not (list 3)) +(test #t not #f) +(test #f not '()) +(test #f not (list)) +(test #f not 'nil) + +;(test #t boolean? #f) +;(test #f boolean? 0) +;(test #f boolean? '()) +(SECTION 6 2) +(test #t eqv? 'a 'a) +(test #f eqv? 'a 'b) +(test #t eqv? 2 2) +(test #t eqv? '() '()) +(test #t eqv? '10000 '10000) +(test #f eqv? (cons 1 2)(cons 1 2)) +(test #f eqv? (lambda () 1) (lambda () 2)) +(test #f eqv? #f 'nil) +(let ((p (lambda (x) x))) + (test #t eqv? p p)) +(define gen-counter + (lambda () + (let ((n 0)) + (lambda () (set! n (+ n 1)) n)))) +(let ((g (gen-counter))) (test #t eqv? g g)) +(test #f eqv? (gen-counter) (gen-counter)) +(letrec ((f (lambda () (if (eqv? f g) 'f 'both))) + (g (lambda () (if (eqv? f g) 'g 'both)))) + (test #f eqv? f g)) + +(test #t eq? 'a 'a) +(test #f eq? (list 'a) (list 'a)) +(test #t eq? '() '()) +(test #t eq? car car) +(let ((x '(a))) (test #t eq? x x)) +(let ((x '#())) (test #t eq? x x)) +(let ((x (lambda (x) x))) (test #t eq? x x)) + +(define test-eq?-eqv?-agreement + (lambda (obj1 obj2) + (cond ((eq? (eq? obj1 obj2) (eqv? obj1 obj2))) + (else + (record-error (list #f #t (list 'test-eq?-eqv?-agreement obj1 obj2))) + (display "eqv? and eq? disagree about ") + (write obj1) + (display #\space) + (write obj2) + (newline))))) + +(test-eq?-eqv?-agreement '#f '#f) +(test-eq?-eqv?-agreement '#t '#t) +(test-eq?-eqv?-agreement '#t '#f) +(test-eq?-eqv?-agreement '(a) '(a)) +(test-eq?-eqv?-agreement '(a) '(b)) +(test-eq?-eqv?-agreement car car) +(test-eq?-eqv?-agreement car cdr) +(test-eq?-eqv?-agreement (list 'a) (list 'a)) +(test-eq?-eqv?-agreement (list 'a) (list 'b)) +(test-eq?-eqv?-agreement '#(a) '#(a)) +(test-eq?-eqv?-agreement '#(a) '#(b)) +(test-eq?-eqv?-agreement "abc" "abc") +(test-eq?-eqv?-agreement "abc" "abz") + +(test #t equal? 'a 'a) +(test #t equal? '(a) '(a)) +(test #t equal? '(a (b) c) '(a (b) c)) +(test #t equal? "abc" "abc") +(test #t equal? 2 2) +(test #t equal? (make-vector 5 'a) (make-vector 5 'a)) +(SECTION 6 3) +(test '(a b c d e) 'dot '(a . (b . (c . (d . (e . ())))))) +(define x (list 'a 'b 'c)) +(define y x) +(and list? (test #t list? y)) +(set-cdr! x 4) +(test '(a . 4) 'set-cdr! x) +(test #t eqv? x y) +(test '(a b c . d) 'dot '(a . (b . (c . d)))) +(and list? (test #f list? y)) +(and list? (let ((x (list 'a))) (set-cdr! x x) (test #f 'list? (list? x)))) + +;(test #t pair? '(a . b)) +;(test #t pair? '(a . 1)) +;(test #t pair? '(a b c)) +;(test #f pair? '()) +;(test #f pair? '#(a b)) + +(test '(a) cons 'a '()) +(test '((a) b c d) cons '(a) '(b c d)) +(test '("a" b c) cons "a" '(b c)) +(test '(a . 3) cons 'a 3) +(test '((a b) . c) cons '(a b) 'c) + +(test 'a car '(a b c)) +(test '(a) car '((a) b c d)) +(test 1 car '(1 . 2)) + +(test '(b c d) cdr '((a) b c d)) +(test 2 cdr '(1 . 2)) + +(test '(a 7 c) list 'a (+ 3 4) 'c) +(test '() list) + +(test 3 length '(a b c)) +(test 3 length '(a (b) (c d e))) +(test 0 length '()) + +(test '(x y) append '(x) '(y)) +(test '(a b c d) append '(a) '(b c d)) +(test '(a (b) (c)) append '(a (b)) '((c))) +(test '() append) +(test '(a b c . d) append '(a b) '(c . d)) +(test 'a append '() 'a) + +(test '(c b a) reverse '(a b c)) +(test '((e (f)) d (b c) a) reverse '(a (b c) d (e (f)))) + +(test 'c list-ref '(a b c d) 2) + +(test '(a b c) memq 'a '(a b c)) +(test '(b c) memq 'b '(a b c)) +(test '#f memq 'a '(b c d)) +(test '#f memq (list 'a) '(b (a) c)) +(test '((a) c) member (list 'a) '(b (a) c)) +(test '(101 102) memv 101 '(100 101 102)) + +(define e '((a 1) (b 2) (c 3))) +(test '(a 1) assq 'a e) +(test '(b 2) assq 'b e) +(test #f assq 'd e) +(test #f assq (list 'a) '(((a)) ((b)) ((c)))) +(test '((a)) assoc (list 'a) '(((a)) ((b)) ((c)))) +(test '(5 7) assv 5 '((2 3) (5 7) (11 13))) +(SECTION 6 4) +;(test #t symbol? 'foo) +(test #t symbol? (car '(a b))) +;(test #f symbol? "bar") +;(test #t symbol? 'nil) +;(test #f symbol? '()) +;(test #f symbol? #f) +;;; But first, what case are symbols in? Determine the standard case: +(define char-standard-case char-upcase) +(if (string=? (symbol->string 'A) "a") + (set! char-standard-case char-downcase)) +(test #t 'standard-case + (string=? (symbol->string 'a) (symbol->string 'A))) +(test #t 'standard-case + (or (string=? (symbol->string 'a) "A") + (string=? (symbol->string 'A) "a"))) +(define (str-copy s) + (let ((v (make-string (string-length s)))) + (do ((i (- (string-length v) 1) (- i 1))) + ((< i 0) v) + (string-set! v i (string-ref s i))))) +(define (string-standard-case s) + (set! s (str-copy s)) + (do ((i 0 (+ 1 i)) + (sl (string-length s))) + ((>= i sl) s) + (string-set! s i (char-standard-case (string-ref s i))))) +(test (string-standard-case "flying-fish") symbol->string 'flying-fish) +(test (string-standard-case "martin") symbol->string 'Martin) +(test "Malvina" symbol->string (string->symbol "Malvina")) +(test #t 'standard-case (eq? 'a 'A)) + +(define x (string #\a #\b)) +(define y (string->symbol x)) +(string-set! x 0 #\c) +(test "cb" 'string-set! x) +(test "ab" symbol->string y) +(test y string->symbol "ab") + +(test #t eq? 'mISSISSIppi 'mississippi) +(test #f 'string->symbol (eq? 'bitBlt (string->symbol "bitBlt"))) +(test 'JollyWog string->symbol (symbol->string 'JollyWog)) + +(SECTION 6 5 5) +(test #t number? 3) +(test #t complex? 3) +(test #t real? 3) +(test #t rational? 3) +(test #t integer? 3) + +(test #t exact? 3) +(test #f inexact? 3) + +(test 1 expt 0 0) +(test 0 expt 0 1) +(test 0 expt 0 256) +;;(test 0 expt 0 -255) +(test 1 expt -1 256) +(test -1 expt -1 255) +(test 1 expt -1 -256) +(test -1 expt -1 -255) +(test 1 expt 256 0) +(test 1 expt -256 0) +(test 256 expt 256 1) +(test -256 expt -256 1) +(test 8 expt 2 3) +(test -8 expt -2 3) +(test 9 expt 3 2) +(test 9 expt -3 2) + +(test #t = 22 22 22) +(test #t = 22 22) +(test #f = 34 34 35) +(test #f = 34 35) +(test #t > 3 -6246) +(test #f > 9 9 -2424) +(test #t >= 3 -4 -6246) +(test #t >= 9 9) +(test #f >= 8 9) +(test #t < -1 2 3 4 5 6 7 8) +(test #f < -1 2 3 4 4 5 6 7) +(test #t <= -1 2 3 4 5 6 7 8) +(test #t <= -1 2 3 4 4 5 6 7) +(test #f < 1 3 2) +(test #f >= 1 3 2) + +(test #t zero? 0) +(test #f zero? 1) +(test #f zero? -1) +(test #f zero? -100) +(test #t positive? 4) +(test #f positive? -4) +(test #f positive? 0) +(test #f negative? 4) +(test #t negative? -4) +(test #f negative? 0) +(test #t odd? 3) +(test #f odd? 2) +(test #f odd? -4) +(test #t odd? -1) +(test #f even? 3) +(test #t even? 2) +(test #t even? -4) +(test #f even? -1) + +(test 38 max 34 5 7 38 6) +(test -24 min 3 5 5 330 4 -24) + +(test 7 + 3 4) +(test '3 + 3) +(test 0 +) +(test 4 * 4) +(test 1 *) + +(test -1 - 3 4) +(test -3 - 3) +(test 7 abs -7) +(test 7 abs 7) +(test 0 abs 0) + +(test 5 quotient 35 7) +(test -5 quotient -35 7) +(test -5 quotient 35 -7) +(test 5 quotient -35 -7) +(test 1 modulo 13 4) +(test 1 remainder 13 4) +(test 3 modulo -13 4) +(test -1 remainder -13 4) +(test -3 modulo 13 -4) +(test 1 remainder 13 -4) +(test -1 modulo -13 -4) +(test -1 remainder -13 -4) +(test 0 modulo 0 86400) +(test 0 modulo 0 -86400) +(define (divtest n1 n2) + (= n1 (+ (* n2 (quotient n1 n2)) + (remainder n1 n2)))) +(test #t divtest 238 9) +(test #t divtest -238 9) +(test #t divtest 238 -9) +(test #t divtest -238 -9) + +(test 4 gcd 0 4) +(test 4 gcd -4 0) +(test 4 gcd 32 -36) +(test 0 gcd) +(test 288 lcm 32 -36) +(test 1 lcm) + +(SECTION 6 5 5) +;;; Implementations which don't allow division by 0 can have fragile +;;; string->number. +(define (test-string->number str) + (define ans (string->number str)) + (cond ((not ans) #t) ((number? ans) #t) (else ans))) +(for-each (lambda (str) (test #t test-string->number str)) + '("+#.#" "-#.#" "#.#" "1/0" "-1/0" "0/0" + "+1/0i" "-1/0i" "0/0i" "0/0-0/0i" "1/0-1/0i" "-1/0+1/0i" + "#i" "#e" "#" "#i0/0")) +(cond ((number? (string->number "1+1i")) ;More kawa bait + (test #t number? (string->number "#i-i")) + (test #t number? (string->number "#i+i")) + (test #t number? (string->number "#i2+i")))) + +;;;;From: [EMAIL PROTECTED] (Fred J Kaudel) +;;; Modified by jaffer. +(define (test-inexact) + (define f3.9 (string->number "3.9")) + (define f4.0 (string->number "4.0")) + (define f-3.25 (string->number "-3.25")) + (define f.25 (string->number ".25")) + (define f4.5 (string->number "4.5")) + (define f3.5 (string->number "3.5")) + (define f0.0 (string->number "0.0")) + (define f0.8 (string->number "0.8")) + (define f1.0 (string->number "1.0")) + (define f1e300 (and (string->number "1+3i") (string->number "1e300"))) + (define f1e-300 (and (string->number "1+3i") (string->number "1e-300"))) + (define wto write-test-obj) + (define lto load-test-obj) + (newline) + (display ";testing inexact numbers; ") + (newline) + (SECTION 6 2) + (test #f eqv? 1 f1.0) + (test #f eqv? 0 f0.0) + (test #t eqv? f0.0 f0.0) + (cond ((= f0.0 (- f0.0)) + (test #t eqv? f0.0 (- f0.0)) + (test #t equal? f0.0 (- f0.0)))) + (cond ((= f0.0 (* -5 f0.0)) + (test #t eqv? f0.0 (* -5 f0.0)) + (test #t equal? f0.0 (* -5 f0.0)))) + (SECTION 6 5 5) + (and f1e300 + (let ((f1e300+1e300i (make-rectangular f1e300 f1e300))) + (test f1.0 'magnitude (/ (magnitude f1e300+1e300i) + (* f1e300 (sqrt 2)))) + (test f.25 / f1e300+1e300i (* 4 f1e300+1e300i)))) + (and f1e-300 + (let ((f1e-300+1e-300i (make-rectangular f1e-300 f1e-300))) + (test f1.0 'magnitude (round (/ (magnitude f1e-300+1e-300i) + (* f1e-300 (sqrt 2))))) + (test f.25 / f1e-300+1e-300i (* 4 f1e-300+1e-300i)))) + (test #t = f0.0 f0.0) + (test #t = f0.0 (- f0.0)) + (test #t = f0.0 (* -5 f0.0)) + (test #t inexact? f3.9) + (test #t 'max (inexact? (max f3.9 4))) + (test f4.0 max f3.9 4) + (test f4.0 exact->inexact 4) + (test f4.0 exact->inexact 4.0) + (test 4 inexact->exact 4) + (test 4 inexact->exact 4.0) + (test (- f4.0) round (- f4.5)) + (test (- f4.0) round (- f3.5)) + (test (- f4.0) round (- f3.9)) + (test f0.0 round f0.0) + (test f0.0 round f.25) + (test f1.0 round f0.8) + (test f4.0 round f3.5) + (test f4.0 round f4.5) + + ;;(test f1.0 expt f0.0 f0.0) + ;;(test f1.0 expt f0.0 0) + ;;(test f1.0 expt 0 f0.0) + (test f0.0 expt f0.0 f1.0) + (test f0.0 expt f0.0 1) + (test f0.0 expt 0 f1.0) + (test f1.0 expt -25 f0.0) + (test f1.0 expt f-3.25 f0.0) + (test f1.0 expt f-3.25 0) + ;;(test f0.0 expt f0.0 f-3.25) + + (test (atan 1) atan 1 1) + (set! write-test-obj (list f.25 f-3.25)) ;.25 inexact errors less likely. + (set! load-test-obj (list 'define 'foo (list 'quote write-test-obj))) + (test #t call-with-output-file + "tmp3" + (lambda (test-file) + (write-char #\; test-file) + (display #\; test-file) + (display ";" test-file) + (write write-test-obj test-file) + (newline test-file) + (write load-test-obj test-file) + (output-port? test-file))) + (check-test-file "tmp3") + (set! write-test-obj wto) + (set! load-test-obj lto) + (let ((x (string->number "4195835.0")) + (y (string->number "3145727.0"))) + (test #t 'pentium-fdiv-bug (> f1.0 (- x (* (/ x y) y))))) + (report-errs)) + +(define (test-inexact-printing) + (let ((f0.0 (string->number "0.0")) + (f0.5 (string->number "0.5")) + (f1.0 (string->number "1.0")) + (f2.0 (string->number "2.0"))) + (define log2 + (let ((l2 (log 2))) + (lambda (x) (/ (log x) l2)))) + + (define (slow-frexp x) + (if (zero? x) + (list f0.0 0) + (let* ((l2 (log2 x)) + (e (floor (log2 x))) + (e (if (= l2 e) + (inexact->exact e) + (+ (inexact->exact e) 1))) + (f (/ x (expt 2 e)))) + (list f e)))) + + (define float-precision + (let ((mantissa-bits + (do ((i 0 (+ i 1)) + (eps f1.0 (* f0.5 eps))) + ((= f1.0 (+ f1.0 eps)) + i))) + (minval + (do ((x f1.0 (* f0.5 x))) + ((zero? (* f0.5 x)) x)))) + (lambda (x) + (apply (lambda (f e) + (let ((eps + (cond ((= f1.0 f) (expt f2.0 (+ 1 (- e mantissa-bits)))) + ((zero? f) minval) + (else (expt f2.0 (- e mantissa-bits)))))) + (if (zero? eps) ;Happens if gradual underflow. + minval + eps))) + (slow-frexp x))))) + + (define (float-print-test x) + (define (testit number) + (eqv? number (string->number (number->string number)))) + (let ((eps (float-precision x)) + (all-ok? #t)) + (do ((j -100 (+ j 1))) + ((or (not all-ok?) (> j 100)) all-ok?) + (let* ((xx (+ x (* j eps))) + (ok? (testit xx))) + (cond ((not ok?) + (display "Number readback failure for ") + (display `(+ ,x (* ,j ,eps))) + (newline) + (display xx) + (newline) + (set! all-ok? #f)) + ;; (else (display xx) (newline)) + ))))) + + (define (mult-float-print-test x) + (let ((res #t)) + (for-each + (lambda (mult) + (or (float-print-test (* mult x)) (set! res #f))) + (map string->number + '("1.0" "10.0" "100.0" "1.0e20" "1.0e50" "1.0e100" + "0.1" "0.01" "0.001" "1.0e-20" "1.0e-50" "1.0e-100"))) + res)) + + (SECTION 6 5 6) + (test #t 'float-print-test (float-print-test f0.0)) + (test #t 'mult-float-print-test (mult-float-print-test f1.0)) + (test #t 'mult-float-print-test (mult-float-print-test + (string->number "3.0"))) + (test #t 'mult-float-print-test (mult-float-print-test + (string->number "7.0"))) + (test #t 'mult-float-print-test (mult-float-print-test + (string->number "3.1415926535897931"))) + (test #t 'mult-float-print-test (mult-float-print-test + (string->number "2.7182818284590451"))))) + +(define (test-bignum) + (define tb + (lambda (n1 n2) + (= n1 (+ (* n2 (quotient n1 n2)) + (remainder n1 n2))))) + (define b3-3 (string->number "33333333333333333333")) + (define b3-2 (string->number "33333333333333333332")) + (define b3-0 (string->number "33333333333333333330")) + (define b2-0 (string->number "2177452800")) + (newline) + (display ";testing bignums; ") + (newline) + (SECTION 6 5 7) + (test 0 modulo b3-3 3) + (test 0 modulo b3-3 -3) + (test 0 remainder b3-3 3) + (test 0 remainder b3-3 -3) + (test 2 modulo b3-2 3) + (test -1 modulo b3-2 -3) + (test 2 remainder b3-2 3) + (test 2 remainder b3-2 -3) + (test 1 modulo (- b3-2) 3) + (test -2 modulo (- b3-2) -3) + (test -2 remainder (- b3-2) 3) + (test -2 remainder (- b3-2) -3) + + (test 3 modulo 3 b3-3) + (test b3-0 modulo -3 b3-3) + (test 3 remainder 3 b3-3) + (test -3 remainder -3 b3-3) + (test (- b3-0) modulo 3 (- b3-3)) + (test -3 modulo -3 (- b3-3)) + (test 3 remainder 3 (- b3-3)) + (test -3 remainder -3 (- b3-3)) + + (test 0 modulo (- b2-0) 86400) + (test 0 modulo b2-0 -86400) + (test 0 modulo b2-0 86400) + (test 0 modulo (- b2-0) -86400) + (test 0 modulo 0 (- b2-0)) + (test #t 'remainder (tb (string->number "281474976710655325431") 65535)) + (test #t 'remainder (tb (string->number "281474976710655325430") 65535)) + + (let ((n (string->number + "30414093201713378043612608166064768844377641568960512"))) + (and n (exact? n) + (do ((pow3 1 (* 3 pow3)) + (cnt 21 (+ -1 cnt))) + ((negative? cnt) + (zero? (modulo n pow3)))))) + + (SECTION 6 5 8) + (test "281474976710655325431" number->string + (string->number "281474976710655325431")) + (report-errs)) + +(define (test-numeric-predicates) + (let* ((big-ex (expt 2 150)) + (big-inex (exact->inexact big-ex))) + (newline) + (display ";testing bignum-inexact comparisons;") + (newline) + (SECTION 6 5 5) + (test #f = (+ big-ex 1) big-inex (- big-ex 1)) + (test #f = big-inex (+ big-ex 1) (- big-ex 1)) + (test #t < (- (inexact->exact big-inex) 1) + big-inex + (+ (inexact->exact big-inex) 1)))) + + +(SECTION 6 5 9) +(test "0" number->string 0) +(test "100" number->string 100) +(test "100" number->string 256 16) +(test 100 string->number "100") +(test 256 string->number "100" 16) +(test #f string->number "") +(test #f string->number ".") +(test #f string->number "d") +(test #f string->number "D") +(test #f string->number "i") +(test #f string->number "I") +(test #f string->number "3i") +(test #f string->number "3I") +(test #f string->number "33i") +(test #f string->number "33I") +(test #f string->number "3.3i") +(test #f string->number "3.3I") +(test #f string->number "-") +(test #f string->number "+") +(test #t 'string->number (or (not (string->number "80000000" 16)) + (positive? (string->number "80000000" 16)))) +(test #t 'string->number (or (not (string->number "-80000000" 16)) + (negative? (string->number "-80000000" 16)))) + +(SECTION 6 6) +(test #t eqv? '#\ #\Space) +(test #t eqv? #\space '#\Space) +(test #t char? #\a) +(test #t char? #\() +(test #t char? #\space) +(test #t char? '#\newline) + +(test #f char=? #\A #\B) +(test #f char=? #\a #\b) +(test #f char=? #\9 #\0) +(test #t char=? #\A #\A) + +(test #t char<? #\A #\B) +(test #t char<? #\a #\b) +(test #f char<? #\9 #\0) +(test #f char<? #\A #\A) + +(test #f char>? #\A #\B) +(test #f char>? #\a #\b) +(test #t char>? #\9 #\0) +(test #f char>? #\A #\A) + +(test #t char<=? #\A #\B) +(test #t char<=? #\a #\b) +(test #f char<=? #\9 #\0) +(test #t char<=? #\A #\A) + +(test #f char>=? #\A #\B) +(test #f char>=? #\a #\b) +(test #t char>=? #\9 #\0) +(test #t char>=? #\A #\A) + +(test #f char-ci=? #\A #\B) +(test #f char-ci=? #\a #\B) +(test #f char-ci=? #\A #\b) +(test #f char-ci=? #\a #\b) +(test #f char-ci=? #\9 #\0) +(test #t char-ci=? #\A #\A) +(test #t char-ci=? #\A #\a) + +(test #t char-ci<? #\A #\B) +(test #t char-ci<? #\a #\B) +(test #t char-ci<? #\A #\b) +(test #t char-ci<? #\a #\b) +(test #f char-ci<? #\9 #\0) +(test #f char-ci<? #\A #\A) +(test #f char-ci<? #\A #\a) + +(test #f char-ci>? #\A #\B) +(test #f char-ci>? #\a #\B) +(test #f char-ci>? #\A #\b) +(test #f char-ci>? #\a #\b) +(test #t char-ci>? #\9 #\0) +(test #f char-ci>? #\A #\A) +(test #f char-ci>? #\A #\a) + +(test #t char-ci<=? #\A #\B) +(test #t char-ci<=? #\a #\B) +(test #t char-ci<=? #\A #\b) +(test #t char-ci<=? #\a #\b) +(test #f char-ci<=? #\9 #\0) +(test #t char-ci<=? #\A #\A) +(test #t char-ci<=? #\A #\a) + +(test #f char-ci>=? #\A #\B) +(test #f char-ci>=? #\a #\B) +(test #f char-ci>=? #\A #\b) +(test #f char-ci>=? #\a #\b) +(test #t char-ci>=? #\9 #\0) +(test #t char-ci>=? #\A #\A) +(test #t char-ci>=? #\A #\a) + +(test #t char-alphabetic? #\a) +(test #t char-alphabetic? #\A) +(test #t char-alphabetic? #\z) +(test #t char-alphabetic? #\Z) +(test #f char-alphabetic? #\0) +(test #f char-alphabetic? #\9) +(test #f char-alphabetic? #\space) +(test #f char-alphabetic? #\;) + +(test #f char-numeric? #\a) +(test #f char-numeric? #\A) +(test #f char-numeric? #\z) +(test #f char-numeric? #\Z) +(test #t char-numeric? #\0) +(test #t char-numeric? #\9) +(test #f char-numeric? #\space) +(test #f char-numeric? #\;) + +(test #f char-whitespace? #\a) +(test #f char-whitespace? #\A) +(test #f char-whitespace? #\z) +(test #f char-whitespace? #\Z) +(test #f char-whitespace? #\0) +(test #f char-whitespace? #\9) +(test #t char-whitespace? #\space) +(test #f char-whitespace? #\;) + +(test #f char-upper-case? #\0) +(test #f char-upper-case? #\9) +(test #f char-upper-case? #\space) +(test #f char-upper-case? #\;) + +(test #f char-lower-case? #\0) +(test #f char-lower-case? #\9) +(test #f char-lower-case? #\space) +(test #f char-lower-case? #\;) + +(test #\. integer->char (char->integer #\.)) +(test #\A integer->char (char->integer #\A)) +(test #\a integer->char (char->integer #\a)) +(test #\A char-upcase #\A) +(test #\A char-upcase #\a) +(test #\a char-downcase #\A) +(test #\a char-downcase #\a) +(SECTION 6 7) +(test #t string? "The word \"recursion\\\" has many meanings.") +;(test #t string? "") +(define f (make-string 3 #\*)) +(test "?**" 'string-set! (begin (string-set! f 0 #\?) f)) +(test "abc" string #\a #\b #\c) +(test "" string) +(test 3 string-length "abc") +(test #\a string-ref "abc" 0) +(test #\c string-ref "abc" 2) +(test 0 string-length "") +(test "" substring "ab" 0 0) +(test "" substring "ab" 1 1) +(test "" substring "ab" 2 2) +(test "a" substring "ab" 0 1) +(test "b" substring "ab" 1 2) +(test "ab" substring "ab" 0 2) +(test "foobar" string-append "foo" "bar") +(test "foo" string-append "foo") +(test "foo" string-append "foo" "") +(test "foo" string-append "" "foo") +(test "" string-append) +(test "" make-string 0) +(test #t string=? "" "") +(test #f string<? "" "") +(test #f string>? "" "") +(test #t string<=? "" "") +(test #t string>=? "" "") +(test #t string-ci=? "" "") +(test #f string-ci<? "" "") +(test #f string-ci>? "" "") +(test #t string-ci<=? "" "") +(test #t string-ci>=? "" "") + +(test #f string=? "A" "B") +(test #f string=? "a" "b") +(test #f string=? "9" "0") +(test #t string=? "A" "A") + +(test #t string<? "A" "B") +(test #t string<? "a" "b") +(test #f string<? "9" "0") +(test #f string<? "A" "A") + +(test #f string>? "A" "B") +(test #f string>? "a" "b") +(test #t string>? "9" "0") +(test #f string>? "A" "A") + +(test #t string<=? "A" "B") +(test #t string<=? "a" "b") +(test #f string<=? "9" "0") +(test #t string<=? "A" "A") + +(test #f string>=? "A" "B") +(test #f string>=? "a" "b") +(test #t string>=? "9" "0") +(test #t string>=? "A" "A") + +(test #f string-ci=? "A" "B") +(test #f string-ci=? "a" "B") +(test #f string-ci=? "A" "b") +(test #f string-ci=? "a" "b") +(test #f string-ci=? "9" "0") +(test #t string-ci=? "A" "A") +(test #t string-ci=? "A" "a") + +(test #t string-ci<? "A" "B") +(test #t string-ci<? "a" "B") +(test #t string-ci<? "A" "b") +(test #t string-ci<? "a" "b") +(test #f string-ci<? "9" "0") +(test #f string-ci<? "A" "A") +(test #f string-ci<? "A" "a") + +(test #f string-ci>? "A" "B") +(test #f string-ci>? "a" "B") +(test #f string-ci>? "A" "b") +(test #f string-ci>? "a" "b") +(test #t string-ci>? "9" "0") +(test #f string-ci>? "A" "A") +(test #f string-ci>? "A" "a") + +(test #t string-ci<=? "A" "B") +(test #t string-ci<=? "a" "B") +(test #t string-ci<=? "A" "b") +(test #t string-ci<=? "a" "b") +(test #f string-ci<=? "9" "0") +(test #t string-ci<=? "A" "A") +(test #t string-ci<=? "A" "a") + +(test #f string-ci>=? "A" "B") +(test #f string-ci>=? "a" "B") +(test #f string-ci>=? "A" "b") +(test #f string-ci>=? "a" "b") +(test #t string-ci>=? "9" "0") +(test #t string-ci>=? "A" "A") +(test #t string-ci>=? "A" "a") +(SECTION 6 8) +(test #t vector? '#(0 (2 2 2 2) "Anna")) +;(test #t vector? '#()) +(test '#(a b c) vector 'a 'b 'c) +(test '#() vector) +(test 3 vector-length '#(0 (2 2 2 2) "Anna")) +(test 0 vector-length '#()) +(test 8 vector-ref '#(1 1 2 3 5 8 13 21) 5) +(test '#(0 ("Sue" "Sue") "Anna") 'vector-set + (let ((vec (vector 0 '(2 2 2 2) "Anna"))) + (vector-set! vec 1 '("Sue" "Sue")) + vec)) +(test '#(hi hi) make-vector 2 'hi) +(test '#() make-vector 0) +(test '#() make-vector 0 'a) +(SECTION 6 9) +(test #t procedure? car) +;(test #f procedure? 'car) +(test #t procedure? (lambda (x) (* x x))) +(test #f procedure? '(lambda (x) (* x x))) +(test #t call-with-current-continuation procedure?) +(test 7 apply + (list 3 4)) +(test 7 apply (lambda (a b) (+ a b)) (list 3 4)) +(test 17 apply + 10 (list 3 4)) +(test '() apply list '()) +(define compose (lambda (f g) (lambda args (f (apply g args))))) +(test 30 (compose sqt *) 12 75) + +(test '(b e h) map cadr '((a b) (d e) (g h))) +(test '(5 7 9) map + '(1 2 3) '(4 5 6)) +(test '(1 2 3) map + '(1 2 3)) +(test '(1 2 3) map * '(1 2 3)) +(test '(-1 -2 -3) map - '(1 2 3)) +(test '#(0 1 4 9 16) 'for-each + (let ((v (make-vector 5))) + (for-each (lambda (i) (vector-set! v i (* i i))) + '(0 1 2 3 4)) + v)) +(test -3 call-with-current-continuation + (lambda (exit) + (for-each (lambda (x) (if (negative? x) (exit x))) + '(54 0 37 -3 245 19)) + #t)) +(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)))))) +(test 4 list-length '(1 2 3 4)) +(test #f list-length '(a b . c)) +(test '() map cadr '()) + +;;; This tests full conformance of call-with-current-continuation. It +;;; is a separate test because some schemes do not support call/cc +;;; other than escape procedures. I am indebted to +;;; [EMAIL PROTECTED] (Raja Sooriamurthi) for fixing this +;;; code. The function leaf-eq? compares the leaves of 2 arbitrary +;;; trees constructed of conses. +(define (next-leaf-generator obj eot) + (letrec ((return #f) + (cont (lambda (x) + (recur obj) + (set! cont (lambda (x) (return eot))) + (cont #f))) + (recur (lambda (obj) + (if (pair? obj) + (for-each recur obj) + (call-with-current-continuation + (lambda (c) + (set! cont c) + (return obj))))))) + (lambda () (call-with-current-continuation + (lambda (ret) (set! return ret) (cont #f)))))) +(define (leaf-eq? x y) + (let* ((eot (list 'eot)) + (xf (next-leaf-generator x eot)) + (yf (next-leaf-generator y eot))) + (letrec ((loop (lambda (x y) + (cond ((not (eq? x y)) #f) + ((eq? eot x) #t) + (else (loop (xf) (yf))))))) + (loop (xf) (yf))))) +(define (test-cont) + (newline) + (display ";testing continuations; ") + (newline) + (SECTION 6 9) + (test #t leaf-eq? '(a (b (c))) '((a) b c)) + (test #f leaf-eq? '(a (b (c))) '((a) b c d)) + (report-errs)) + +;;; Test Optional R4RS DELAY syntax and FORCE procedure +(define (test-delay) + (newline) + (display ";testing DELAY and FORCE; ") + (newline) + (SECTION 6 9) + (test 3 'delay (force (delay (+ 1 2)))) + (test '(3 3) 'delay (let ((p (delay (+ 1 2)))) + (list (force p) (force p)))) + (test 2 'delay (letrec ((a-stream + (letrec ((next (lambda (n) + (cons n (delay (next (+ n 1))))))) + (next 0))) + (head car) + (tail (lambda (stream) (force (cdr stream))))) + (head (tail (tail a-stream))))) + (letrec ((count 0) + (p (delay (begin (set! count (+ count 1)) + (if (> count x) + count + (force p))))) + (x 5)) + (test 6 force p) + (set! x 10) + (test 6 force p)) + (test 3 'force + (letrec ((p (delay (if c 3 (begin (set! c #t) (+ (force p) 1))))) + (c #f)) + (force p))) + (report-errs)) + +(SECTION 6 10 1) +(test #t input-port? (current-input-port)) +(test #t output-port? (current-output-port)) +(test #t call-with-input-file "r4rstest.scm" input-port?) +(define this-file (open-input-file "r4rstest.scm")) +(test #t input-port? this-file) +(SECTION 6 10 2) +(test #\; peek-char this-file) +(test #\; read-char this-file) +(test '(define cur-section '()) read this-file) +(test #\( peek-char this-file) +(test '(define errs '()) read this-file) +(close-input-port this-file) +(close-input-port this-file) +(define (check-test-file name) + (define test-file (open-input-file name)) + (test #t 'input-port? + (call-with-input-file + name + (lambda (test-file) + (test load-test-obj read test-file) + (test #t eof-object? (peek-char test-file)) + (test #t eof-object? (read-char test-file)) + (input-port? test-file)))) + (test #\; read-char test-file) + (test #\; read-char test-file) + (test #\; read-char test-file) + (test write-test-obj read test-file) + (test load-test-obj read test-file) + (close-input-port test-file)) +(SECTION 6 10 3) +(define write-test-obj + '(#t #f a () 9739 -3 . #((test) "te \" \" st" "" test #() b c))) +(define load-test-obj + (list 'define 'foo (list 'quote write-test-obj))) +(test #t call-with-output-file + "tmp1" + (lambda (test-file) + (write-char #\; test-file) + (display #\; test-file) + (display ";" test-file) + (write write-test-obj test-file) + (newline test-file) + (write load-test-obj test-file) + (output-port? test-file))) +(check-test-file "tmp1") + +(define test-file (open-output-file "tmp2")) +(write-char #\; test-file) +(display #\; test-file) +(display ";" test-file) +(write write-test-obj test-file) +(newline test-file) +(write load-test-obj test-file) +(test #t output-port? test-file) +(close-output-port test-file) +(check-test-file "tmp2") +(define (test-sc4) + (newline) + (display ";testing scheme 4 functions; ") + (newline) + (SECTION 6 7) + (test '(#\P #\space #\l) string->list "P l") + (test '() string->list "") + (test "1\\\"" list->string '(#\1 #\\ #\")) + (test "" list->string '()) + (SECTION 6 8) + (test '(dah dah didah) vector->list '#(dah dah didah)) + (test '() vector->list '#()) + (test '#(dididit dah) list->vector '(dididit dah)) + (test '#() list->vector '()) + (SECTION 6 10 4) + (load "tmp1") + (test write-test-obj 'load foo) + (report-errs)) + +(report-errs) +(let ((have-inexacts? + (and (string->number "0.0") (inexact? (string->number "0.0")))) + (have-bignums? + (let ((n (string->number + "1427247692705959881058285969449495136382746625"))) + (and n (exact? n))))) + (cond (have-inexacts? + (test-inexact) + (test-inexact-printing))) + (if have-bignums? (test-bignum)) + (if (and have-inexacts? have-bignums?) + (test-numeric-predicates))) + +(newline) +(display "To fully test continuations, Scheme 4, and DELAY/FORCE do:") +(newline) +(display "(test-cont) (test-sc4) (test-delay)") +(newline) +"last item in file"
