tests/error.scm

   1 ; File: "error.scm", Time-stamp: <2008-04-01 12:44:06 feeley>
   2
   3 ; Copyright (c) 1998-2007 by Marc Feeley, All Rights Reserved.
   4
   5 ; Test program for error processing.
   6
   7 ; run like this:  gsi/gsi -f error.scm < error.scm
   8
   9 1 2 3
  10
  11 (define scheme-system
  12   (let ((str1 (symbol->string (car '(aB\c;
  13                                      ))))
  14         (str2 "\0411\x23"))
  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))
  20                     'scm)
  21                    ((char=? c0 (integer->char 9))
  22                     'stk)
  23                    ((char=? c0 #\!)
  24                     (cond ((char=? (string-ref str2 2) #\#)
  25                            'gambit) ; Gambit in case-insensitive mode
  26                           (else
  27                            'mit)))
  28                    (else
  29                     'unknown))))
  30           ((equal? str1 "ABc")
  31            'scheme-to-c)
  32           ((equal? str1 "abc")
  33            'chez)
  34           ((equal? str1 "aBc")
  35            'elk)
  36           ((equal? str1 "AB\\C")
  37            'bigloo)
  38           (else
  39            'unknown))))
  40
  41 (define return #f)
  42 (define call-args #f)
  43 (define call-expr #f)
  44
  45 (define continuation->return-address #f)
  46 (define catch-all #f)
  47
  48 (define chez-continuation->return-address
  49   (lambda (cont)
  50     #f))
  51
  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")
  57                                (list (apply format
  58                                             (cons err-format err-args))
  59                                      fn-name
  60                                      call-args)))))
  61       (thunk))))
  62
  63 (define mit-continuation->return-address
  64   (lambda (cont)
  65     #f))
  66
  67 (define mit-catch-all
  68   (lambda (catcher thunk)
  69     (call-with-current-continuation
  70      (lambda (return)
  71        (bind-condition-handler
  72         '()
  73         (lambda (condition)
  74           (catcher (string->symbol "##signal.runtime-error")
  75                    (list (condition/report-string condition)
  76                          (car call-expr)
  77                          call-args))
  78           (return #f))
  79         thunk)))))
  80
  81 (define scm-continuation->return-address
  82   (lambda (cont)
  83     #f))
  84
  85 (define scm-catch-all
  86   (lambda (catcher thunk)
  87     (call-with-current-continuation
  88      (lambda (return)
  89        (let ((error? #t))
  90          (dynamic-wind
  91           (lambda () #f)
  92           (lambda ()
  93             (let ((result (thunk)))
  94               (set! error? #f)
  95               result))
  96           (lambda ()
  97             (if error?
  98               (begin
  99                 (catcher (string->symbol "##signal.runtime-error")
 100                          (list "ERROR"
 101                                (car call-expr)
 102                                call-args))
 103                 (return #f))))))))))
 104
 105 (case scheme-system
 106   ((gambit)
 107    (set! continuation->return-address
 108      (eval `(lambda (cont)
 109               (,(string->symbol "##continuation-ret")
 110                (,(string->symbol "##procedure->continuation") cont)))))
 111    (set! catch-all
 112      (lambda (catcher thunk)
 113        (with-exception-handler
 114         (lambda (exc)
 115
 116           (define (call oper args)
 117             (catcher
 118              (string->symbol "##signal.runtime-error")
 119              (list (with-input-from-string
 120                      (with-output-to-string
 121                        '()
 122                        (lambda ()
 123                          (if (os-exception? exc)
 124                              (write exc)
 125                              (##display-exception exc (current-output-port)))))
 126                      read-line)
 127                    (##procedure-friendly-name oper)
 128                    args)))
 129
 130           (cond ((abandoned-mutex-exception? exc)
 131                  (call "???" '()))
 132                 ((sfun-conversion-exception? exc)
 133                  (call
 134                   (sfun-conversion-exception-procedure exc)
 135                   (sfun-conversion-exception-arguments exc)))
 136                 ((cfun-conversion-exception? exc)
 137                  (call
 138                   (cfun-conversion-exception-procedure exc)
 139                   (cfun-conversion-exception-arguments exc)))
 140                 ((datum-parsing-exception? exc)
 141                  (call "???" '()))
 142                 ((deadlock-exception? exc)
 143                  (call "???" '()))
 144                 ((divide-by-zero-exception? exc)
 145                  (call
 146                   (divide-by-zero-exception-procedure exc)
 147                   (divide-by-zero-exception-arguments exc)))
 148                 ((error-exception? exc)
 149                  (call "???" '()))
 150                 ((expression-parsing-exception? exc)
 151                  (call "???" '()))
 152                 ((heap-overflow-exception? exc)
 153                  (call "???" '()))
 154                 ((improper-length-list-exception? exc)
 155                  (call
 156                   (improper-length-list-exception-procedure exc)
 157                   (improper-length-list-exception-arguments exc)))
 158                 ((join-timeout-exception? exc)
 159                  (call
 160                   (join-timeout-exception-procedure exc)
 161                   (join-timeout-exception-arguments exc)))
 162                 ((keyword-expected-exception? exc)
 163                  (call
 164                   (keyword-expected-exception-procedure exc)
 165                   (keyword-expected-exception-arguments exc)))
 166                 ((multiple-c-return-exception? exc)
 167                  (call "???" '()))
 168                 ((noncontinuable-exception? exc)
 169                  (call "???" '()))
 170                 ((nonprocedure-operator-exception? exc)
 171                  (call
 172                   (quot (nonprocedure-operator-exception-operator exc))
 173                   (nonprocedure-operator-exception-arguments exc)))
 174                 ((number-of-arguments-limit-exception? exc)
 175                  (call
 176                   (number-of-arguments-limit-exception-procedure exc)
 177                   (number-of-arguments-limit-exception-arguments exc)))
 178                 ((os-exception? exc)
 179                  (call
 180                   (os-exception-procedure exc)
 181                   (os-exception-arguments exc)))
 182                 ((range-exception? exc)
 183                  (call
 184                   (range-exception-procedure exc)
 185                   (range-exception-arguments exc)))
 186                 ((scheduler-exception? exc)
 187                  (call "???" '()))
 188                 ((stack-overflow-exception? exc)
 189                  (call "???" '()))
 190                 ((started-thread-exception? exc)
 191                  (call
 192                   (started-thread-exception-procedure exc)
 193                   (started-thread-exception-arguments exc)))
 194                 ((terminated-thread-exception? exc)
 195                  (call
 196                   (terminated-thread-exception-procedure exc)
 197                   (terminated-thread-exception-arguments exc)))
 198                 ((type-exception? exc)
 199                  (call
 200                   (type-exception-procedure exc)
 201                   (type-exception-arguments exc)))
 202                 ((unbound-os-environment-variable-exception? exc)
 203                  (call
 204                   (unbound-os-environment-variable-exception-procedure exc)
 205                   (unbound-os-environment-variable-exception-arguments exc)))
 206                 ((unbound-global-exception? exc)
 207                  (call "???" '()))
 208                 ((uncaught-exception? exc)
 209                  (call
 210                   (uncaught-exception-procedure exc)
 211                   (uncaught-exception-arguments exc)))
 212                 ((unknown-keyword-argument-exception? exc)
 213                  (call
 214                   (unknown-keyword-argument-exception-procedure exc)
 215                   (unknown-keyword-argument-exception-arguments exc)))
 216                 ((wrong-number-of-arguments-exception? exc)
 217                  (call
 218                   (wrong-number-of-arguments-exception-procedure exc)
 219                   (wrong-number-of-arguments-exception-arguments exc)))
 220                 ((no-such-file-or-directory-exception? exc)
 221                  (call
 222                   (no-such-file-or-directory-exception-procedure exc)
 223                   (no-such-file-or-directory-exception-arguments exc)))
 224                 (else
 225                  (call "???" '()))))
 226         thunk))))
 227   ((chez)
 228    (set! continuation->return-address chez-continuation->return-address)
 229    (set! catch-all chez-catch-all)
 230    (print-vector-length #f))
 231   ((mit)
 232    (set! continuation->return-address mit-continuation->return-address)
 233    (set! catch-all mit-catch-all))
 234   ((scm)
 235    (set! continuation->return-address scm-continuation->return-address)
 236    (set! catch-all scm-catch-all)))
 237
 238 (define copy-obj
 239   (lambda (obj)
 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))))
 243           (else          obj))))
 244
 245 (define apply-fn
 246   (lambda (fn args)
 247     (let ((result ; make sure continuation is unique (even in interpreter)
 248            (cond (fn => (lambda (f) (apply f args))))))
 249       result)))
 250
 251 (define return-address-of-apply-fn
 252   (apply-fn
 253    (lambda ()
 254      (call-with-current-continuation
 255       (lambda (cont)
 256         (continuation->return-address cont))))
 257    '()))
 258
 259 (define error-catcher
 260   (lambda (s args)
 261     (call-with-current-continuation
 262      (lambda (cont)
 263        (if (not (eq? s (string->symbol "##signal.runtime-error")))
 264          (begin
 265            (display ";;; SIGNAL ")
 266            (write s)
 267            (display " IS WRONG: ")
 268            (write call-expr)
 269            (newline))
 270          (let ((call-expr2
 271                 (cons (cadr args)
 272                       (map quot (caddr args)))))
 273            (if (not (equal? call-expr call-expr2))
 274              (begin
 275                (display ";;; CALL EXPRESSION ")
 276                (write call-expr2)
 277                (display " IS WRONG: ")
 278                (write call-expr)
 279                (newline))
 280              (let ((retadr (continuation->return-address cont)))
 281                (if (not (eq? retadr return-address-of-apply-fn))
 282                  (begin
 283                    (display ";;; CONTINUATION ")
 284                    (display retadr)
 285                    (display " IS WRONG: ")
 286                    (write call-expr)
 287                    (newline))
 288                  (begin
 289                    (display ";;; ")
 290                    (display (car args))
 291                    (display ": ")
 292                    (write call-expr)
 293                    (newline)))))))
 294        (return #t)))))
 295
 296 (define quot
 297   (lambda (x)
 298     (if (or (number? x) (string? x) (char? x) (boolean? x))
 299       x
 300       (list 'quote x))))
 301
 302 (define generic-try
 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
 307      (lambda (cont)
 308        (set! return cont)
 309        (proc
 310         (catch-all
 311          error-catcher
 312          (lambda ()
 313            (apply-fn fn args))))))))
 314
 315 (define try
 316   (lambda (fn-name fn . args)
 317     (generic-try fn-name
 318                  fn
 319                  args
 320                  (lambda (result)
 321                    (write call-expr)
 322                    (display " => ")
 323                    (write (normalize-numbers result))
 324                    (newline)))))
 325
 326 (define try*
 327   (lambda (obj fn-name fn . args)
 328     (generic-try fn-name
 329                  fn
 330                  args
 331                  (lambda (result)
 332                    (write call-expr)
 333                    (display " => ")
 334                    (write (normalize-numbers obj))
 335                    (newline)))))
 336
 337 (define normalize-numbers
 338   (lambda (x)
 339     (if (and (number? x) (inexact? x))
 340       (if (real? 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))))
 345       x)))
 346
 347 (define (sort-list lst <?)
 348
 349   (define (mergesort lst)
 350
 351     (define (merge lst1 lst2)
 352       (cond ((null? lst1) lst2)
 353             ((null? lst2) lst1)
 354             (else
 355              (let ((e1 (car lst1)) (e2 (car lst2)))
 356                (if (<? e1 e2)
 357                  (cons e1 (merge (cdr lst1) lst2))
 358                  (cons e2 (merge lst1 (cdr lst2))))))))
 359
 360     (define (split lst)
 361       (if (or (null? lst) (null? (cdr lst)))
 362         lst
 363         (cons (car lst) (split (cddr lst)))))
 364
 365     (if (or (null? lst) (null? (cdr lst)))
 366       lst
 367       (let* ((lst1 (mergesort (split lst)))
 368              (lst2 (mergesort (split (cdr lst)))))
 369         (merge lst1 lst2))))
 370
 371   (mergesort lst))
 372
 373 ;------------------------------------------------------------------------------
 374
 375 (define (test-not) ; no error possible
 376 (try 'not not #f)
 377 (try 'not not #t)
 378 (try 'not not '())
 379 (try 'not not "foo")
 380 )
 381 (test-not)
 382
 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")
 388 )
 389 (test-boolean?)
 390
 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))
 397 )
 398 (test-eqv?)
 399
 400 (define (test-eq?) ; no error possible
 401 (try 'eq? eq? #f "foo")
 402 (try 'eq? eq? #f #f)
 403 (try 'eq? eq? 'foo 'foo)
 404 (try 'eq? eq? 12345678901234567890 12345678901234567890)
 405 (try 'eq? eq? '(1 2) '(1 2))
 406 )
 407 (test-eq?)
 408
 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))
 415 )
 416 (test-equal?)
 417
 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)
 423 )
 424 (test-pair?)
 425
 426 (define (test-cons) ; no error possible
 427 (try 'cons cons 1 "foo")
 428 )
 429 (test-cons)
 430
 431 (define (test-car)
 432 (try 'car car '(a . b))
 433 (try 'car car 'a)
 434 (try 'car car "foo")
 435 (try 'car car '#(a b))
 436 )
 437 (test-car)
 438
 439 (define (test-cdr)
 440 (try 'cdr cdr '(a . b))
 441 (try 'cdr cdr 'a)
 442 (try 'cdr cdr "foo")
 443 (try 'cdr cdr '#(a b))
 444 )
 445 (test-cdr)
 446
 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)
 452 )
 453 (test-set-car!)
 454
 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)
 460 )
 461 (test-set-cdr!)
 462
 463 (define (test-caar)
 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))
 468 (try 'caar caar 'a)
 469 )
 470 (test-caar)
 471
 472 (define (test-cadr)
 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))
 477 (try 'cadr cadr 'a)
 478 )
 479 (test-cadr)
 480
 481 (define (test-cdar)
 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))
 486 (try 'cdar cdar 'a)
 487 )
 488 (test-cdar)
 489
 490 (define (test-cddr)
 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))
 495 (try 'cddr cddr 'a)
 496 )
 497 (test-cddr)
 498
 499 (define (test-caaar)
 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)
 505 )
 506 (test-caaar)
 507
 508 (define (test-caadr)
 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)
 514 )
 515 (test-caadr)
 516
 517 (define (test-cddar)
 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)
 523 )
 524 (test-cddar)
 525
 526 (define (test-cdddr)
 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)
 532 )
 533 (test-cdddr)
 534
 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)
 541 )
 542 (test-caaaar)
 543
 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)
 550 )
 551 (test-caaadr)
 552
 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)
 559 )
 560 (test-caddar)
 561
 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)
 568 )
 569 (test-cadddr)
 570
 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)
 577 )
 578 (test-cdaaar)
 579
 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)
 586 )
 587 (test-cdaadr)
 588
 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)
 595 )
 596 (test-cdddar)
 597
 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)
 604 )
 605 (test-cddddr)
 606
 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)
 612 )
 613 (test-null?)
 614
 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)
 621 )
 622 (test-list?)
 623
 624 (define (test-list) ; no error possible
 625 (try 'list list)
 626 (try 'list list 1)
 627 (try 'list list 1 2)
 628 )
 629 (test-list)
 630
 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")
 636 )
 637 (test-length)
 638
 639 (define (test-append)
 640 (try 'append 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)
 653 )
 654 (test-append)
 655
 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")
 661 )
 662 (test-reverse)
 663
 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)
 669 )
 670 (test-list-tail)
 671
 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)
 677 )
 678 (test-list-ref)
 679
 680 (define (test-memq)
 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"))
 689 )
 690 (test-memq)
 691
 692 (define (test-memv)
 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"))
 701 )
 702 (test-memv)
 703
 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"))
 713 )
 714 (test-member)
 715
 716 (define (test-assq)
 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)))
 726 )
 727 (test-assq)
 728
 729 (define (test-assv)
 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)))
 739 )
 740 (test-assv)
 741
 742 (define (test-assoc)
 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)))
 752 )
 753 (test-assoc)
 754
 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")
 760 )
 761 (test-symbol?)
 762
 763 (define (test-symbol->string)
 764 (try 'symbol->string symbol->string 'foo)
 765 (try 'symbol->string symbol->string "foo")
 766 )
 767 (test-symbol->string)
 768
 769 (define (test-string->symbol)
 770 (try 'string->symbol string->symbol "foo")
 771 (try 'string->symbol string->symbol 'foo)
 772 )
 773 (test-string->symbol)
 774
 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)
 781 )
 782 (test-number?)
 783
 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)
 790 )
 791 (test-complex?)
 792
 793 (define (test-real?) ; no error possible
 794 (try 'real? real? 1)
 795 (try 'real? real? 1/2)
 796 (try 'real? real? 1.5)
 797 (try 'real? real? +i)
 798 (try 'real? real? #f)
 799 )
 800 (test-real?)
 801
 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)
 808 )
 809 (test-rational?)
 810
 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)
 817 )
 818 (test-integer?)
 819
 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)
 825 )
 826 (test-exact?)
 827
 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)
 833 )
 834 (test-inexact?)
 835
 836 (define (test-=)
 837 (try '= =)
 838 (try '= = 1)
 839 (try '= = 'a)
 840 (try '= = 1 1)
 841 (try '= = 1 2)
 842 (try '= = 2 1)
 843 (try '= = 1 +i)
 844 (try '= = 'a 2)
 845 (try '= = 1 'b)
 846 (try '= = 1 2 3)
 847 (try '= = 1 2 'c)
 848 (try '= = 2 2 2 2)
 849 (try '= = 1 2 3 4)
 850 (try '= = 4 3 2 1)
 851 (try '= = 1 2 4 4)
 852 (try '= = 4 4 2 1)
 853 )
 854 (test-=)
 855
 856 (define (test-<)
 857 (try '< <)
 858 (try '< < 1)
 859 (try '< < 'a)
 860 (try '< < 1 1)
 861 (try '< < 1 2)
 862 (try '< < 2 1)
 863 (try '< < 1 +i)
 864 (try '< < 'a 2)
 865 (try '< < 1 'b)
 866 (try '< < 1 2 3)
 867 (try '< < 1 2 'c)
 868 (try '< < 2 2 2 2)
 869 (try '< < 1 2 3 4)
 870 (try '< < 4 3 2 1)
 871 (try '< < 1 2 4 4)
 872 (try '< < 4 4 2 1)
 873 )
 874 (test-<)
 875
 876 (define (test->)
 877 (try '> >)
 878 (try '> > 1)
 879 (try '> > 'a)
 880 (try '> > 1 1)
 881 (try '> > 1 2)
 882 (try '> > 2 1)
 883 (try '> > 1 +i)
 884 (try '> > 'a 2)
 885 (try '> > 1 'b)
 886 (try '> > 1 2 3)
 887 (try '> > 1 2 'c)
 888 (try '> > 2 2 2 2)
 889 (try '> > 1 2 3 4)
 890 (try '> > 4 3 2 1)
 891 (try '> > 1 2 4 4)
 892 (try '> > 4 4 2 1)
 893 )
 894 (test->)
 895
 896 (define (test-<=)
 897 (try '<= <=)
 898 (try '<= <= 1)
 899 (try '<= <= 'a)
 900 (try '<= <= 1 1)
 901 (try '<= <= 1 2)
 902 (try '<= <= 2 1)
 903 (try '<= <= 1 +i)
 904 (try '<= <= 'a 2)
 905 (try '<= <= 1 'b)
 906 (try '<= <= 1 2 3)
 907 (try '<= <= 1 2 'c)
 908 (try '<= <= 2 2 2 2)
 909 (try '<= <= 1 2 3 4)
 910 (try '<= <= 4 3 2 1)
 911 (try '<= <= 1 2 4 4)
 912 (try '<= <= 4 4 2 1)
 913 )
 914 (test-<=)
 915
 916 (define (test->=)
 917 (try '>= >=)
 918 (try '>= >= 1)
 919 (try '>= >= 'a)
 920 (try '>= >= 1 1)
 921 (try '>= >= 1 2)
 922 (try '>= >= 2 1)
 923 (try '>= >= 1 +i)
 924 (try '>= >= 'a 2)
 925 (try '>= >= 1 'b)
 926 (try '>= >= 1 2 3)
 927 (try '>= >= 1 2 'c)
 928 (try '>= >= 2 2 2 2)
 929 (try '>= >= 1 2 3 4)
 930 (try '>= >= 4 3 2 1)
 931 (try '>= >= 1 2 4 4)
 932 (try '>= >= 4 4 2 1)
 933 )
 934 (test->=)
 935
 936 (define (test-zero?)
 937 (try 'zero? zero? 1)
 938 (try 'zero? zero? 2.0)
 939 (try 'zero? zero? 3.4)
 940 (try 'zero? zero? +i)
 941 (try 'zero? zero? 'foo)
 942 )
 943 (test-zero?)
 944
 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)
 951 )
 952 (test-positive?)
 953
 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)
 960 )
 961 (test-negative?)
 962
 963 (define (test-odd?)
 964 (try 'odd? odd? 1)
 965 (try 'odd? odd? 2.0)
 966 (try 'odd? odd? 3.4)
 967 (try 'odd? odd? +i)
 968 (try 'odd? odd? 'foo)
 969 )
 970 (test-odd?)
 971
 972 (define (test-even?)
 973 (try 'even? even? 1)
 974 (try 'even? even? 2.0)
 975 (try 'even? even? 3.4)
 976 (try 'even? even? +i)
 977 (try 'even? even? 'foo)
 978 )
 979 (test-even?)
 980
 981 (define (test-max)
 982 (try 'max max 3)
 983 (try 'max max 'a)
 984 (try 'max max 3 4)
 985 (try 'max max 3 4.0)
 986 (try 'max max 'a 4.0)
 987 (try 'max max 3 'b)
 988 (try 'max max 1 2 3)
 989 (try 'max max 1 2 'c)
 990 (try 'max max 1+0.i 2+0.i)
 991 )
 992 (test-max)
 993
 994 (define (test-min)
 995 (try 'min min 3)
 996 (try 'min min 'a)
 997 (try 'min min 3 4)
 998 (try 'min min 3 4.0)
 999 (try 'min min 'a 4.0)
1000 (try 'min min 3 'b)
1001 (try 'min min 1 2 3)
1002 (try 'min min 1 2 'c)
1003 (try 'min min 1+0.i 2+0.i)
1004 )
1005 (test-min)
1006
1007 (define (test-+)
1008 (try '+ +)
1009 (try '+ + 2)
1010 (try '+ + 'a)
1011 (try '+ + 2 3)
1012 (try '+ + 2 +i)
1013 (try '+ + 'a 2)
1014 (try '+ + 1 'b)
1015 (try '+ + 1 2 3)
1016 (try '+ + 1 2 'c)
1017 (try '+ + 2 2 2 2)
1018 (try '+ + 1 2 3 4)
1019 (try '+ + 4 3 2 1)
1020 (try '+ + 1 2 4 4)
1021 (try '+ + 4 4 2 1)
1022 )
1023 (test-+)
1024
1025 (define (test-*)
1026 (try '* *)
1027 (try '* * 2)
1028 (try '* * 'a)
1029 (try '* * 2 3)
1030 (try '* * 2 +i)
1031 (try '* * 'a 2)
1032 (try '* * 1 'b)
1033 (try '* * 1 2 3)
1034 (try '* * 1 2 'c)
1035 (try '* * 2 2 2 2)
1036 (try '* * 1 2 3 4)
1037 (try '* * 4 3 2 1)
1038 (try '* * 1 2 4 4)
1039 (try '* * 4 4 2 1)
1040 )
1041 (test-*)
1042
1043 (define (test--)
1044 (try '- - 2)
1045 (try '- - 'a)
1046 (try '- - 2 3)
1047 (try '- - 2 +i)
1048 (try '- - 'a 2)
1049 (try '- - 1 'b)
1050 (try '- - 1 2 3)
1051 (try '- - 1 2 'c)
1052 (try '- - 2 2 2 2)
1053 (try '- - 1 2 3 4)
1054 (try '- - 4 3 2 1)
1055 (try '- - 1 2 4 4)
1056 (try '- - 4 4 2 1)
1057 )
1058 (test--)
1059
1060 (define (test-/)
1061 (try '/ / 2)
1062 (try '/ / 0)
1063 (try '/ / 'a)
1064 (try '/ / 2 3)
1065 (try '/ / 2 +i)
1066 (try '/ / 2 0)
1067 (try '/ / 'a 2)
1068 (try '/ / 1 'b)
1069 (try '/ / 1 2 3)
1070 (try '/ / 1 2 0)
1071 (try '/ / 1 2 'c)
1072 (try '/ / 2 2 2 2)
1073 (try '/ / 1 2 3 4)
1074 (try '/ / 4 3 2 1)
1075 (try '/ / 1 2 4 4)
1076 (try '/ / 4 4 2 1)
1077 )
1078 (test-/)
1079
1080 (define (test-abs)
1081 (try 'abs abs -7)
1082 (try 'abs abs +i)
1083 (try 'abs abs 'a)
1084 )
1085 (test-abs)
1086
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)
1096 )
1097 (test-quotient)
1098
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)
1108 )
1109 (test-remainder)
1110
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)
1120 )
1121 (test-modulo)
1122
1123 (define (test-gcd)
1124 (try 'gcd gcd)
1125 (try 'gcd gcd 10)
1126 (try 'gcd gcd 3/2)
1127 (try 'gcd gcd 'a)
1128 (try 'gcd gcd 9 4)
1129 (try 'gcd gcd 9. -4.)
1130 (try 'gcd gcd 9. 3/2)
1131 (try 'gcd gcd 'a 4)
1132 (try 'gcd gcd 9 'b)
1133 (try 'gcd gcd 12 8 10)
1134 (try 'gcd gcd 12 8 'c)
1135 )
1136 (test-gcd)
1137
1138 (define (test-lcm)
1139 (try 'lcm lcm)
1140 (try 'lcm lcm 10)
1141 (try 'lcm lcm 3/2)
1142 (try 'lcm lcm 'a)
1143 (try 'lcm lcm 9 4)
1144 (try 'lcm lcm 9. -4.)
1145 (try 'lcm lcm 9. 3/2)
1146 (try 'lcm lcm 'a 4)
1147 (try 'lcm lcm 9 'b)
1148 (try 'lcm lcm 12 8 10)
1149 (try 'lcm lcm 12 8 'c)
1150 )
1151 (test-lcm)
1152
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)
1158 )
1159 (test-numerator)
1160
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)
1166 )
1167 (test-denominator)
1168
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)
1174 )
1175 (test-floor)
1176
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)
1182 )
1183 (test-ceiling)
1184
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)
1190 )
1191 (test-truncate)
1192
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)
1198 )
1199 (test-round)
1200
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)
1209 )
1210 (test-rationalize)
1211
1212 (define (test-exp)
1213 (try 'exp exp 1/2)
1214 (try 'exp exp -1.5)
1215 (try 'exp exp +i)
1216 (try 'exp exp 'a)
1217 )
1218 (test-exp)
1219
1220 (define (test-log)
1221 (try 'log log 1/2)
1222 (try 'log log -1.5)
1223 (try 'log log +i)
1224 (try 'log log 'a)
1225 )
1226 (test-log)
1227
1228 (define (test-sin)
1229 (try 'sin sin 1/2)
1230 (try 'sin sin -1.5)
1231 (try 'sin sin +i)
1232 (try 'sin sin 'a)
1233 )
1234 (test-sin)
1235
1236 (define (test-cos)
1237 (try 'cos cos 1/2)
1238 (try 'cos cos -1.5)
1239 (try 'cos cos +i)
1240 (try 'cos cos 'a)
1241 )
1242 (test-cos)
1243
1244 (define (test-tan)
1245 (try 'tan tan 1/2)
1246 (try 'tan tan -1.5)
1247 (try 'tan tan +i)
1248 (try 'tan tan 'a)
1249 )
1250 (test-tan)
1251
1252 (define (test-asin)
1253 (try 'asin asin 1/2)
1254 (try 'asin asin -1.5)
1255 (try 'asin asin +i)
1256 (try 'asin asin 'a)
1257 )
1258 (test-asin)
1259
1260 (define (test-acos)
1261 (try 'acos acos 1/2)
1262 (try 'acos acos -1.5)
1263 (try 'acos acos +i)
1264 (try 'acos acos 'a)
1265 )
1266 (test-acos)
1267
1268 (define (test-atan)
1269 (try 'atan atan 1/2)
1270 (try 'atan atan -1.5)
1271 (try 'atan atan +i)
1272 (try 'atan atan 'a)
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)
1278 )
1279 (test-atan)
1280
1281 (define (test-sqrt)
1282 (try 'sqrt sqrt 1/4)
1283 (try 'sqrt sqrt -1.5)
1284 (try 'sqrt sqrt +i)
1285 (try 'sqrt sqrt 'a)
1286 )
1287 (test-sqrt)
1288
1289 (define (test-expt)
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)
1295 )
1296 (test-expt)
1297
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)
1304 )
1305 (test-make-rectangular)
1306
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)
1313 )
1314 (test-make-polar)
1315
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)
1321 )
1322 (test-real-part)
1323
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)
1329 )
1330 (test-imag-part)
1331
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)
1337 )
1338 (test-magnitude)
1339
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)
1345 )
1346 (test-angle)
1347
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)
1353 )
1354 (test-exact->inexact)
1355
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)
1361 )
1362 (test-inexact->exact)
1363
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)
1374 )
1375 (test-number->string)
1376
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)
1388 )
1389 (test-string->number)
1390
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")
1396 )
1397 (test-char?)
1398
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)
1414 )
1415 (test-char=?)
1416
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)
1432 )
1433 (test-char<?)
1434
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)
1450 )
1451 (test-char>?)
1452
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)
1468 )
1469 (test-char<=?)
1470
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)
1486 )
1487 (test-char>=?)
1488
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)
1504 )
1505 (test-char-ci=?)
1506
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)
1522 )
1523 (test-char-ci<?)
1524
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)
1540 )
1541 (test-char-ci>?)
1542
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)
1558 )
1559 (test-char-ci<=?)
1560
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)
1576 )
1577 (test-char-ci>=?)
1578
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)
1585 )
1586 (test-char-alphabetic?)
1587
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)
1594 )
1595 (test-char-numeric?)
1596
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)
1603 )
1604 (test-char-whitespace?)
1605
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)
1612 )
1613 (test-char-upper-case?)
1614
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)
1621 )
1622 (test-char-lower-case?)
1623
1624 (define (test-char->integer)
1625 (try 'char->integer char->integer #\A)
1626 (try 'char->integer char->integer 123)
1627 )
1628 (test-char->integer)
1629
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)
1637 )
1638 (test-integer->char)
1639
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")
1647 )
1648 (test-char-upcase)
1649
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")
1657 )
1658 (test-char-downcase)
1659
1660 (define (test-string?) ; no error possible
1661 (string? "5678")
1662 (string? 12345678901234567890)
1663 )
1664 (test-string?)
1665
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)
1675 )
1676 (test-make-string)
1677
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)
1683 )
1684 (test-string)
1685
1686 (define (test-string-length)
1687 (try 'string-length string-length "5678")
1688 (try 'string-length string-length 12345678901234567890)
1689 )
1690 (test-string-length)
1691
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)
1698 )
1699 (test-string-ref)
1700
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)
1708 )
1709 (test-string-set!)
1710
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)
1729 )
1730 (test-string=?)
1731
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)
1750 )
1751 (test-string<?)
1752
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)
1771 )
1772 (test-string>?)
1773
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)
1792 )
1793 (test-string<=?)
1794
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)
1813 )
1814 (test-string>=?)
1815
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)
1834 )
1835 (test-string-ci=?)
1836
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)
1855 )
1856 (test-string-ci<?)
1857
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)
1876 )
1877 (test-string-ci>?)
1878
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)
1897 )
1898 (test-string-ci<=?)
1899
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)
1918 )
1919 (test-string-ci>=?)
1920
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)
1934 )
1935 (test-substring)
1936
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)
1946 )
1947 (test-string-append)
1948
1949 (define (test-string->list)
1950 (try 'string->list string->list "56")
1951 (try 'string->list string->list 12345678901234567890)
1952 )
1953 (test-string->list)
1954
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)
1959 )
1960 (test-list->string)
1961
1962 (define (test-string-copy)
1963 (try 'string-copy string-copy "ab")
1964 (try 'string-copy string-copy 12345678901234567890)
1965 )
1966 (test-string-copy)
1967
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)
1972 )
1973 (test-string-fill!)
1974
1975 (define (test-vector?) ; no error possible
1976 (vector? '#(5 6 7 8))
1977 (vector? 12345678901234567890)
1978 )
1979 (test-vector?)
1980
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)
1989 )
1990 (test-make-vector)
1991
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)
1997 )
1998 (test-vector)
1999
2000 (define (test-vector-length)
2001 (try 'vector-length vector-length '#(5 6 7 8))
2002 (try 'vector-length vector-length 12345678901234567890)
2003 )
2004 (test-vector-length)
2005
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)
2012 )
2013 (test-vector-ref)
2014
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)
2022 )
2023 (test-vector-set!)
2024
2025 (define (test-vector->list)
2026 (try 'vector->list vector->list '#(5 6))
2027 (try 'vector->list vector->list 12345678901234567890)
2028 )
2029 (test-vector->list)
2030
2031 (define (test-list->vector)
2032 (try 'list->vector list->vector '(5 b))
2033 (try 'list->vector list->vector 12345678901234567890)
2034 )
2035 (test-list->vector)
2036
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)
2040 )
2041 (test-vector-fill!)
2042
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)
2048 )
2049 (test-procedure?)
2050
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))
2059 )
2060 (test-apply)
2061
2062 (define (test-map)
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))
2085 )
2086 (test-map)
2087
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))
2112 )
2113 (test-for-each)
2114
2115 (define (test-force) ; no error possible
2116 ;(let ((x (delay (+ 2 3)))) (try 'force force x))
2117 (try 'force force 123)
2118 )
2119 (test-force)
2120
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)
2124 )
2125 (test-call-with-current-continuation)
2126
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)
2131 )
2132 (test-call-with-input-file)
2133
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)
2137 )
2138 (test-call-with-output-file)
2139
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)
2144 )
2145 (test-input-port?)
2146
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)
2151 )
2152 (test-output-port?)
2153
2154 (define (test-current-input-port) ; no error possible
2155 (try 'current-input-port current-input-port)
2156 )
2157 (test-current-input-port)
2158
2159 (define (test-current-output-port) ; no error possible
2160 (try 'current-output-port current-output-port)
2161 )
2162 (test-current-output-port)
2163
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)
2168 )
2169 (test-with-input-from-file)
2170
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)
2174 )
2175 (test-with-output-to-file)
2176
2177 (define (test-open-input-file)
2178 (try 'open-input-file open-input-file #f)
2179 (try 'open-input-file open-input-file "noexist")
2180 )
2181 (test-open-input-file)
2182
2183 (define (test-open-output-file)
2184 (try 'open-output-file open-output-file #f)
2185 )
2186 (test-open-output-file)
2187
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)
2191 )
2192 (test-close-input-port)
2193
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)
2197 )
2198 (test-close-output-port)
2199
2200 (define (test-read)
2201 (try 'read read)
2202 (try 'read read (current-output-port))
2203 (try 'read read #f)
2204 )
2205 (test-read)
2206
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)
2211 )
2212 (test-read-char)
2213
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)
2218 )
2219 (test-peek-char)
2220
2221 (define (test-eof-object?) ; no error possible
2222 (try 'eof-object? eof-object? #f)
2223 (try 'eof-object? eof-object? "abc")
2224 )
2225 (test-eof-object?)
2226
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)
2232 )
2233 (test-char-ready?)
2234
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)
2240 )
2241 (test-write)
2242
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)
2248 )
2249 (test-display)
2250
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)
2256 )
2257 (test-newline)
2258
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)
2266 )
2267 (test-write-char)
2268
2269 (define (test-load)
2270 (try 'load load "noexist")
2271 (try 'load load #f)
2272 )
2273 (test-load)
2274
2275 (define (test-transcript-on)
2276 (try 'transcript-on transcript-on #f)
2277 )
2278 (test-transcript-on)
2279
2280 (define (test-transcript-off)
2281 (try 'transcript-off transcript-off)
2282 )
2283 (test-transcript-off)
2284
2285 ;------------------------------------------------------------------------------
2286
2287 (define (path-exp file dir)
2288   (string-append dir "/" file))
2289
2290 (define (test-setenv)
2291 (try 'setenv setenv "UNKNOWNVAR1")
2292 (try 'setenv setenv "UNKNOWNVAR2" "NOW-DEFINED")
2293 )
2294 (test-setenv)
2295
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)
2301 )
2302 (test-getenv)
2303
2304 (define (test-command-line)
2305 (define (cdr-command-line) (cdr (command-line)))
2306 (try 'cdr-command-line cdr-command-line)
2307 )
2308 (test-command-line)
2309
2310 (define (test-shell-command)
2311 (try 'shell-command shell-command "echo hello > newfile1")
2312 ;(try 'shell-command shell-command "notexist")
2313 )
2314 (test-shell-command)
2315
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")
2320 )
2321 (test-create-directory)
2322
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"))
2328 )
2329 (test-rename-file)
2330
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"))
2334 )
2335 (test-copy-file)
2336
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)
2341 )
2342 (test-directory-files)
2343
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")
2350 )
2351 (test-file-exists?)
2352
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")
2359 )
2360 (test-file-type)
2361
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")
2366 )
2367 (test-file-size)
2368
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")
2375 )
2376 (test-delete-file-and-directory)
2377
2378 (define (test-open-process)
2379 (define (read-all-open-process)
2380   (let ((p
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)))
2387       (close-port p)
2388       x)))
2389 (try 'open-process open-process
2390      (list path: "sort"
2391            arguments: (list "input")
2392            eol-encoding: 'cr-lf))
2393 (try 'read-all-open-process read-all-open-process)
2394 )
2395 (test-open-process)
2396
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")
2404 )
2405 '(test-host-info)
2406
2407 (define (test-open-tcp-client)
2408 (define (string?-read-line-open-tcp-client)
2409   (let ((p
2410          (open-tcp-client
2411           (list server-address: "www.iro.umontreal.ca"
2412                 port-number: 80
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)
2417     (force-output p)
2418     (let ((x (read-line p)))
2419       (close-port p)
2420       (string? x))))
2421 '
2422 (try 'open-tcp-client open-tcp-client
2423      (list server-address: "www.iro.umontreal.ca"
2424            port-number: 80
2425            eol-encoding: 'cr-lf))
2426 '
2427 (try 'string?-read-line-open-tcp-client string?-read-line-open-tcp-client)
2428 )
2429 (test-open-tcp-client)
2430
2431 ;------------------------------------------------------------------------------
2432
2433 (exit)