1 ; File: "error.scm", Time-stamp: <2008-04-01 12:44:06 feeley>
3 ; Copyright (c) 1998-2007 by Marc Feeley, All Rights Reserved.
5 ; Test program for error processing.
7 ; run like this: gsi/gsi -f error.scm < error.scm
12 (let ((str1 (symbol->string (car '(aB\c;
15 (cond ((or (equal? str1 "aB\\c") (equal? str1 "aB"))
16 'gambit) ; Gambit in case-sensitive mode
17 ((equal? str1 "ab\\c")
18 (let* ((c0 (string-ref str2 0)))
19 (cond ((char=? c0 (integer->char 0))
21 ((char=? c0 (integer->char 9))
24 (cond ((char=? (string-ref str2 2) #\#)
25 'gambit) ; Gambit in case-insensitive mode
36 ((equal? str1 "AB\\C")
45 (define continuation->return-address #f)
48 (define chez-continuation->return-address
52 (define chez-catch-all
53 (lambda (catcher thunk)
54 (parameterize ((error-handler
55 (lambda (fn-name err-format . err-args)
56 (catcher (string->symbol "##signal.runtime-error")
58 (cons err-format err-args))
63 (define mit-continuation->return-address
68 (lambda (catcher thunk)
69 (call-with-current-continuation
71 (bind-condition-handler
74 (catcher (string->symbol "##signal.runtime-error")
75 (list (condition/report-string condition)
81 (define scm-continuation->return-address
86 (lambda (catcher thunk)
87 (call-with-current-continuation
93 (let ((result (thunk)))
99 (catcher (string->symbol "##signal.runtime-error")
107 (set! continuation->return-address
108 (eval `(lambda (cont)
109 (,(string->symbol "##continuation-ret")
110 (,(string->symbol "##procedure->continuation") cont)))))
112 (lambda (catcher thunk)
113 (with-exception-handler
116 (define (call oper args)
118 (string->symbol "##signal.runtime-error")
119 (list (with-input-from-string
120 (with-output-to-string
123 (if (os-exception? exc)
125 (##display-exception exc (current-output-port)))))
127 (##procedure-friendly-name oper)
130 (cond ((abandoned-mutex-exception? exc)
132 ((sfun-conversion-exception? exc)
134 (sfun-conversion-exception-procedure exc)
135 (sfun-conversion-exception-arguments exc)))
136 ((cfun-conversion-exception? exc)
138 (cfun-conversion-exception-procedure exc)
139 (cfun-conversion-exception-arguments exc)))
140 ((datum-parsing-exception? exc)
142 ((deadlock-exception? exc)
144 ((divide-by-zero-exception? exc)
146 (divide-by-zero-exception-procedure exc)
147 (divide-by-zero-exception-arguments exc)))
148 ((error-exception? exc)
150 ((expression-parsing-exception? exc)
152 ((heap-overflow-exception? exc)
154 ((improper-length-list-exception? exc)
156 (improper-length-list-exception-procedure exc)
157 (improper-length-list-exception-arguments exc)))
158 ((join-timeout-exception? exc)
160 (join-timeout-exception-procedure exc)
161 (join-timeout-exception-arguments exc)))
162 ((keyword-expected-exception? exc)
164 (keyword-expected-exception-procedure exc)
165 (keyword-expected-exception-arguments exc)))
166 ((multiple-c-return-exception? exc)
168 ((noncontinuable-exception? exc)
170 ((nonprocedure-operator-exception? exc)
172 (quot (nonprocedure-operator-exception-operator exc))
173 (nonprocedure-operator-exception-arguments exc)))
174 ((number-of-arguments-limit-exception? exc)
176 (number-of-arguments-limit-exception-procedure exc)
177 (number-of-arguments-limit-exception-arguments exc)))
180 (os-exception-procedure exc)
181 (os-exception-arguments exc)))
182 ((range-exception? exc)
184 (range-exception-procedure exc)
185 (range-exception-arguments exc)))
186 ((scheduler-exception? exc)
188 ((stack-overflow-exception? exc)
190 ((started-thread-exception? exc)
192 (started-thread-exception-procedure exc)
193 (started-thread-exception-arguments exc)))
194 ((terminated-thread-exception? exc)
196 (terminated-thread-exception-procedure exc)
197 (terminated-thread-exception-arguments exc)))
198 ((type-exception? exc)
200 (type-exception-procedure exc)
201 (type-exception-arguments exc)))
202 ((unbound-os-environment-variable-exception? exc)
204 (unbound-os-environment-variable-exception-procedure exc)
205 (unbound-os-environment-variable-exception-arguments exc)))
206 ((unbound-global-exception? exc)
208 ((uncaught-exception? exc)
210 (uncaught-exception-procedure exc)
211 (uncaught-exception-arguments exc)))
212 ((unknown-keyword-argument-exception? exc)
214 (unknown-keyword-argument-exception-procedure exc)
215 (unknown-keyword-argument-exception-arguments exc)))
216 ((wrong-number-of-arguments-exception? exc)
218 (wrong-number-of-arguments-exception-procedure exc)
219 (wrong-number-of-arguments-exception-arguments exc)))
220 ((no-such-file-or-directory-exception? exc)
222 (no-such-file-or-directory-exception-procedure exc)
223 (no-such-file-or-directory-exception-arguments exc)))
228 (set! continuation->return-address chez-continuation->return-address)
229 (set! catch-all chez-catch-all)
230 (print-vector-length #f))
232 (set! continuation->return-address mit-continuation->return-address)
233 (set! catch-all mit-catch-all))
235 (set! continuation->return-address scm-continuation->return-address)
236 (set! catch-all scm-catch-all)))
240 (cond ((string? obj) (string-copy obj))
241 ((pair? obj) (cons (copy-obj (car obj)) (copy-obj (cdr obj))))
242 ((vector? obj) (list->vector (map copy-obj (vector->list obj))))
247 (let ((result ; make sure continuation is unique (even in interpreter)
248 (cond (fn => (lambda (f) (apply f args))))))
251 (define return-address-of-apply-fn
254 (call-with-current-continuation
256 (continuation->return-address cont))))
259 (define error-catcher
261 (call-with-current-continuation
263 (if (not (eq? s (string->symbol "##signal.runtime-error")))
265 (display ";;; SIGNAL ")
267 (display " IS WRONG: ")
272 (map quot (caddr args)))))
273 (if (not (equal? call-expr call-expr2))
275 (display ";;; CALL EXPRESSION ")
277 (display " IS WRONG: ")
280 (let ((retadr (continuation->return-address cont)))
281 (if (not (eq? retadr return-address-of-apply-fn))
283 (display ";;; CONTINUATION ")
285 (display " IS WRONG: ")
298 (if (or (number? x) (string? x) (char? x) (boolean? x))
303 (lambda (fn-name fn args proc)
304 (set! call-args (map copy-obj args))
305 (set! call-expr (cons fn-name (map quot call-args)))
306 (call-with-current-continuation
313 (apply-fn fn args))))))))
316 (lambda (fn-name fn . args)
323 (write (normalize-numbers result))
327 (lambda (obj fn-name fn . args)
334 (write (normalize-numbers obj))
337 (define normalize-numbers
339 (if (and (number? x) (inexact? x))
341 (let ((y (/ (round (* (abs x) 1000000)) 1000000)))
342 (if (< x 0) (- y) y)) ; get rid of -0.
343 (make-rectangular (normalize-numbers (real-part x))
344 (normalize-numbers (imag-part x))))
347 (define (sort-list lst <?)
349 (define (mergesort lst)
351 (define (merge lst1 lst2)
352 (cond ((null? lst1) lst2)
355 (let ((e1 (car lst1)) (e2 (car lst2)))
357 (cons e1 (merge (cdr lst1) lst2))
358 (cons e2 (merge lst1 (cdr lst2))))))))
361 (if (or (null? lst) (null? (cdr lst)))
363 (cons (car lst) (split (cddr lst)))))
365 (if (or (null? lst) (null? (cdr lst)))
367 (let* ((lst1 (mergesort (split lst)))
368 (lst2 (mergesort (split (cdr lst)))))
373 ;------------------------------------------------------------------------------
375 (define (test-not) ; no error possible
383 (define (test-boolean?) ; no error possible
384 (try 'boolean? boolean? #f)
385 (try 'boolean? boolean? #t)
386 (try 'boolean? boolean? '())
387 (try 'boolean? boolean? "foo")
391 (define (test-eqv?) ; no error possible
392 (try 'eqv? eqv? #f "foo")
393 (try 'eqv? eqv? #f #f)
394 (try 'eqv? eqv? 'foo 'foo)
395 (try 'eqv? eqv? 12345678901234567890 12345678901234567890)
396 (try 'eqv? eqv? '(1 2) '(1 2))
400 (define (test-eq?) ; no error possible
401 (try 'eq? eq? #f "foo")
403 (try 'eq? eq? 'foo 'foo)
404 (try 'eq? eq? 12345678901234567890 12345678901234567890)
405 (try 'eq? eq? '(1 2) '(1 2))
409 (define (test-equal?) ; no error possible
410 (try 'equal? equal? #f "foo")
411 (try 'equal? equal? #f #f)
412 (try 'equal? equal? 'foo 'foo)
413 (try 'equal? equal? 12345678901234567890 12345678901234567890)
414 (try 'equal? equal? '(1 2) '(1 2))
418 (define (test-pair?) ; no error possible
419 (try 'pair? pair? '(1 . 2))
420 (try 'pair? pair? '())
421 (try 'pair? pair? "foo")
422 (try 'pair? pair? #f)
426 (define (test-cons) ; no error possible
427 (try 'cons cons 1 "foo")
432 (try 'car car '(a . b))
435 (try 'car car '#(a b))
440 (try 'cdr cdr '(a . b))
443 (try 'cdr cdr '#(a b))
447 (define (test-set-car!)
448 (let ((x (cons 'a 'b))) (try* x 'set-car! set-car! x 123))
449 (try 'set-car! set-car! 'a 123)
450 (try 'set-car! set-car! "foo" 123)
451 (try 'set-car! set-car! '#(a b) 123)
455 (define (test-set-cdr!)
456 (let ((x (cons 'a 'b))) (try* x 'set-cdr! set-cdr! x 123))
457 (try 'set-cdr! set-cdr! 'a 123)
458 (try 'set-cdr! set-cdr! "foo" 123)
459 (try 'set-cdr! set-cdr! '#(a b) 123)
464 (try 'caar caar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
465 (try 'caar caar '(((a . b) c . d) (e . f) g . h))
466 (try 'caar caar '((a . b) c . d))
467 (try 'caar caar '(a . b))
473 (try 'cadr cadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
474 (try 'cadr cadr '(((a . b) c . d) (e . f) g . h))
475 (try 'cadr cadr '((a . b) c . d))
476 (try 'cadr cadr '(a . b))
482 (try 'cdar cdar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
483 (try 'cdar cdar '(((a . b) c . d) (e . f) g . h))
484 (try 'cdar cdar '((a . b) c . d))
485 (try 'cdar cdar '(a . b))
491 (try 'cddr cddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
492 (try 'cddr cddr '(((a . b) c . d) (e . f) g . h))
493 (try 'cddr cddr '((a . b) c . d))
494 (try 'cddr cddr '(a . b))
500 (try 'caaar caaar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
501 (try 'caaar caaar '(((a . b) c . d) (e . f) g . h))
502 (try 'caaar caaar '((a . b) c . d))
503 (try 'caaar caaar '(a . b))
504 (try 'caaar caaar 'a)
509 (try 'caadr caadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
510 (try 'caadr caadr '(((a . b) c . d) (e . f) g . h))
511 (try 'caadr caadr '((a . b) c . d))
512 (try 'caadr caadr '(a . b))
513 (try 'caadr caadr 'a)
518 (try 'cddar cddar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
519 (try 'cddar cddar '(((a . b) c . d) (e . f) g . h))
520 (try 'cddar cddar '((a . b) c . d))
521 (try 'cddar cddar '(a . b))
522 (try 'cddar cddar 'a)
527 (try 'cdddr cdddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
528 (try 'cdddr cdddr '(((a . b) c . d) (e . f) g . h))
529 (try 'cdddr cdddr '((a . b) c . d))
530 (try 'cdddr cdddr '(a . b))
531 (try 'cdddr cdddr 'a)
535 (define (test-caaaar)
536 (try 'caaaar caaaar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
537 (try 'caaaar caaaar '(((a . b) c . d) (e . f) g . h))
538 (try 'caaaar caaaar '((a . b) c . d))
539 (try 'caaaar caaaar '(a . b))
540 (try 'caaaar caaaar 'a)
544 (define (test-caaadr)
545 (try 'caaadr caaadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
546 (try 'caaadr caaadr '(((a . b) c . d) (e . f) g . h))
547 (try 'caaadr caaadr '((a . b) c . d))
548 (try 'caaadr caaadr '(a . b))
549 (try 'caaadr caaadr 'a)
553 (define (test-caddar)
554 (try 'caddar caddar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
555 (try 'caddar caddar '(((a . b) c . d) (e . f) g . h))
556 (try 'caddar caddar '((a . b) c . d))
557 (try 'caddar caddar '(a . b))
558 (try 'caddar caddar 'a)
562 (define (test-cadddr)
563 (try 'cadddr cadddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
564 (try 'cadddr cadddr '(((a . b) c . d) (e . f) g . h))
565 (try 'cadddr cadddr '((a . b) c . d))
566 (try 'cadddr cadddr '(a . b))
567 (try 'cadddr cadddr 'a)
571 (define (test-cdaaar)
572 (try 'cdaaar cdaaar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
573 (try 'cdaaar cdaaar '(((a . b) c . d) (e . f) g . h))
574 (try 'cdaaar cdaaar '((a . b) c . d))
575 (try 'cdaaar cdaaar '(a . b))
576 (try 'cdaaar cdaaar 'a)
580 (define (test-cdaadr)
581 (try 'cdaadr cdaadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
582 (try 'cdaadr cdaadr '(((a . b) c . d) (e . f) g . h))
583 (try 'cdaadr cdaadr '((a . b) c . d))
584 (try 'cdaadr cdaadr '(a . b))
585 (try 'cdaadr cdaadr 'a)
589 (define (test-cdddar)
590 (try 'cdddar cdddar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
591 (try 'cdddar cdddar '(((a . b) c . d) (e . f) g . h))
592 (try 'cdddar cdddar '((a . b) c . d))
593 (try 'cdddar cdddar '(a . b))
594 (try 'cdddar cdddar 'a)
598 (define (test-cddddr)
599 (try 'cddddr cddddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
600 (try 'cddddr cddddr '(((a . b) c . d) (e . f) g . h))
601 (try 'cddddr cddddr '((a . b) c . d))
602 (try 'cddddr cddddr '(a . b))
603 (try 'cddddr cddddr 'a)
607 (define (test-null?) ; no error possible
608 (try 'null? null? '())
609 (try 'null? null? '(1 . 2))
610 (try 'null? null? "foo")
611 (try 'null? null? #f)
615 (define (test-list?) ; no error possible
616 (try 'list? list? '())
617 (try 'list? list? '(1 . 2))
618 (try 'list? list? '(1 2))
619 (try 'list? list? "foo")
620 (try 'list? list? #f)
624 (define (test-list) ; no error possible
631 (define (test-length)
632 (try 'length length '())
633 (try 'length length '(1 2 3))
634 (try 'length length '(1 2 . 3))
635 (try 'length length "foo")
639 (define (test-append)
641 (try 'append append #f)
642 (try 'append append '() #f)
643 (try 'append append '(1 2) #f)
644 (try 'append append '(1 2 . "foo") #f)
645 (try 'append append '() '() #f)
646 (try 'append append '() '(1 2) #f)
647 (try 'append append '() '(1 2 . "foo") #f)
648 (try 'append append '(1 2) '() #f)
649 (try 'append append '(1 2 . "foo") '() #f)
650 (try 'append append '(1 2) '(3 4) #f)
651 (try 'append append '() '() '() #f)
652 (try 'append append '(1 2) '(3 4) '(5 6) #f)
656 (define (test-reverse)
657 (try 'reverse reverse '())
658 (try 'reverse reverse '(1 2 3))
659 (try 'reverse reverse '(1 2 . 3))
660 (try 'reverse reverse "foo")
664 (define (test-list-tail)
665 (try 'list-tail list-tail '() 0)
666 (try 'list-tail list-tail '(1 2 . 3) 1)
667 (try 'list-tail list-tail '(1 2) 3)
668 (try 'list-tail list-tail "foo" 1)
672 (define (test-list-ref)
673 (try 'list-ref list-ref '() 0)
674 (try 'list-ref list-ref '(1 2 . 3) 1)
675 (try 'list-ref list-ref '(1 2) 3)
676 (try 'list-ref list-ref "foo" 1)
681 (try 'memq memq 123 '(a b c))
682 (try 'memq memq #f '(a #f b))
683 (try 'memq memq 'foo '(a foo b))
684 (try 'memq memq 12345678901234567890 '(a 12345678901234567890 b))
685 (try 'memq memq '(1 2) '(a (1 2) b))
686 (try 'memq memq 123 '())
687 (try 'memq memq 123 "foo")
688 (try 'memq memq 123 '(a b . "foo"))
693 (try 'memv memv 123 '(a b c))
694 (try 'memv memv #f '(a #f b))
695 (try 'memv memv 'foo '(a foo b))
696 (try 'memv memv 12345678901234567890 '(a 12345678901234567890 b))
697 (try 'memv memv '(1 2) '(a (1 2) b))
698 (try 'memv memv 123 '())
699 (try 'memv memv 123 "foo")
700 (try 'memv memv 123 '(a b . "foo"))
704 (define (test-member)
705 (try 'member member 123 '(a b c))
706 (try 'member member #f '(a #f b))
707 (try 'member member 'foo '(a foo b))
708 (try 'member member 12345678901234567890 '(a 12345678901234567890 b))
709 (try 'member member '(1 2) '(a (1 2) b))
710 (try 'member member 123 '())
711 (try 'member member 123 "foo")
712 (try 'member member 123 '(a b . "foo"))
717 (try 'assq assq 123 '((a . 1) (b . 2) (c . 3)))
718 (try 'assq assq #f '((a . 1) (#f . 2) (b . 3)))
719 (try 'assq assq 'foo '((a . 1) (foo . 2) (b . 3)))
720 (try 'assq assq 12345678901234567890 '((a . 1) (12345678901234567890 . 2) (b . 3)))
721 (try 'assq assq '(1 2) '((a . 1) ((1 2) . 2) (b . 3)))
722 (try 'assq assq 123 '())
723 (try 'assq assq 123 "foo")
724 (try 'assq assq 123 '((a . 1) (b . 2) . "foo"))
725 (try 'assq assq 123 '((a . 1) b (c . 3)))
730 (try 'assv assv 123 '((a . 1) (b . 2) (c . 3)))
731 (try 'assv assv #f '((a . 1) (#f . 2) (b . 3)))
732 (try 'assv assv 'foo '((a . 1) (foo . 2) (b . 3)))
733 (try 'assv assv 12345678901234567890 '((a . 1) (12345678901234567890 . 2) (b . 3)))
734 (try 'assv assv '(1 2) '((a . 1) ((1 2) . 2) (b . 3)))
735 (try 'assv assv 123 '())
736 (try 'assv assv 123 "foo")
737 (try 'assv assv 123 '((a . 1) (b . 2) . "foo"))
738 (try 'assv assv 123 '((a . 1) b (c . 3)))
743 (try 'assoc assoc 123 '((a . 1) (b . 2) (c . 3)))
744 (try 'assoc assoc #f '((a . 1) (#f . 2) (b . 3)))
745 (try 'assoc assoc 'foo '((a . 1) (foo . 2) (b . 3)))
746 (try 'assoc assoc 12345678901234567890 '((a . 1) (12345678901234567890 . 2) (b . 3)))
747 (try 'assoc assoc '(1 2) '((a . 1) ((1 2) . 2) (b . 3)))
748 (try 'assoc assoc 123 '())
749 (try 'assoc assoc 123 "foo")
750 (try 'assoc assoc 123 '((a . 1) (b . 2) . "foo"))
751 (try 'assoc assoc 123 '((a . 1) b (c . 3)))
755 (define (test-symbol?) ; no error possible
756 (try 'symbol? symbol? 'foo)
757 (try 'symbol? symbol? #f)
758 (try 'symbol? symbol? '())
759 (try 'symbol? symbol? "foo")
763 (define (test-symbol->string)
764 (try 'symbol->string symbol->string 'foo)
765 (try 'symbol->string symbol->string "foo")
767 (test-symbol->string)
769 (define (test-string->symbol)
770 (try 'string->symbol string->symbol "foo")
771 (try 'string->symbol string->symbol 'foo)
773 (test-string->symbol)
775 (define (test-number?) ; no error possible
776 (try 'number? number? 1)
777 (try 'number? number? 1/2)
778 (try 'number? number? 1.5)
779 (try 'number? number? +i)
780 (try 'number? number? #f)
784 (define (test-complex?) ; no error possible
785 (try 'complex? complex? 1)
786 (try 'complex? complex? 1/2)
787 (try 'complex? complex? 1.5)
788 (try 'complex? complex? +i)
789 (try 'complex? complex? #f)
793 (define (test-real?) ; no error possible
795 (try 'real? real? 1/2)
796 (try 'real? real? 1.5)
797 (try 'real? real? +i)
798 (try 'real? real? #f)
802 (define (test-rational?) ; no error possible
803 (try 'rational? rational? 1)
804 (try 'rational? rational? 1/2)
805 (try 'rational? rational? 1.5)
806 (try 'rational? rational? +i)
807 (try 'rational? rational? #f)
811 (define (test-integer?) ; no error possible
812 (try 'integer? integer? 1)
813 (try 'integer? integer? 1/2)
814 (try 'integer? integer? 1.5)
815 (try 'integer? integer? +i)
816 (try 'integer? integer? #f)
820 (define (test-exact?)
821 (try 'exact? exact? 1/2)
822 (try 'exact? exact? 1.5)
823 (try 'exact? exact? +i)
824 (try 'exact? exact? #f)
828 (define (test-inexact?)
829 (try 'inexact? inexact? 1/2)
830 (try 'inexact? inexact? 1.5)
831 (try 'inexact? inexact? +i)
832 (try 'inexact? inexact? #f)
938 (try 'zero? zero? 2.0)
939 (try 'zero? zero? 3.4)
940 (try 'zero? zero? +i)
941 (try 'zero? zero? 'foo)
945 (define (test-positive?)
946 (try 'positive? positive? 1)
947 (try 'positive? positive? 2.0)
948 (try 'positive? positive? 3.4)
949 (try 'positive? positive? +i)
950 (try 'positive? positive? 'foo)
954 (define (test-negative?)
955 (try 'negative? negative? 1)
956 (try 'negative? negative? 2.0)
957 (try 'negative? negative? 3.4)
958 (try 'negative? negative? +i)
959 (try 'negative? negative? 'foo)
968 (try 'odd? odd? 'foo)
974 (try 'even? even? 2.0)
975 (try 'even? even? 3.4)
976 (try 'even? even? +i)
977 (try 'even? even? 'foo)
986 (try 'max max 'a 4.0)
989 (try 'max max 1 2 'c)
990 (try 'max max 1+0.i 2+0.i)
999 (try 'min min 'a 4.0)
1001 (try 'min min 1 2 3)
1002 (try 'min min 1 2 'c)
1003 (try 'min min 1+0.i 2+0.i)
1087 (define (test-quotient)
1088 (try 'quotient quotient 9 4)
1089 (try 'quotient quotient 295147905149568077200 34359738366)
1090 (try 'quotient quotient 696898287454081973170944403677937368733396 1180591620717411303422)
1091 (try 'quotient quotient 9. -4.)
1092 (try 'quotient quotient 9. 3/2)
1093 (try 'quotient quotient 9 0)
1094 (try 'quotient quotient 'a 4)
1095 (try 'quotient quotient 9 'b)
1099 (define (test-remainder)
1100 (try 'remainder remainder 9 4)
1101 (try 'remainder remainder 295147905149568077200 34359738366)
1102 (try 'remainder remainder 696898287454081973170944403677937368733396 1180591620717411303422)
1103 (try 'remainder remainder 9. -4.)
1104 (try 'remainder remainder 9. 3/2)
1105 (try 'remainder remainder 9 0)
1106 (try 'remainder remainder 'a 4)
1107 (try 'remainder remainder 9 'b)
1111 (define (test-modulo)
1112 (try 'modulo modulo 9 4)
1113 (try 'modulo modulo 295147905149568077200 34359738366)
1114 (try 'modulo modulo 696898287454081973170944403677937368733396 1180591620717411303422)
1115 (try 'modulo modulo 9. -4.)
1116 (try 'modulo modulo 9. 3/2)
1117 (try 'modulo modulo 9 0)
1118 (try 'modulo modulo 'a 4)
1119 (try 'modulo modulo 9 'b)
1129 (try 'gcd gcd 9. -4.)
1130 (try 'gcd gcd 9. 3/2)
1133 (try 'gcd gcd 12 8 10)
1134 (try 'gcd gcd 12 8 'c)
1144 (try 'lcm lcm 9. -4.)
1145 (try 'lcm lcm 9. 3/2)
1148 (try 'lcm lcm 12 8 10)
1149 (try 'lcm lcm 12 8 'c)
1153 (define (test-numerator)
1154 (try 'numerator numerator 3/2)
1155 (try 'numerator numerator 1.5)
1156 (try 'numerator numerator +i)
1157 (try 'numerator numerator 'a)
1161 (define (test-denominator)
1162 (try 'denominator denominator 3/2)
1163 (try 'denominator denominator 1.5)
1164 (try 'denominator denominator +i)
1165 (try 'denominator denominator 'a)
1169 (define (test-floor)
1170 (try 'floor floor 2/3)
1171 (try 'floor floor 1.2)
1172 (try 'floor floor +i)
1173 (try 'floor floor 'a)
1177 (define (test-ceiling)
1178 (try 'ceiling ceiling 2/3)
1179 (try 'ceiling ceiling 1.2)
1180 (try 'ceiling ceiling +i)
1181 (try 'ceiling ceiling 'a)
1185 (define (test-truncate)
1186 (try 'truncate truncate 2/3)
1187 (try 'truncate truncate 1.2)
1188 (try 'truncate truncate +i)
1189 (try 'truncate truncate 'a)
1193 (define (test-round)
1194 (try 'round round 2/3)
1195 (try 'round round 1.2)
1196 (try 'round round +i)
1197 (try 'round round 'a)
1201 (define (test-rationalize)
1202 (try 'rationalize rationalize -3/2 1/2)
1203 (try 'rationalize rationalize -1.5 0.5)
1204 (try 'rationalize rationalize -1.5 -0.5)
1205 (try 'rationalize rationalize +i 2)
1206 (try 'rationalize rationalize 1 +i)
1207 (try 'rationalize rationalize 'a 2)
1208 (try 'rationalize rationalize 1 'b)
1253 (try 'asin asin 1/2)
1254 (try 'asin asin -1.5)
1261 (try 'acos acos 1/2)
1262 (try 'acos acos -1.5)
1269 (try 'atan atan 1/2)
1270 (try 'atan atan -1.5)
1273 (try 'atan atan -1.5 2.5)
1274 (try 'atan atan 1 +i)
1275 (try 'atan atan +i 2)
1276 (try 'atan atan 1 'b)
1277 (try 'atan atan 'a 2)
1282 (try 'sqrt sqrt 1/4)
1283 (try 'sqrt sqrt -1.5)
1290 (try 'expt expt 1/4 -1.5)
1291 (try 'expt expt 2 +i)
1292 (try 'expt expt +i 2)
1293 (try 'expt expt 'a +i)
1294 (try 'expt expt +i 'b)
1298 (define (test-make-rectangular)
1299 (try 'make-rectangular make-rectangular 1/2 -1.5)
1300 (try 'make-rectangular make-rectangular 1/2 +i)
1301 (try 'make-rectangular make-rectangular +i -1.5)
1302 (try 'make-rectangular make-rectangular 'a 2)
1303 (try 'make-rectangular make-rectangular 1 'b)
1305 (test-make-rectangular)
1307 (define (test-make-polar)
1308 (try 'make-polar make-polar 1/2 -1.5)
1309 (try 'make-polar make-polar 1/2 +i)
1310 (try 'make-polar make-polar +i -1.5)
1311 (try 'make-polar make-polar 'a 2)
1312 (try 'make-polar make-polar 1 'b)
1316 (define (test-real-part)
1317 (try 'real-part real-part 1/2)
1318 (try 'real-part real-part -1.5)
1319 (try 'real-part real-part +i)
1320 (try 'real-part real-part 'a)
1324 (define (test-imag-part)
1325 (try 'imag-part imag-part 1/2)
1326 (try 'imag-part imag-part -1.5)
1327 (try 'imag-part imag-part +i)
1328 (try 'imag-part imag-part 'a)
1332 (define (test-magnitude)
1333 (try 'magnitude magnitude 1/2)
1334 (try 'magnitude magnitude -1.5)
1335 (try 'magnitude magnitude +i)
1336 (try 'magnitude magnitude 'a)
1340 (define (test-angle)
1341 (try 'angle angle 1/2)
1342 (try 'angle angle -1.5)
1343 (try 'angle angle +i)
1344 (try 'angle angle 'a)
1348 (define (test-exact->inexact)
1349 (try 'exact->inexact exact->inexact 1/2)
1350 (try 'exact->inexact exact->inexact -1.5)
1351 (try 'exact->inexact exact->inexact +i)
1352 (try 'exact->inexact exact->inexact 'a)
1354 (test-exact->inexact)
1356 (define (test-inexact->exact)
1357 (try 'inexact->exact inexact->exact 1/2)
1358 (try 'inexact->exact inexact->exact -1.5)
1359 (try 'inexact->exact inexact->exact +i)
1360 (try 'inexact->exact inexact->exact 'a)
1362 (test-inexact->exact)
1364 (define (test-number->string)
1365 (try 'number->string number->string 1/2)
1366 (try 'number->string number->string -1.5)
1367 (try 'number->string number->string +i)
1368 (try 'number->string number->string 'a)
1369 (try 'number->string number->string 123 2)
1370 (try 'number->string number->string 123 3)
1371 (try 'number->string number->string 123 2.)
1372 (try 'number->string number->string 123 +i)
1373 (try 'number->string number->string 123 'a)
1375 (test-number->string)
1377 (define (test-string->number)
1378 (try 'string->number string->number "1/2")
1379 (try 'string->number string->number "-1.5")
1380 (try 'string->number string->number "+i")
1381 (try 'string->number string->number "foo")
1382 (try 'string->number string->number 'a)
1383 (try 'string->number string->number "123" 2)
1384 (try 'string->number string->number "123" 3)
1385 (try 'string->number string->number "123" 2.)
1386 (try 'string->number string->number "123" +i)
1387 (try 'string->number string->number "123" 'a)
1389 (test-string->number)
1391 (define (test-char?) ; no error possible
1392 (try 'char? char? #\A)
1393 (try 'char? char? #f)
1394 (try 'char? char? '())
1395 (try 'char? char? "foo")
1399 (define (test-char=?)
1400 (try 'char=? char=?)
1401 (try 'char=? char=? #\A)
1402 (try 'char=? char=? 123)
1403 (try 'char=? char=? #\A #\A)
1404 (try 'char=? char=? #\A #\B)
1405 (try 'char=? char=? #\B #\A)
1406 (try 'char=? char=? #\A 123)
1407 (try 'char=? char=? 123 #\A)
1408 (try 'char=? char=? #\A #\B #\C)
1409 (try 'char=? char=? #\A #\B #\B)
1410 (try 'char=? char=? #\B #\B #\B)
1411 (try 'char=? char=? #\B #\B #\A)
1412 (try 'char=? char=? #\C #\B #\A)
1413 (try 'char=? char=? #\A #\B 123)
1417 (define (test-char<?)
1418 (try 'char<? char<?)
1419 (try 'char<? char<? #\A)
1420 (try 'char<? char<? 123)
1421 (try 'char<? char<? #\A #\A)
1422 (try 'char<? char<? #\A #\B)
1423 (try 'char<? char<? #\B #\A)
1424 (try 'char<? char<? #\A 123)
1425 (try 'char<? char<? 123 #\A)
1426 (try 'char<? char<? #\A #\B #\C)
1427 (try 'char<? char<? #\A #\B #\B)
1428 (try 'char<? char<? #\B #\B #\B)
1429 (try 'char<? char<? #\B #\B #\A)
1430 (try 'char<? char<? #\C #\B #\A)
1431 (try 'char<? char<? #\A #\B 123)
1435 (define (test-char>?)
1436 (try 'char>? char>?)
1437 (try 'char>? char>? #\A)
1438 (try 'char>? char>? 123)
1439 (try 'char>? char>? #\A #\A)
1440 (try 'char>? char>? #\A #\B)
1441 (try 'char>? char>? #\B #\A)
1442 (try 'char>? char>? #\A 123)
1443 (try 'char>? char>? 123 #\A)
1444 (try 'char>? char>? #\A #\B #\C)
1445 (try 'char>? char>? #\A #\B #\B)
1446 (try 'char>? char>? #\B #\B #\B)
1447 (try 'char>? char>? #\B #\B #\A)
1448 (try 'char>? char>? #\C #\B #\A)
1449 (try 'char>? char>? #\A #\B 123)
1453 (define (test-char<=?)
1454 (try 'char<=? char<=?)
1455 (try 'char<=? char<=? #\A)
1456 (try 'char<=? char<=? 123)
1457 (try 'char<=? char<=? #\A #\A)
1458 (try 'char<=? char<=? #\A #\B)
1459 (try 'char<=? char<=? #\B #\A)
1460 (try 'char<=? char<=? #\A 123)
1461 (try 'char<=? char<=? 123 #\A)
1462 (try 'char<=? char<=? #\A #\B #\C)
1463 (try 'char<=? char<=? #\A #\B #\B)
1464 (try 'char<=? char<=? #\B #\B #\B)
1465 (try 'char<=? char<=? #\B #\B #\A)
1466 (try 'char<=? char<=? #\C #\B #\A)
1467 (try 'char<=? char<=? #\A #\B 123)
1471 (define (test-char>=?)
1472 (try 'char>=? char>=?)
1473 (try 'char>=? char>=? #\A)
1474 (try 'char>=? char>=? 123)
1475 (try 'char>=? char>=? #\A #\A)
1476 (try 'char>=? char>=? #\A #\B)
1477 (try 'char>=? char>=? #\B #\A)
1478 (try 'char>=? char>=? #\A 123)
1479 (try 'char>=? char>=? 123 #\A)
1480 (try 'char>=? char>=? #\A #\B #\C)
1481 (try 'char>=? char>=? #\A #\B #\B)
1482 (try 'char>=? char>=? #\B #\B #\B)
1483 (try 'char>=? char>=? #\B #\B #\A)
1484 (try 'char>=? char>=? #\C #\B #\A)
1485 (try 'char>=? char>=? #\A #\B 123)
1489 (define (test-char-ci=?)
1490 (try 'char-ci=? char-ci=?)
1491 (try 'char-ci=? char-ci=? #\A)
1492 (try 'char-ci=? char-ci=? 123)
1493 (try 'char-ci=? char-ci=? #\A #\a)
1494 (try 'char-ci=? char-ci=? #\A #\b)
1495 (try 'char-ci=? char-ci=? #\B #\a)
1496 (try 'char-ci=? char-ci=? #\A 123)
1497 (try 'char-ci=? char-ci=? 123 #\A)
1498 (try 'char-ci=? char-ci=? #\A #\b #\C)
1499 (try 'char-ci=? char-ci=? #\A #\b #\B)
1500 (try 'char-ci=? char-ci=? #\B #\b #\B)
1501 (try 'char-ci=? char-ci=? #\B #\b #\A)
1502 (try 'char-ci=? char-ci=? #\C #\b #\A)
1503 (try 'char-ci=? char-ci=? #\A #\b 123)
1507 (define (test-char-ci<?)
1508 (try 'char-ci<? char-ci<?)
1509 (try 'char-ci<? char-ci<? #\A)
1510 (try 'char-ci<? char-ci<? 123)
1511 (try 'char-ci<? char-ci<? #\A #\a)
1512 (try 'char-ci<? char-ci<? #\A #\b)
1513 (try 'char-ci<? char-ci<? #\B #\a)
1514 (try 'char-ci<? char-ci<? #\A 123)
1515 (try 'char-ci<? char-ci<? 123 #\A)
1516 (try 'char-ci<? char-ci<? #\A #\b #\C)
1517 (try 'char-ci<? char-ci<? #\A #\b #\B)
1518 (try 'char-ci<? char-ci<? #\B #\b #\B)
1519 (try 'char-ci<? char-ci<? #\B #\b #\A)
1520 (try 'char-ci<? char-ci<? #\C #\b #\A)
1521 (try 'char-ci<? char-ci<? #\A #\b 123)
1525 (define (test-char-ci>?)
1526 (try 'char-ci>? char-ci>?)
1527 (try 'char-ci>? char-ci>? #\A)
1528 (try 'char-ci>? char-ci>? 123)
1529 (try 'char-ci>? char-ci>? #\A #\a)
1530 (try 'char-ci>? char-ci>? #\A #\b)
1531 (try 'char-ci>? char-ci>? #\B #\a)
1532 (try 'char-ci>? char-ci>? #\A 123)
1533 (try 'char-ci>? char-ci>? 123 #\A)
1534 (try 'char-ci>? char-ci>? #\A #\b #\C)
1535 (try 'char-ci>? char-ci>? #\A #\b #\B)
1536 (try 'char-ci>? char-ci>? #\B #\b #\B)
1537 (try 'char-ci>? char-ci>? #\B #\b #\A)
1538 (try 'char-ci>? char-ci>? #\C #\b #\A)
1539 (try 'char-ci>? char-ci>? #\A #\b 123)
1543 (define (test-char-ci<=?)
1544 (try 'char-ci<=? char-ci<=?)
1545 (try 'char-ci<=? char-ci<=? #\A)
1546 (try 'char-ci<=? char-ci<=? 123)
1547 (try 'char-ci<=? char-ci<=? #\A #\a)
1548 (try 'char-ci<=? char-ci<=? #\A #\b)
1549 (try 'char-ci<=? char-ci<=? #\B #\a)
1550 (try 'char-ci<=? char-ci<=? #\A 123)
1551 (try 'char-ci<=? char-ci<=? 123 #\A)
1552 (try 'char-ci<=? char-ci<=? #\A #\b #\C)
1553 (try 'char-ci<=? char-ci<=? #\A #\b #\B)
1554 (try 'char-ci<=? char-ci<=? #\B #\b #\B)
1555 (try 'char-ci<=? char-ci<=? #\B #\b #\A)
1556 (try 'char-ci<=? char-ci<=? #\C #\b #\A)
1557 (try 'char-ci<=? char-ci<=? #\A #\b 123)
1561 (define (test-char-ci>=?)
1562 (try 'char-ci>=? char-ci>=?)
1563 (try 'char-ci>=? char-ci>=? #\A)
1564 (try 'char-ci>=? char-ci>=? 123)
1565 (try 'char-ci>=? char-ci>=? #\A #\a)
1566 (try 'char-ci>=? char-ci>=? #\A #\b)
1567 (try 'char-ci>=? char-ci>=? #\B #\a)
1568 (try 'char-ci>=? char-ci>=? #\A 123)
1569 (try 'char-ci>=? char-ci>=? 123 #\A)
1570 (try 'char-ci>=? char-ci>=? #\A #\b #\C)
1571 (try 'char-ci>=? char-ci>=? #\A #\b #\B)
1572 (try 'char-ci>=? char-ci>=? #\B #\b #\B)
1573 (try 'char-ci>=? char-ci>=? #\B #\b #\A)
1574 (try 'char-ci>=? char-ci>=? #\C #\b #\A)
1575 (try 'char-ci>=? char-ci>=? #\A #\b 123)
1579 (define (test-char-alphabetic?)
1580 (try 'char-alphabetic? char-alphabetic? #\a)
1581 (try 'char-alphabetic? char-alphabetic? #\A)
1582 (try 'char-alphabetic? char-alphabetic? #\0)
1583 (try 'char-alphabetic? char-alphabetic? #\newline)
1584 (try 'char-alphabetic? char-alphabetic? 123)
1586 (test-char-alphabetic?)
1588 (define (test-char-numeric?)
1589 (try 'char-numeric? char-numeric? #\a)
1590 (try 'char-numeric? char-numeric? #\A)
1591 (try 'char-numeric? char-numeric? #\0)
1592 (try 'char-numeric? char-numeric? #\newline)
1593 (try 'char-numeric? char-numeric? 123)
1595 (test-char-numeric?)
1597 (define (test-char-whitespace?)
1598 (try 'char-whitespace? char-whitespace? #\a)
1599 (try 'char-whitespace? char-whitespace? #\A)
1600 (try 'char-whitespace? char-whitespace? #\0)
1601 (try 'char-whitespace? char-whitespace? #\newline)
1602 (try 'char-whitespace? char-whitespace? 123)
1604 (test-char-whitespace?)
1606 (define (test-char-upper-case?)
1607 (try 'char-upper-case? char-upper-case? #\a)
1608 (try 'char-upper-case? char-upper-case? #\A)
1609 (try 'char-upper-case? char-upper-case? #\0)
1610 (try 'char-upper-case? char-upper-case? #\newline)
1611 (try 'char-upper-case? char-upper-case? 123)
1613 (test-char-upper-case?)
1615 (define (test-char-lower-case?)
1616 (try 'char-lower-case? char-lower-case? #\a)
1617 (try 'char-lower-case? char-lower-case? #\A)
1618 (try 'char-lower-case? char-lower-case? #\0)
1619 (try 'char-lower-case? char-lower-case? #\newline)
1620 (try 'char-lower-case? char-lower-case? 123)
1622 (test-char-lower-case?)
1624 (define (test-char->integer)
1625 (try 'char->integer char->integer #\A)
1626 (try 'char->integer char->integer 123)
1628 (test-char->integer)
1630 (define (test-integer->char)
1631 (try 'integer->char integer->char 123)
1632 (try 'integer->char integer->char -1)
1633 (try 'integer->char integer->char #x110000)
1634 (try 'integer->char integer->char #xd800)
1635 (try 'integer->char integer->char 123.0)
1636 (try 'integer->char integer->char #\A)
1638 (test-integer->char)
1640 (define (test-char-upcase)
1641 (try 'char-upcase char-upcase #\a)
1642 (try 'char-upcase char-upcase #\A)
1643 (try 'char-upcase char-upcase #\@)
1644 (try 'char-upcase char-upcase 123)
1645 (try 'char-upcase char-upcase 'a)
1646 (try 'char-upcase char-upcase "a")
1650 (define (test-char-downcase)
1651 (try 'char-downcase char-downcase #\a)
1652 (try 'char-downcase char-downcase #\A)
1653 (try 'char-downcase char-downcase #\@)
1654 (try 'char-downcase char-downcase 123)
1655 (try 'char-downcase char-downcase 'a)
1656 (try 'char-downcase char-downcase "a")
1658 (test-char-downcase)
1660 (define (test-string?) ; no error possible
1662 (string? 12345678901234567890)
1666 (define (test-make-string)
1667 (try 'make-string make-string 0)
1668 (try 'make-string make-string 3)
1669 (try 'make-string make-string 536870911)
1670 (try 'make-string make-string 12345678901234567890)
1671 (try 'make-string make-string -1)
1672 (try 'make-string make-string 1.5)
1673 (try 'make-string make-string 5 #\6)
1674 (try 'make-string make-string 1 'a)
1678 (define (test-string)
1679 (try 'string string)
1680 (try 'string string #\5)
1681 (try 'string string #\5 #\6)
1682 (try 'string string #\5 'b #\7)
1686 (define (test-string-length)
1687 (try 'string-length string-length "5678")
1688 (try 'string-length string-length 12345678901234567890)
1690 (test-string-length)
1692 (define (test-string-ref)
1693 (try 'string-ref string-ref "5678" 3)
1694 (try 'string-ref string-ref "56" -1)
1695 (try 'string-ref string-ref "56" 2)
1696 (try 'string-ref string-ref "56" 12345678901234567890)
1697 (try 'string-ref string-ref 12345678901234567890 0)
1701 (define (test-string-set!)
1702 (let ((x (string #\5 #\6))) (try* x 'string-set! string-set! x 1 #\3))
1703 (let ((x (string #\5 #\6))) (try* x 'string-set! string-set! x -1 #\3))
1704 (let ((x (string #\5 #\6))) (try* x 'string-set! string-set! x 2 #\3))
1705 (let ((x (string #\5 #\6))) (try* x 'string-set! string-set! x 12345678901234567890 #\3))
1706 (let ((x (string #\5 #\6))) (try* x 'string-set! string-set! x 1 'a))
1707 (try 'string-set! string-set! 12345678901234567890 0 #\3)
1711 (define (test-string=?)
1712 (try 'string=? string=?)
1713 (try 'string=? string=? "A")
1714 (try 'string=? string=? 123)
1715 (try 'string=? string=? "A" "A")
1716 (try 'string=? string=? "A" "B")
1717 (try 'string=? string=? "A" "A ")
1718 (try 'string=? string=? "B" "A")
1719 (try 'string=? string=? "A " "A")
1720 (try 'string=? string=? "A" 123)
1721 (try 'string=? string=? 123 "A")
1722 (try 'string=? string=? "A" 123)
1723 (try 'string=? string=? "A" "B" "C")
1724 (try 'string=? string=? "A" "B" "B")
1725 (try 'string=? string=? "B" "B" "B")
1726 (try 'string=? string=? "B" "B" "A")
1727 (try 'string=? string=? "C" "B" "A")
1728 (try 'string=? string=? "A" "B" 123)
1732 (define (test-string<?)
1733 (try 'string<? string<?)
1734 (try 'string<? string<? "A")
1735 (try 'string<? string<? 123)
1736 (try 'string<? string<? "A" "A")
1737 (try 'string<? string<? "A" "B")
1738 (try 'string<? string<? "A" "A ")
1739 (try 'string<? string<? "B" "A")
1740 (try 'string<? string<? "A " "A")
1741 (try 'string<? string<? "A" 123)
1742 (try 'string<? string<? 123 "A")
1743 (try 'string<? string<? "A" 123)
1744 (try 'string<? string<? "A" "B" "C")
1745 (try 'string<? string<? "A" "B" "B")
1746 (try 'string<? string<? "B" "B" "B")
1747 (try 'string<? string<? "B" "B" "A")
1748 (try 'string<? string<? "C" "B" "A")
1749 (try 'string<? string<? "A" "B" 123)
1753 (define (test-string>?)
1754 (try 'string>? string>?)
1755 (try 'string>? string>? "A")
1756 (try 'string>? string>? 123)
1757 (try 'string>? string>? "A" "A")
1758 (try 'string>? string>? "A" "B")
1759 (try 'string>? string>? "A" "A ")
1760 (try 'string>? string>? "B" "A")
1761 (try 'string>? string>? "A " "A")
1762 (try 'string>? string>? "A" 123)
1763 (try 'string>? string>? 123 "A")
1764 (try 'string>? string>? "A" 123)
1765 (try 'string>? string>? "A" "B" "C")
1766 (try 'string>? string>? "A" "B" "B")
1767 (try 'string>? string>? "B" "B" "B")
1768 (try 'string>? string>? "B" "B" "A")
1769 (try 'string>? string>? "C" "B" "A")
1770 (try 'string>? string>? "A" "B" 123)
1774 (define (test-string<=?)
1775 (try 'string<=? string<=?)
1776 (try 'string<=? string<=? "A")
1777 (try 'string<=? string<=? 123)
1778 (try 'string<=? string<=? "A" "A")
1779 (try 'string<=? string<=? "A" "B")
1780 (try 'string<=? string<=? "A" "A ")
1781 (try 'string<=? string<=? "B" "A")
1782 (try 'string<=? string<=? "A " "A")
1783 (try 'string<=? string<=? "A" 123)
1784 (try 'string<=? string<=? 123 "A")
1785 (try 'string<=? string<=? "A" 123)
1786 (try 'string<=? string<=? "A" "B" "C")
1787 (try 'string<=? string<=? "A" "B" "B")
1788 (try 'string<=? string<=? "B" "B" "B")
1789 (try 'string<=? string<=? "B" "B" "A")
1790 (try 'string<=? string<=? "C" "B" "A")
1791 (try 'string<=? string<=? "A" "B" 123)
1795 (define (test-string>=?)
1796 (try 'string>=? string>=?)
1797 (try 'string>=? string>=? "A")
1798 (try 'string>=? string>=? 123)
1799 (try 'string>=? string>=? "A" "A")
1800 (try 'string>=? string>=? "A" "B")
1801 (try 'string>=? string>=? "A" "A ")
1802 (try 'string>=? string>=? "B" "A")
1803 (try 'string>=? string>=? "A " "A")
1804 (try 'string>=? string>=? "A" 123)
1805 (try 'string>=? string>=? 123 "A")
1806 (try 'string>=? string>=? "A" 123)
1807 (try 'string>=? string>=? "A" "B" "C")
1808 (try 'string>=? string>=? "A" "B" "B")
1809 (try 'string>=? string>=? "B" "B" "B")
1810 (try 'string>=? string>=? "B" "B" "A")
1811 (try 'string>=? string>=? "C" "B" "A")
1812 (try 'string>=? string>=? "A" "B" 123)
1816 (define (test-string-ci=?)
1817 (try 'string-ci=? string-ci=?)
1818 (try 'string-ci=? string-ci=? "A")
1819 (try 'string-ci=? string-ci=? 123)
1820 (try 'string-ci=? string-ci=? "A" "a")
1821 (try 'string-ci=? string-ci=? "A" "b")
1822 (try 'string-ci=? string-ci=? "A" "a ")
1823 (try 'string-ci=? string-ci=? "B" "a")
1824 (try 'string-ci=? string-ci=? "A " "a")
1825 (try 'string-ci=? string-ci=? "A" 123)
1826 (try 'string-ci=? string-ci=? 123 "A")
1827 (try 'string-ci=? string-ci=? "A" 123)
1828 (try 'string-ci=? string-ci=? "A" "b" "C")
1829 (try 'string-ci=? string-ci=? "A" "b" "B")
1830 (try 'string-ci=? string-ci=? "B" "b" "B")
1831 (try 'string-ci=? string-ci=? "B" "b" "A")
1832 (try 'string-ci=? string-ci=? "C" "b" "A")
1833 (try 'string-ci=? string-ci=? "A" "b" 123)
1837 (define (test-string-ci<?)
1838 (try 'string-ci<? string-ci<?)
1839 (try 'string-ci<? string-ci<? "A")
1840 (try 'string-ci<? string-ci<? 123)
1841 (try 'string-ci<? string-ci<? "A" "a")
1842 (try 'string-ci<? string-ci<? "A" "b")
1843 (try 'string-ci<? string-ci<? "A" "a ")
1844 (try 'string-ci<? string-ci<? "B" "a")
1845 (try 'string-ci<? string-ci<? "A " "a")
1846 (try 'string-ci<? string-ci<? "A" 123)
1847 (try 'string-ci<? string-ci<? 123 "A")
1848 (try 'string-ci<? string-ci<? "A" 123)
1849 (try 'string-ci<? string-ci<? "A" "b" "C")
1850 (try 'string-ci<? string-ci<? "A" "b" "B")
1851 (try 'string-ci<? string-ci<? "B" "b" "B")
1852 (try 'string-ci<? string-ci<? "B" "b" "A")
1853 (try 'string-ci<? string-ci<? "C" "b" "A")
1854 (try 'string-ci<? string-ci<? "A" "b" 123)
1858 (define (test-string-ci>?)
1859 (try 'string-ci>? string-ci>?)
1860 (try 'string-ci>? string-ci>? "A")
1861 (try 'string-ci>? string-ci>? 123)
1862 (try 'string-ci>? string-ci>? "A" "a")
1863 (try 'string-ci>? string-ci>? "A" "b")
1864 (try 'string-ci>? string-ci>? "A" "a ")
1865 (try 'string-ci>? string-ci>? "B" "a")
1866 (try 'string-ci>? string-ci>? "A " "a")
1867 (try 'string-ci>? string-ci>? "A" 123)
1868 (try 'string-ci>? string-ci>? 123 "A")
1869 (try 'string-ci>? string-ci>? "A" 123)
1870 (try 'string-ci>? string-ci>? "A" "b" "C")
1871 (try 'string-ci>? string-ci>? "A" "b" "B")
1872 (try 'string-ci>? string-ci>? "B" "b" "B")
1873 (try 'string-ci>? string-ci>? "B" "b" "A")
1874 (try 'string-ci>? string-ci>? "C" "b" "A")
1875 (try 'string-ci>? string-ci>? "A" "b" 123)
1879 (define (test-string-ci<=?)
1880 (try 'string-ci<=? string-ci<=?)
1881 (try 'string-ci<=? string-ci<=? "A")
1882 (try 'string-ci<=? string-ci<=? 123)
1883 (try 'string-ci<=? string-ci<=? "A" "a")
1884 (try 'string-ci<=? string-ci<=? "A" "b")
1885 (try 'string-ci<=? string-ci<=? "A" "a ")
1886 (try 'string-ci<=? string-ci<=? "B" "a")
1887 (try 'string-ci<=? string-ci<=? "A " "a")
1888 (try 'string-ci<=? string-ci<=? "A" 123)
1889 (try 'string-ci<=? string-ci<=? 123 "A")
1890 (try 'string-ci<=? string-ci<=? "A" 123)
1891 (try 'string-ci<=? string-ci<=? "A" "b" "C")
1892 (try 'string-ci<=? string-ci<=? "A" "b" "B")
1893 (try 'string-ci<=? string-ci<=? "B" "b" "B")
1894 (try 'string-ci<=? string-ci<=? "B" "b" "A")
1895 (try 'string-ci<=? string-ci<=? "C" "b" "A")
1896 (try 'string-ci<=? string-ci<=? "A" "b" 123)
1900 (define (test-string-ci>=?)
1901 (try 'string-ci>=? string-ci>=?)
1902 (try 'string-ci>=? string-ci>=? "A")
1903 (try 'string-ci>=? string-ci>=? 123)
1904 (try 'string-ci>=? string-ci>=? "A" "a")
1905 (try 'string-ci>=? string-ci>=? "A" "b")
1906 (try 'string-ci>=? string-ci>=? "A" "a ")
1907 (try 'string-ci>=? string-ci>=? "B" "a")
1908 (try 'string-ci>=? string-ci>=? "A " "a")
1909 (try 'string-ci>=? string-ci>=? "A" 123)
1910 (try 'string-ci>=? string-ci>=? 123 "A")
1911 (try 'string-ci>=? string-ci>=? "A" 123)
1912 (try 'string-ci>=? string-ci>=? "A" "b" "C")
1913 (try 'string-ci>=? string-ci>=? "A" "b" "B")
1914 (try 'string-ci>=? string-ci>=? "B" "b" "B")
1915 (try 'string-ci>=? string-ci>=? "B" "b" "A")
1916 (try 'string-ci>=? string-ci>=? "C" "b" "A")
1917 (try 'string-ci>=? string-ci>=? "A" "b" 123)
1921 (define (test-substring)
1922 (try 'substring substring "abcdef" 0 2)
1923 (try 'substring substring "abcdef" 2 2)
1924 (try 'substring substring "abcdef" 2 5)
1925 (try 'substring substring "abcdef" 2 6)
1926 (try 'substring substring "abcdef" 2 7)
1927 (try 'substring substring "abcdef" -1 5)
1928 (try 'substring substring "abcdef" 2 1)
1929 (try 'substring substring "abcdef" 2 12345678901234567890)
1930 (try 'substring substring "abcdef" 12345678901234567890 2)
1931 (try 'substring substring "abcdef" #\a 5)
1932 (try 'substring substring "abcdef" 2 #\a)
1933 (try 'substring substring 12345678901234567890 0 2)
1937 (define (test-string-append)
1938 (try 'string-append string-append)
1939 (try 'string-append string-append "ab")
1940 (try 'string-append string-append 12345678901234567890)
1941 (try 'string-append string-append "ab" "cd")
1942 (try 'string-append string-append "ab" 12345678901234567890)
1943 (try 'string-append string-append 12345678901234567890 "cd")
1944 (try 'string-append string-append "ab" "cd" "ef")
1945 (try 'string-append string-append "ab" "cd" 12345678901234567890)
1947 (test-string-append)
1949 (define (test-string->list)
1950 (try 'string->list string->list "56")
1951 (try 'string->list string->list 12345678901234567890)
1955 (define (test-list->string)
1956 (try 'list->string list->string '(#\5 #\6))
1957 (try 'list->string list->string '(#\5 b))
1958 (try 'list->string list->string 12345678901234567890)
1962 (define (test-string-copy)
1963 (try 'string-copy string-copy "ab")
1964 (try 'string-copy string-copy 12345678901234567890)
1968 (define (test-string-fill!)
1969 (let ((x (string #\5 #\6))) (try* x 'string-fill! string-fill! x #\a))
1970 (let ((x (string #\5 #\6))) (try* x 'string-fill! string-fill! x 'a))
1971 (try 'string-fill! string-fill! 12345678901234567890 #\a)
1975 (define (test-vector?) ; no error possible
1976 (vector? '#(5 6 7 8))
1977 (vector? 12345678901234567890)
1981 (define (test-make-vector)
1982 (try 'make-vector make-vector 0)
1983 (try 'make-vector make-vector 3)
1984 (try 'make-vector make-vector 536870911)
1985 (try 'make-vector make-vector 12345678901234567890)
1986 (try 'make-vector make-vector -1)
1987 (try 'make-vector make-vector 1.5)
1988 (try 'make-vector make-vector 5 'a)
1992 (define (test-vector)
1993 (try 'vector vector)
1994 (try 'vector vector 5)
1995 (try 'vector vector 5 'b)
1996 (try 'vector vector 5 'b 7)
2000 (define (test-vector-length)
2001 (try 'vector-length vector-length '#(5 6 7 8))
2002 (try 'vector-length vector-length 12345678901234567890)
2004 (test-vector-length)
2006 (define (test-vector-ref)
2007 (try 'vector-ref vector-ref '#(5 6 7 8) 3)
2008 (try 'vector-ref vector-ref '#(5 6) -1)
2009 (try 'vector-ref vector-ref '#(5 6) 2)
2010 (try 'vector-ref vector-ref '#(5 6) 12345678901234567890)
2011 (try 'vector-ref vector-ref 12345678901234567890 0)
2015 (define (test-vector-set!)
2016 (let ((x (vector 5 6))) (try* x 'vector-set! vector-set! x 1 3))
2017 (let ((x (vector 5 6))) (try* x 'vector-set! vector-set! x -1 3))
2018 (let ((x (vector 5 6))) (try* x 'vector-set! vector-set! x 2 3))
2019 (let ((x (vector 5 6))) (try* x 'vector-set! vector-set! x 12345678901234567890 3))
2020 (let ((x (vector 5 6))) (try* x 'vector-set! vector-set! x 1 'a))
2021 (try 'vector-set! vector-set! 12345678901234567890 0 3)
2025 (define (test-vector->list)
2026 (try 'vector->list vector->list '#(5 6))
2027 (try 'vector->list vector->list 12345678901234567890)
2031 (define (test-list->vector)
2032 (try 'list->vector list->vector '(5 b))
2033 (try 'list->vector list->vector 12345678901234567890)
2037 (define (test-vector-fill!)
2038 (let ((x (vector 5 6))) (try* x 'vector-fill! vector-fill! x 'a))
2039 (try 'vector-fill! vector-fill! 12345678901234567890 'a)
2043 (define (test-procedure?) ; no error possible
2044 (try 'procedure? procedure? append)
2045 (try 'procedure? procedure? '())
2046 (try 'procedure? procedure? "foo")
2047 (try 'procedure? procedure? #f)
2051 (define (test-apply)
2052 (try 'apply apply + '())
2053 (try 'apply apply + '(2 3))
2054 (try 'apply apply + 2 '(3))
2055 (try 'apply apply + 2 3 '())
2056 (try 'apply apply + '(2 . #f))
2057 (try 'apply apply + #f)
2058 (try 'apply apply #f '(2 3))
2063 (try 'map map sqrt '())
2064 (try 'map map sqrt '(1 4 9))
2065 (try 'map map sqrt #f)
2066 (try 'map map sqrt '(1 . #f))
2067 (try 'map map #f '(1 4 9))
2068 (try 'map map + '() '())
2069 (try 'map map + '(1 2 3) '(0 2 6))
2070 (try 'map map + '(1 2 3) '(0 2))
2071 (try 'map map + '(1 2) '(0 2 6))
2072 (try 'map map + #f '())
2073 (try 'map map + '() #f)
2074 (try 'map map + '(1 . #f) '(0 . #f))
2075 (try 'map map #f '(1 2 3) '(0 2 6))
2076 (try 'map map + '() '() '())
2077 (try 'map map + '(1 2 3) '(0 2 6) '(10 100 1000))
2078 (try 'map map + '(1 2 3) '(0 2) '(10 100 1000))
2079 (try 'map map + '(1 2) '(0 2 6) '(10 100 1000))
2080 (try 'map map + #f '() '())
2081 (try 'map map + '() #f '())
2082 (try 'map map + '() '() #f)
2083 (try 'map map + '(1 . #f) '(0 . #f) '(10 . #f))
2084 (try 'map map #f '(1 2 3) '(0 2 6) '(10 100 1000))
2088 (define (test-for-each)
2089 (try 'for-each for-each sqrt '())
2090 (try 'for-each for-each sqrt '(1 4 9))
2091 (try 'for-each for-each sqrt #f)
2092 (try 'for-each for-each sqrt '(1 . #f))
2093 (try 'for-each for-each #f '(1 4 9))
2094 (try 'for-each for-each + '() '())
2095 (try 'for-each for-each + '(1 2 3) '(0 2 6))
2096 (try 'for-each for-each + '(1 2 3) '(0 2))
2097 (try 'for-each for-each + '(1 2) '(0 2 6))
2098 (try 'for-each for-each + #f '())
2099 (try 'for-each for-each + '() #f)
2100 (try 'for-each for-each + '(1 . #f) '(0 . #f))
2101 (try 'for-each for-each #f '(1 2 3) '(0 2 6))
2102 (try 'for-each for-each + '() '() '())
2103 (try 'for-each for-each + '(1 2 3) '(0 2 6) '(10 100 1000))
2104 (try 'for-each for-each + '(1 2 3) '(0 2) '(10 100 1000))
2105 (try 'for-each for-each + '(1 2 3) '(0 2) '(10 100 1000))
2106 (try 'for-each for-each + '(1 2) '(0 2 6) '(10 100 1000))
2107 (try 'for-each for-each + #f '() '())
2108 (try 'for-each for-each + '() #f '())
2109 (try 'for-each for-each + '() '() #f)
2110 (try 'for-each for-each + '(1 . #f) '(0 . #f) '(10 . #f))
2111 (try 'for-each for-each #f '(1 2 3) '(0 2 6) '(10 100 1000))
2115 (define (test-force) ; no error possible
2116 ;(let ((x (delay (+ 2 3)))) (try 'force force x))
2117 (try 'force force 123)
2121 (define (test-call-with-current-continuation)
2122 ;(try 'call-with-current-continuation call-with-current-continuation list)
2123 (try 'call-with-current-continuation call-with-current-continuation #f)
2125 (test-call-with-current-continuation)
2127 (define (test-call-with-input-file)
2128 (try 'call-with-input-file call-with-input-file #f list)
2129 (try 'call-with-input-file call-with-input-file "tmp" #f)
2130 (try 'call-with-input-file call-with-input-file "notexist" list)
2132 (test-call-with-input-file)
2134 (define (test-call-with-output-file)
2135 (try 'call-with-output-file call-with-output-file #f list)
2136 (try 'call-with-output-file call-with-output-file "tmp" #f)
2138 (test-call-with-output-file)
2140 (define (test-input-port?)
2141 (try 'input-port? input-port? (current-input-port))
2142 (try 'input-port? input-port? (current-output-port))
2143 (try 'input-port? input-port? #f)
2147 (define (test-output-port?)
2148 (try 'output-port? output-port? (current-output-port))
2149 (try 'output-port? output-port? (current-input-port))
2150 (try 'output-port? output-port? #f)
2154 (define (test-current-input-port) ; no error possible
2155 (try 'current-input-port current-input-port)
2157 (test-current-input-port)
2159 (define (test-current-output-port) ; no error possible
2160 (try 'current-output-port current-output-port)
2162 (test-current-output-port)
2164 (define (test-with-input-from-file)
2165 (try 'with-input-from-file with-input-from-file #f list)
2166 (try 'with-input-from-file with-input-from-file "tmp" #f)
2167 (try 'with-input-from-file with-input-from-file "noexist" list)
2169 (test-with-input-from-file)
2171 (define (test-with-output-to-file)
2172 (try 'with-output-to-file with-output-to-file #f list)
2173 (try 'with-output-to-file with-output-to-file "tmp" #f)
2175 (test-with-output-to-file)
2177 (define (test-open-input-file)
2178 (try 'open-input-file open-input-file #f)
2179 (try 'open-input-file open-input-file "noexist")
2181 (test-open-input-file)
2183 (define (test-open-output-file)
2184 (try 'open-output-file open-output-file #f)
2186 (test-open-output-file)
2188 (define (test-close-input-port)
2189 (try 'close-input-port close-input-port (current-output-port))
2190 (try 'close-input-port close-input-port #f)
2192 (test-close-input-port)
2194 (define (test-close-output-port)
2195 (try 'close-output-port close-output-port (current-input-port))
2196 (try 'close-output-port close-output-port #f)
2198 (test-close-output-port)
2202 (try 'read read (current-output-port))
2207 (define (test-read-char)
2208 (try 'read-char read-char)
2209 (try 'read-char read-char (current-output-port))
2210 (try 'read-char read-char #f)
2214 (define (test-peek-char)
2215 (try 'peek-char peek-char)
2216 (try 'peek-char peek-char (current-output-port))
2217 (try 'peek-char peek-char #f)
2221 (define (test-eof-object?) ; no error possible
2222 (try 'eof-object? eof-object? #f)
2223 (try 'eof-object? eof-object? "abc")
2227 (define (test-char-ready?)
2228 (try 'char-ready? char-ready?)
2229 (try 'char-ready? char-ready? (current-input-port))
2230 (try 'char-ready? char-ready? (current-output-port))
2231 (try 'char-ready? char-ready? #f)
2235 (define (test-write)
2236 (try 'write write "abc")
2237 (try 'write write "abc" (current-output-port))
2238 (try 'write write "abc" (current-input-port))
2239 (try 'write write "abc" #f)
2243 (define (test-display)
2244 (try 'display display "abc")
2245 (try 'display display "abc" (current-output-port))
2246 (try 'display display "abc" (current-input-port))
2247 (try 'display display "abc" #f)
2251 (define (test-newline)
2252 (try 'newline newline)
2253 (try 'newline newline (current-output-port))
2254 (try 'newline newline (current-input-port))
2255 (try 'newline newline #f)
2259 (define (test-write-char)
2260 (try 'write-char write-char #\A)
2261 (try 'write-char write-char 123)
2262 (try 'write-char write-char #\A (current-output-port))
2263 (try 'write-char write-char 123 (current-output-port))
2264 (try 'write-char write-char #\A (current-input-port))
2265 (try 'write-char write-char #\A #f)
2270 (try 'load load "noexist")
2275 (define (test-transcript-on)
2276 (try 'transcript-on transcript-on #f)
2278 (test-transcript-on)
2280 (define (test-transcript-off)
2281 (try 'transcript-off transcript-off)
2283 (test-transcript-off)
2285 ;------------------------------------------------------------------------------
2287 (define (path-exp file dir)
2288 (string-append dir "/" file))
2290 (define (test-setenv)
2291 (try 'setenv setenv "UNKNOWNVAR1")
2292 (try 'setenv setenv "UNKNOWNVAR2" "NOW-DEFINED")
2296 (define (test-getenv)
2297 (try 'getenv getenv "UNKNOWNVAR1")
2298 (try 'getenv getenv "UNKNOWNVAR2")
2299 (try 'getenv getenv "UNKNOWNVAR1" 999)
2300 (try 'getenv getenv "UNKNOWNVAR2" 999)
2304 (define (test-command-line)
2305 (define (cdr-command-line) (cdr (command-line)))
2306 (try 'cdr-command-line cdr-command-line)
2310 (define (test-shell-command)
2311 (try 'shell-command shell-command "echo hello > newfile1")
2312 ;(try 'shell-command shell-command "notexist")
2314 (test-shell-command)
2316 (define (test-create-directory)
2317 (try 'create-directory create-directory "newdir1")
2318 (try 'create-directory create-directory "newdir1")
2319 (try 'create-directory create-directory "newfile1")
2321 (test-create-directory)
2323 (define (test-rename-file)
2324 (try 'rename-file rename-file "newdir1" "newdir2")
2325 (try 'rename-file rename-file "newdir1" "newdir2")
2326 (try 'rename-file rename-file "newfile1" (path-exp "aaa" "newdir2"))
2327 (try 'rename-file rename-file "newfile1" (path-exp "aaa" "newdir2"))
2331 (define (test-copy-file)
2332 (try 'copy-file copy-file "error.scm" (path-exp "bbb" "newdir2"))
2333 (try 'copy-file copy-file "notexist" (path-exp "ccc" "newdir2"))
2337 (define (test-directory-files)
2338 (define (sort-directory-files)
2339 (sort-list (directory-files "newdir2") string<?))
2340 (try 'sort-directory-files sort-directory-files)
2342 (test-directory-files)
2344 (define (test-file-exists?)
2345 (try 'file-exists? file-exists? ".")
2346 (try 'file-exists? file-exists? "error.scm")
2347 (try 'file-exists? file-exists? "newdir2")
2348 (try 'file-exists? file-exists? (path-exp "bbb" "newdir2"))
2349 (try 'file-exists? file-exists? "notexist")
2353 (define (test-file-type)
2354 (try 'file-type file-type ".")
2355 (try 'file-type file-type "error.scm")
2356 (try 'file-type file-type "newdir2")
2357 (try 'file-type file-type (path-exp "bbb" "newdir2"))
2358 (try 'file-type file-type "notexist")
2362 (define (test-file-size)
2363 (try 'file-size file-size "error.scm")
2364 (try 'file-size file-size (path-exp "bbb" "newdir2"))
2365 (try 'file-size file-size "notexist")
2369 (define (test-delete-file-and-directory)
2370 (try 'delete-directory delete-directory "newdir2")
2371 (try 'delete-file delete-file (path-exp "aaa" "newdir2"))
2372 (try 'delete-file delete-file (path-exp "bbb" "newdir2"))
2373 (try 'delete-file delete-file (path-exp "ccc" "newdir2"))
2374 (try 'delete-directory delete-directory "newdir2")
2376 (test-delete-file-and-directory)
2378 (define (test-open-process)
2379 (define (read-all-open-process)
2381 (open-process (list path: "sort"
2382 arguments: (list "input")
2383 eol-encoding: 'cr-lf))))
2384 (output-port-timeout-set! p 10)
2385 (input-port-timeout-set! p 10)
2386 (let ((x (read-all p)))
2389 (try 'open-process open-process
2391 arguments: (list "input")
2392 eol-encoding: 'cr-lf))
2393 (try 'read-all-open-process read-all-open-process)
2397 (define (test-host-info)
2398 (define (host-info-addresses-host-info hostname)
2399 (host-info-addresses (host-info hostname)))
2400 (try 'host-info host-info "notexist.iro.umontreal.ca")
2401 (try 'host-info-addresses-host-info
2402 host-info-addresses-host-info
2403 "www.iro.umontreal.ca")
2407 (define (test-open-tcp-client)
2408 (define (string?-read-line-open-tcp-client)
2411 (list server-address: "www.iro.umontreal.ca"
2413 eol-encoding: 'cr-lf))))
2414 (output-port-timeout-set! p 10)
2415 (input-port-timeout-set! p 10)
2416 (display "GET /gambit-check\n\n" p)
2418 (let ((x (read-line p)))
2422 (try 'open-tcp-client open-tcp-client
2423 (list server-address: "www.iro.umontreal.ca"
2425 eol-encoding: 'cr-lf))
2427 (try 'string?-read-line-open-tcp-client string?-read-line-open-tcp-client)
2429 (test-open-tcp-client)
2431 ;------------------------------------------------------------------------------