Changeset 14229 in project


Ignore:
Timestamp:
04/10/09 17:37:09 (11 years ago)
Author:
Kon Lovett
Message:

Added test. Msg is like core.

Location:
release/4/check-errors
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • release/4/check-errors/tags/1.0.0/conditions.scm

    r14214 r14229  
    3636;;   (<symbol> [<symbol> <object>]...)
    3737
    38 (define (make-exn-condition+ loc msg args . conds)
     38(define (make-exn-condition+ loc msg args . cnds)
    3939  (apply make-composite-condition
    4040         (make-exn-condition loc msg args)
     
    4343                      ((symbol? cnd)     (make-property-condition cnd) )
    4444                      ((pair? cnd)       (apply make-property-condition cnd) ) ) )
    45               conds)) )
     45              cnds)) )
    4646
    4747;;
  • release/4/check-errors/tags/1.0.0/tests/run.scm

    r14084 r14229  
     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(define testc (make-exn-condition+ 'test "test" '(test) 'test '(extra test 23)))
     28(define testc? (make-condition-predicate exn test extra))
     29(define testc-extra-test (condition-property-accessor 'extra 'test))
     30
     31(test 23 (testc-extra-test testc))
     32(test-assert (testc? testc))
     33
     34(check-fixnum 'test 1)
     35(check-positive-fixnum 'test 1)
     36(check-cardinal-fixnum 'test 0)
     37(check-flonum 'test 1.0)
     38(check-integer 'test 1.0)
     39(check-integer 'test 1)
     40(check-positive-integer 'test 1.0)
     41(check-positive-integer 'test 1)
     42(check-cardinal-integer 'test 0.0)
     43(check-cardinal-integer 'test 0)
     44(check-number 'test 1.0)
     45(check-number 'test 1)
     46(check-positive-number 'test 1.0)
     47(check-positive-number 'test 1)
     48(check-cardinal-number 'test 0.0)
     49(check-cardinal-number 'test 0)
     50(check-procedure 'test check-procedure)
     51#;(check-input-port 'test 'x)
     52#;(check-output-port 'test 'x)
     53(check-list 'test '(x))
     54(check-pair 'test '(x . y))
     55(check-blob 'test (string->blob "x"))
     56(check-vector 'test '#(x))
     57(check-structure 'test (##sys#make-structure 'x) 'x)
     58(check-symbol 'test 'x)
     59(check-keyword 'test #:x)
     60(check-string 'test "x")
     61(check-char 'test #\x)
     62(check-boolean 'test #t)
  • release/4/check-errors/tags/1.0.0/type-errors.scm

    r14167 r14229  
    5858                       (conc "bad"
    5959                             #\space (if argnam (conc #\` (->string argnam) #\') "")
    60                              #\space "argument type - expected"
     60                             #\space "argument type - not"
    6161                             #\space (if (vowel? (string-ref kndnam 0)) "an" "a")
    6262                             #\space kndnam)
  • release/4/check-errors/trunk/conditions.scm

    r14214 r14229  
    3636;;   (<symbol> [<symbol> <object>]...)
    3737
    38 (define (make-exn-condition+ loc msg args . conds)
     38(define (make-exn-condition+ loc msg args . cnds)
    3939  (apply make-composite-condition
    4040         (make-exn-condition loc msg args)
     
    4343                      ((symbol? cnd)     (make-property-condition cnd) )
    4444                      ((pair? cnd)       (apply make-property-condition cnd) ) ) )
    45               conds)) )
     45              cnds)) )
    4646
    4747;;
  • release/4/check-errors/trunk/tests/run.scm

    r14084 r14229  
     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(define testc (make-exn-condition+ 'test "test" '(test) 'test '(extra test 23)))
     28(define testc? (make-condition-predicate exn test extra))
     29(define testc-extra-test (condition-property-accessor 'extra 'test))
     30
     31(test 23 (testc-extra-test testc))
     32(test-assert (testc? testc))
     33
     34(check-fixnum 'test 1)
     35(check-positive-fixnum 'test 1)
     36(check-cardinal-fixnum 'test 0)
     37(check-flonum 'test 1.0)
     38(check-integer 'test 1.0)
     39(check-integer 'test 1)
     40(check-positive-integer 'test 1.0)
     41(check-positive-integer 'test 1)
     42(check-cardinal-integer 'test 0.0)
     43(check-cardinal-integer 'test 0)
     44(check-number 'test 1.0)
     45(check-number 'test 1)
     46(check-positive-number 'test 1.0)
     47(check-positive-number 'test 1)
     48(check-cardinal-number 'test 0.0)
     49(check-cardinal-number 'test 0)
     50(check-procedure 'test check-procedure)
     51#;(check-input-port 'test 'x)
     52#;(check-output-port 'test 'x)
     53(check-list 'test '(x))
     54(check-pair 'test '(x . y))
     55(check-blob 'test (string->blob "x"))
     56(check-vector 'test '#(x))
     57(check-structure 'test (##sys#make-structure 'x) 'x)
     58(check-symbol 'test 'x)
     59(check-keyword 'test #:x)
     60(check-string 'test "x")
     61(check-char 'test #\x)
     62(check-boolean 'test #t)
  • release/4/check-errors/trunk/type-errors.scm

    r14167 r14229  
    5757                       loc
    5858                       (conc "bad"
    59                              #\space (if argnam (conc #\` (->string argnam) #\') "")
    60                              #\space "argument type - expected"
     59                             #\space (if argnam (conc #\` argnam #\') "")
     60                             #\space "argument type - not"
    6161                             #\space (if (vowel? (string-ref kndnam 0)) "an" "a")
    6262                             #\space kndnam)
Note: See TracChangeset for help on using the changeset viewer.