source: project/release/4/check-errors/trunk/tests/run.scm @ 14288

Last change on this file since 14288 was 14288, checked in by Kon Lovett, 11 years ago

Added routines.

File size: 2.3 KB
Line 
1(use test conditions type-checks)
2
3(test-error (check-fixnum 'test 1.0))
4(test-error (check-positive-fixnum 'test 0))
5(test-error (check-cardinal-fixnum 'test -1))
6(test-error (check-flonum 'test 1))
7(test-error (check-integer 'test 0.1))
8(test-error (check-positive-integer 'test 0.0))
9(test-error (check-cardinal-integer 'test -1.0))
10(test-error (check-number 'test 'x))
11(test-error (check-positive-number 'test -0.1))
12(test-error (check-cardinal-number 'test -0.1))
13(test-error (check-procedure 'test 'x))
14(test-error (check-input-port 'test 'x))
15(test-error (check-output-port 'test 'x))
16(test-error (check-list 'test 'x))
17(test-error (check-pair 'test 'x))
18(test-error (check-blob 'test 'x))
19(test-error (check-vector 'test 'x))
20(test-error (check-structure 'test 'x))
21(test-error (check-symbol 'test 1))
22(test-error (check-keyword 'test 'x))
23(test-error (check-string 'test 'x))
24(test-error (check-char 'test 'x))
25(test-error (check-boolean 'test 'x))
26
27(check-fixnum 'test 1)
28(check-positive-fixnum 'test 1)
29(check-cardinal-fixnum 'test 0)
30(check-flonum 'test 1.0)
31(check-integer 'test 1.0)
32(check-integer 'test 1)
33(check-positive-integer 'test 1.0)
34(check-positive-integer 'test 1)
35(check-cardinal-integer 'test 0.0)
36(check-cardinal-integer 'test 0)
37(check-number 'test 1.0)
38(check-number 'test 1)
39(check-positive-number 'test 1.0)
40(check-positive-number 'test 1)
41(check-cardinal-number 'test 0.0)
42(check-cardinal-number 'test 0)
43(check-procedure 'test check-procedure)
44(check-input-port 'test (current-input-port))
45(check-output-port 'test (current-output-port))
46(check-list 'test '(x))
47(check-pair 'test '(x . y))
48(check-blob 'test (string->blob "x"))
49(check-vector 'test '#(x))
50(check-structure 'test (##sys#make-structure 'x) 'x)
51(check-symbol 'test 'x)
52(check-keyword 'test #:x)
53(check-string 'test "x")
54(check-char 'test #\x)
55(check-boolean 'test #t)
56
57(define testc (make-exn-condition+ 'test "test" '(test) 'test '(extra test 23)))
58(define testc? (make-condition-predicate exn test extra))
59(test-assert (testc? testc))
60(test 23 ((condition-property-accessor 'extra 'test) testc))
61
62(define testc-extra-test (make-condition-property-accessor extra test))
63(define testc-extra-foo (make-condition-property-accessor extra foo 'foobar))
64(test 23 (testc-extra-test testc))
65(test 'foobar (testc-extra-foo testc))
Note: See TracBrowser for help on using the repository browser.