Changeset 37483 in project


Ignore:
Timestamp:
03/29/19 15:59:31 (21 months ago)
Author:
juergen
Message:

checks 1.3 with dependency on simple-exceptions

Location:
release/5/checks
Files:
4 edited
3 copied

Legend:

Unmodified
Added
Removed
  • release/5/checks/tags/1.3/checks.egg

    r37475 r37483  
    44 (license "BSD")
    55 (test-dependencies simple-tests)
     6 (dependencies simple-exceptions)
    67 (author "[[/users/juergen-lorenz|Juergen Lorenz]]")
    7  (version "1.2")
     8 (version "1.3")
    89 (components (extension checks)))
    910
  • release/5/checks/tags/1.3/checks.scm

    r37475 r37483  
    3838                <<% << >>% >> <<<% <<< >>>% >>>
    3939                 true? false? named-lambda)
    40   (import scheme (only (chicken base) assert print case-lambda error))
     40
     41  (import scheme (only (chicken base) assert print case-lambda error)
     42          (only simple-exceptions raise assert-exception
     43                argument-exception result-exception))
    4144
    4245;;; (assert* loc xpr . xprs)
     
    4649  (syntax-rules ()
    4750    ((_ loc xpr)
    48      (assert xpr loc "assertion violated" 'xpr))
     51     ;(assert xpr loc "assertion violated" 'xpr))
     52     (or xpr (raise (assert-exception loc 'xpr))))
    4953    ((_ loc xpr xpr1 ...)
    5054     (and (assert* loc xpr) (assert* loc xpr1 ...)))
     
    7175     (if (ok? arg)
    7276       arg
    73        (error loc "precondition violated" '(ok? arg))))
     77       (raise (argument-exception loc '(ok? arg)))))
     78       ;(error loc "precondition violated" '(ok? arg))))
    7479    ((_ loc arg ok? ok1? ...)
    7580     (if (ok? arg)
    7681       (<<< loc arg ok1? ...)
    77        (error loc "precondition violated" (ok? arg))))
     82       (raise (argument-exception loc '(ok? arg)))))
     83       ;(error loc "precondition violated" (ok? arg))))
    7884    ))
    7985
     
    99105     (if (ok? result)
    100106       result
    101        (error loc "postcondition violated" '(ok? result))))
     107       (raise (result-exception loc '(ok? result)))))
     108       ;(error loc "postcondition violated" '(ok? result))))
    102109    ((_ loc result ok? ok1? ...)
    103110     (if (ok? result)
    104111       (>>> loc result ok1? ...)
    105        (error loc "postcondition violated" '(ok? result))))
     112       (raise (result-exception loc '(ok? result)))))
     113       ;(error loc "postcondition violated" '(ok? result))))
    106114    ))
    107115
     
    123131      (((car tests) arg)
    124132       (loop (cdr tests)))
    125       (else (error loc
    126                    "precondition violated"
    127                    `(,(car tests) ,arg-name))))))
     133      (else (raise
     134              (argument-exception loc
     135                                  `(,(car tests) ,arg-name)))))))
     136      ;(else (raise
     137      ;      (error loc
     138      ;             "precondition violated"
     139      ;             `(,(car tests) ,arg-name))))))
    128140
    129141
     
    137149      (((car tests) result)
    138150       (loop (cdr tests)))
    139       (else (error loc
    140                    "postcondition violated"
    141                    `(,(car tests) ,result-name))))))
     151      (else (raise
     152              (result-exception loc
     153                                `(,(car tests) ,result-name)))))))
     154      ;(else (error loc
     155      ;             "postcondition violated"
     156      ;             `(,(car tests) ,result-name))))))
    142157
    143158
  • release/5/checks/tags/1.3/tests/run.scm

    r37191 r37483  
    1 (import checks simple-tests)
     1(import scheme (chicken base) checks simple-tests)
    22
    33(define x 5)
    44
    55(define-test (checks?)
     6
     7  (assert* 'x (integer? x))
     8  (assert* 'x (integer? x) (odd? x))
     9  (not
     10    (condition-case
     11      (assert* 'x (integer? x) (even? x))
     12      ((exn assert) #f)))
     13
    614  (= (>> x) 5)
    715  (= (<< x) 5)
     
    1624  (not (condition-case
    1725         (<<% 'x x integer? even?)
    18          ((exn) #f)))
     26         ((exn argument) #f)))
    1927  (not (condition-case
    2028         (<<<% 'loc 'x x integer? even?)
    21          ((exn) #f)))
     29         ((exn argument) #f)))
    2230  (not (condition-case
    2331         (>> x integer? even?)
    24          ((exn) #f)))
     32         ((exn result) #f)))
    2533  (not (<< ((lambda () #f)) boolean?))
    2634  (= ((named-lambda (! n)
  • release/5/checks/trunk/checks.egg

    r37475 r37483  
    44 (license "BSD")
    55 (test-dependencies simple-tests)
     6 (dependencies simple-exceptions)
    67 (author "[[/users/juergen-lorenz|Juergen Lorenz]]")
    7  (version "1.2")
     8 (version "1.3")
    89 (components (extension checks)))
    910
  • release/5/checks/trunk/checks.scm

    r37475 r37483  
    3838                <<% << >>% >> <<<% <<< >>>% >>>
    3939                 true? false? named-lambda)
    40   (import scheme (only (chicken base) assert print case-lambda error))
     40
     41  (import scheme (only (chicken base) assert print case-lambda error)
     42          (only simple-exceptions raise assert-exception
     43                argument-exception result-exception))
    4144
    4245;;; (assert* loc xpr . xprs)
     
    4649  (syntax-rules ()
    4750    ((_ loc xpr)
    48      (assert xpr loc "assertion violated" 'xpr))
     51     ;(assert xpr loc "assertion violated" 'xpr))
     52     (or xpr (raise (assert-exception loc 'xpr))))
    4953    ((_ loc xpr xpr1 ...)
    5054     (and (assert* loc xpr) (assert* loc xpr1 ...)))
     
    7175     (if (ok? arg)
    7276       arg
    73        (error loc "precondition violated" '(ok? arg))))
     77       (raise (argument-exception loc '(ok? arg)))))
     78       ;(error loc "precondition violated" '(ok? arg))))
    7479    ((_ loc arg ok? ok1? ...)
    7580     (if (ok? arg)
    7681       (<<< loc arg ok1? ...)
    77        (error loc "precondition violated" (ok? arg))))
     82       (raise (argument-exception loc '(ok? arg)))))
     83       ;(error loc "precondition violated" (ok? arg))))
    7884    ))
    7985
     
    99105     (if (ok? result)
    100106       result
    101        (error loc "postcondition violated" '(ok? result))))
     107       (raise (result-exception loc '(ok? result)))))
     108       ;(error loc "postcondition violated" '(ok? result))))
    102109    ((_ loc result ok? ok1? ...)
    103110     (if (ok? result)
    104111       (>>> loc result ok1? ...)
    105        (error loc "postcondition violated" '(ok? result))))
     112       (raise (result-exception loc '(ok? result)))))
     113       ;(error loc "postcondition violated" '(ok? result))))
    106114    ))
    107115
     
    123131      (((car tests) arg)
    124132       (loop (cdr tests)))
    125       (else (error loc
    126                    "precondition violated"
    127                    `(,(car tests) ,arg-name))))))
     133      (else (raise
     134              (argument-exception loc
     135                                  `(,(car tests) ,arg-name)))))))
     136      ;(else (raise
     137      ;      (error loc
     138      ;             "precondition violated"
     139      ;             `(,(car tests) ,arg-name))))))
    128140
    129141
     
    137149      (((car tests) result)
    138150       (loop (cdr tests)))
    139       (else (error loc
    140                    "postcondition violated"
    141                    `(,(car tests) ,result-name))))))
     151      (else (raise
     152              (result-exception loc
     153                                `(,(car tests) ,result-name)))))))
     154      ;(else (error loc
     155      ;             "postcondition violated"
     156      ;             `(,(car tests) ,result-name))))))
    142157
    143158
  • release/5/checks/trunk/tests/run.scm

    r37191 r37483  
    1 (import checks simple-tests)
     1(import scheme (chicken base) checks simple-tests)
    22
    33(define x 5)
    44
    55(define-test (checks?)
     6
     7  (assert* 'x (integer? x))
     8  (assert* 'x (integer? x) (odd? x))
     9  (not
     10    (condition-case
     11      (assert* 'x (integer? x) (even? x))
     12      ((exn assert) #f)))
     13
    614  (= (>> x) 5)
    715  (= (<< x) 5)
     
    1624  (not (condition-case
    1725         (<<% 'x x integer? even?)
    18          ((exn) #f)))
     26         ((exn argument) #f)))
    1927  (not (condition-case
    2028         (<<<% 'loc 'x x integer? even?)
    21          ((exn) #f)))
     29         ((exn argument) #f)))
    2230  (not (condition-case
    2331         (>> x integer? even?)
    24          ((exn) #f)))
     32         ((exn result) #f)))
    2533  (not (<< ((lambda () #f)) boolean?))
    2634  (= ((named-lambda (! n)
Note: See TracChangeset for help on using the changeset viewer.