- Timestamp:
- 05/12/20 20:31:39 (9 months ago)
- Location:
- release/5/simple-tests
- Files:
-
- 3 edited
- 4 copied
Legend:
- Unmodified
- Added
- Removed
-
release/5/simple-tests/tags/2.2/simple-tests.egg
r38640 r38691 4 4 (category testing) 5 5 (license "BSD") 6 (version "2. 1")6 (version "2.2") 7 7 (author "Juergen Lorenz") 8 8 (components (extension simple-tests -
release/5/simple-tests/tags/2.2/simple-tests.scm
r38640 r38691 48 48 writeln 49 49 pe 50 ppp 51 ppp* 52 ppp** 50 53 xpr:val 51 ppp52 54 xpr:val* 53 ppp*55 == 54 56 ; old interface 55 57 define-test … … 58 60 *failures* 59 61 ; new interface 60 ==61 62 define-checks 62 63 do-checks … … 75 76 (define simple-tests 76 77 (let ( 77 (signatures '((simple-tests sym ..) 78 (and? xpr ...) 79 (writeln xpr ....) 80 (pe macro-code) 81 (xpr:val xpr ...) 82 (ppp xpr ...) 83 (xpr:val* {xpr val} ...) 84 (ppp* {xpr val} ...) 85 86 (define-test (name . parameters) form . forms) 87 (check form . forms) 88 (compound-test (name) test . tests) 89 90 (==) 91 (== x) 92 (== type? type-equal?) 93 (do-checks (name? verbose? :arg val: ...) :xpr expected: ....) 94 (define-checks (name? verbose? :arg val: ...) :xpr expected: ....) 95 (check-all name check-xpr ....))) 78 (signatures '((simple-tests 79 procedure: 80 (simple-tests sym ..) 81 "documentation procedure") 82 (and? 83 procedure: 84 (and? xpr ...) 85 "Pascal like and procedure") 86 (writeln 87 procedure: 88 (writeln xpr ....) 89 "write analog of print") 90 (pe 91 procedure: 92 (pe macro-code) 93 " composes pretty-print and expand") 94 (ppp 95 macro: 96 (ppp xpr ...) 97 " print each xpr quoted in a headline" 98 "and pretty-print xpr's computed value") 99 (ppp* 100 macro: 101 (ppp* xpr ypr . xpr-yprs) 102 "print each xpr quoted in a headline" 103 "and pretty-print xpr's computed and" 104 "expected value, ypr") 105 (ppp** 106 macro: 107 (ppp** ((var val) ...) xpr ypr . xpr-yprs) 108 "wraps ppp* into a let") 109 (xpr:val 110 macro: 111 (xpr:val xpr ...) 112 "alias to ppp") 113 (xpr:val* 114 macro: 115 (xpr:val* xpr ypr . xpr-yprs) 116 "alias to ppp*") 117 (== 118 procedure: 119 (==) 120 (== x) 121 (== type? type-equal?) 122 "generic type equality as curried procedure:" 123 "the first resets the local database," 124 "the second is the curried equality check" 125 "and the third adds a new equality procedure" 126 "to the local database") 127 128 (define-test 129 macro: 130 (define-test (name . parameters) form . forms) 131 "creates a test function") 132 (check 133 macro: 134 (check form . forms) 135 "report results of all forms") 136 (compound-test 137 macro: 138 (compound-test (name) test . tests) 139 "checks all tests created with define-test" 140 "and reports a summary of results") 141 142 (define-checks 143 macro: 144 (define-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs) 145 "returns a unary predicate, name?," 146 "comparing xpr with ypr ...." 147 "and using var val ... within this checks." 148 "verbose? controls the reported results") 149 (do-checks 150 macro: 151 (do-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs) 152 "alias to define-checks") 153 (check-all 154 macro: 155 (check-all name check-xpr ....) 156 "checks all check-expressions created by do-check" 157 "and reports the results"))) 96 158 ) 97 159 (case-lambda 98 160 (() (map car signatures)) 99 ((sym) (assq sym signatures))))) 161 ((sym) 162 (let ((pair (assq sym signatures))) 163 (if pair 164 (for-each print (cdr pair)) 165 (print "Choose one of " (map car signatures)))))))) 100 166 101 167 (define (writeln . args) … … 157 223 ((_) 158 224 (print)) 159 ((_ xpr val)225 ((_ xpr ypr) 160 226 (begin (print "Testing " 'xpr " ...") 161 227 (print* "computed: ") (pp xpr) 162 (print* "expected: ") (pp val)228 (print* "expected: ") (pp ypr) 163 229 )) 164 ((_ xpr val. pairs)165 (begin (help-ppp* xpr val)230 ((_ xpr ypr . pairs) 231 (begin (help-ppp* xpr ypr) 166 232 (help-ppp* . pairs))) 167 233 )) 168 234 ; 169 ;;;; (ppp* {xpr val} ...)235 ;;;; (ppp* {xpr ypr} ...) 170 236 ;;; -------------------- 171 237 ;;; print each xpr quoted in a headline and pretty-print xpr's computed 172 ;;; and expected value .238 ;;; and expected value, ypr. 173 239 (define-syntax ppp* 174 240 (syntax-rules () … … 179 245 (else))))) 180 246 181 ;;; (xpr:val* {xpr val} ...)247 ;;; (xpr:val* {xpr ypr} ...) 182 248 ;;; ------------------------ 183 249 ;;; print each xpr quoted in a headline and pretty-print xpr's computed 184 ;;; and expected value .250 ;;; and expected value, ypr. 185 251 ;;; Alias to ppp* 186 252 (define-syntax xpr:val* … … 188 254 ((_ . pairs) 189 255 (ppp* . pairs)))) 256 257 ;;; (ppp** ((var val) ...) xpr ypr . other xpr-ypr-pairs) 258 ;;; ----------------------------------------------------- 259 ;;; ppp* wrapped into a let 260 (define-syntax ppp** 261 (syntax-rules () 262 ((_ ((var val) ...) xpr ypr . other-xpr-ypr-pairs) 263 (let ((var val) ...) 264 (ppp* xpr ypr . other-xpr-ypr-pairs))))) 190 265 191 266 ;;;;;;;; old interface ;;;;;;;;; … … 359 434 ))) 360 435 361 ;;; (do-checks (name? verbose? :arg val: ...) :xpr expect: ....) 362 ;;; ---------------------------------------------------------------- 363 ;;; returns a unary predicate, name?, comparing xpr with expect .... 364 ;;; and using arg val ... within this checks 365 (define-syntax do-checks 436 ;;; (define-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs) 437 ;;; -------------------------------------------------------------- 438 ;;; returns a unary predicate, name?, comparing xpr with ypr .... 439 ;;; and using var val ... within this checks, 440 ;;; verbose? controls the reported summary. 441 (define-syntax define-checks 366 442 (er-macro-transformer 367 443 (lambda (form rename compare?) … … 447 523 )))) 448 524 449 ;;; (d efine-checks (name? verbose? :arg val: ...) :xpr expect: ....)450 ;;; --------------------------------------------------------------- -451 ;;; returns a unary predicate, name?, comparing xpr with expect....452 ;;; and using arg val ... within this checks453 ;;; Alias to do-checks454 (define-syntax d efine-checks455 (syntax-rules () 456 ((_(name? verbose? . arg-val-pairs) xpr expect . xpr-expect-pairs)457 (d o-checks (name? verbose? . arg-val-pairs)458 xpr expect . xpr-expect-pairs))))525 ;;; (do-checks (name? verbose? . var-val-pairs) xpr ypr . xpr-yprs) 526 ;;; --------------------------------------------------------------- 527 ;;; returns a unary predicate, name?, comparing xpr with ypr .... 528 ;;; and using var val ... within this checks, 529 ;;; alias to define-checks 530 (define-syntax do-checks 531 (syntax-rules () 532 ((_(name? verbose? . var-val-pairs) xpr ypr . xpr-ypr-pairs) 533 (define-checks (name? verbose? . var-val-pairs) 534 xpr ypr . xpr-ypr-pairs)))) 459 535 460 536 (define (check-all-proc name . test-name-pairs) ; internal to check-all -
release/5/simple-tests/tags/2.2/tests/run.scm
r38640 r38691 40 40 ;;; new interface 41 41 ;;; define-checks is an alias to do-checks 42 43 (ppp** ((lst '(0 1 2 3))) 44 lst 45 '(0 1 2 3) 46 (car lst) 47 0 48 (cadr lst) 49 1 50 (cddr lst) 51 '(2 3) 52 ) 42 53 43 54 (do-checks (bar? verbose? n 5) -
release/5/simple-tests/trunk/simple-tests.egg
r38640 r38691 4 4 (category testing) 5 5 (license "BSD") 6 (version "2. 1")6 (version "2.2") 7 7 (author "Juergen Lorenz") 8 8 (components (extension simple-tests -
release/5/simple-tests/trunk/simple-tests.scm
r38640 r38691 48 48 writeln 49 49 pe 50 ppp 51 ppp* 52 ppp** 50 53 xpr:val 51 ppp52 54 xpr:val* 53 ppp*55 == 54 56 ; old interface 55 57 define-test … … 58 60 *failures* 59 61 ; new interface 60 ==61 62 define-checks 62 63 do-checks … … 75 76 (define simple-tests 76 77 (let ( 77 (signatures '((simple-tests sym ..) 78 (and? xpr ...) 79 (writeln xpr ....) 80 (pe macro-code) 81 (xpr:val xpr ...) 82 (ppp xpr ...) 83 (xpr:val* {xpr val} ...) 84 (ppp* {xpr val} ...) 85 86 (define-test (name . parameters) form . forms) 87 (check form . forms) 88 (compound-test (name) test . tests) 89 90 (==) 91 (== x) 92 (== type? type-equal?) 93 (do-checks (name? verbose? :arg val: ...) :xpr expected: ....) 94 (define-checks (name? verbose? :arg val: ...) :xpr expected: ....) 95 (check-all name check-xpr ....))) 78 (signatures '((simple-tests 79 procedure: 80 (simple-tests sym ..) 81 "documentation procedure") 82 (and? 83 procedure: 84 (and? xpr ...) 85 "Pascal like and procedure") 86 (writeln 87 procedure: 88 (writeln xpr ....) 89 "write analog of print") 90 (pe 91 procedure: 92 (pe macro-code) 93 " composes pretty-print and expand") 94 (ppp 95 macro: 96 (ppp xpr ...) 97 " print each xpr quoted in a headline" 98 "and pretty-print xpr's computed value") 99 (ppp* 100 macro: 101 (ppp* xpr ypr . xpr-yprs) 102 "print each xpr quoted in a headline" 103 "and pretty-print xpr's computed and" 104 "expected value, ypr") 105 (ppp** 106 macro: 107 (ppp** ((var val) ...) xpr ypr . xpr-yprs) 108 "wraps ppp* into a let") 109 (xpr:val 110 macro: 111 (xpr:val xpr ...) 112 "alias to ppp") 113 (xpr:val* 114 macro: 115 (xpr:val* xpr ypr . xpr-yprs) 116 "alias to ppp*") 117 (== 118 procedure: 119 (==) 120 (== x) 121 (== type? type-equal?) 122 "generic type equality as curried procedure:" 123 "the first resets the local database," 124 "the second is the curried equality check" 125 "and the third adds a new equality procedure" 126 "to the local database") 127 128 (define-test 129 macro: 130 (define-test (name . parameters) form . forms) 131 "creates a test function") 132 (check 133 macro: 134 (check form . forms) 135 "report results of all forms") 136 (compound-test 137 macro: 138 (compound-test (name) test . tests) 139 "checks all tests created with define-test" 140 "and reports a summary of results") 141 142 (define-checks 143 macro: 144 (define-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs) 145 "returns a unary predicate, name?," 146 "comparing xpr with ypr ...." 147 "and using var val ... within this checks." 148 "verbose? controls the reported results") 149 (do-checks 150 macro: 151 (do-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs) 152 "alias to define-checks") 153 (check-all 154 macro: 155 (check-all name check-xpr ....) 156 "checks all check-expressions created by do-check" 157 "and reports the results"))) 96 158 ) 97 159 (case-lambda 98 160 (() (map car signatures)) 99 ((sym) (assq sym signatures))))) 161 ((sym) 162 (let ((pair (assq sym signatures))) 163 (if pair 164 (for-each print (cdr pair)) 165 (print "Choose one of " (map car signatures)))))))) 100 166 101 167 (define (writeln . args) … … 157 223 ((_) 158 224 (print)) 159 ((_ xpr val)225 ((_ xpr ypr) 160 226 (begin (print "Testing " 'xpr " ...") 161 227 (print* "computed: ") (pp xpr) 162 (print* "expected: ") (pp val)228 (print* "expected: ") (pp ypr) 163 229 )) 164 ((_ xpr val. pairs)165 (begin (help-ppp* xpr val)230 ((_ xpr ypr . pairs) 231 (begin (help-ppp* xpr ypr) 166 232 (help-ppp* . pairs))) 167 233 )) 168 234 ; 169 ;;;; (ppp* {xpr val} ...)235 ;;;; (ppp* {xpr ypr} ...) 170 236 ;;; -------------------- 171 237 ;;; print each xpr quoted in a headline and pretty-print xpr's computed 172 ;;; and expected value .238 ;;; and expected value, ypr. 173 239 (define-syntax ppp* 174 240 (syntax-rules () … … 179 245 (else))))) 180 246 181 ;;; (xpr:val* {xpr val} ...)247 ;;; (xpr:val* {xpr ypr} ...) 182 248 ;;; ------------------------ 183 249 ;;; print each xpr quoted in a headline and pretty-print xpr's computed 184 ;;; and expected value .250 ;;; and expected value, ypr. 185 251 ;;; Alias to ppp* 186 252 (define-syntax xpr:val* … … 188 254 ((_ . pairs) 189 255 (ppp* . pairs)))) 256 257 ;;; (ppp** ((var val) ...) xpr ypr . other xpr-ypr-pairs) 258 ;;; ----------------------------------------------------- 259 ;;; ppp* wrapped into a let 260 (define-syntax ppp** 261 (syntax-rules () 262 ((_ ((var val) ...) xpr ypr . other-xpr-ypr-pairs) 263 (let ((var val) ...) 264 (ppp* xpr ypr . other-xpr-ypr-pairs))))) 190 265 191 266 ;;;;;;;; old interface ;;;;;;;;; … … 359 434 ))) 360 435 361 ;;; (do-checks (name? verbose? :arg val: ...) :xpr expect: ....) 362 ;;; ---------------------------------------------------------------- 363 ;;; returns a unary predicate, name?, comparing xpr with expect .... 364 ;;; and using arg val ... within this checks 365 (define-syntax do-checks 436 ;;; (define-checks (name? verbose? . var-vals) xpr ypr . xpr-yprs) 437 ;;; -------------------------------------------------------------- 438 ;;; returns a unary predicate, name?, comparing xpr with ypr .... 439 ;;; and using var val ... within this checks, 440 ;;; verbose? controls the reported summary. 441 (define-syntax define-checks 366 442 (er-macro-transformer 367 443 (lambda (form rename compare?) … … 447 523 )))) 448 524 449 ;;; (d efine-checks (name? verbose? :arg val: ...) :xpr expect: ....)450 ;;; --------------------------------------------------------------- -451 ;;; returns a unary predicate, name?, comparing xpr with expect....452 ;;; and using arg val ... within this checks453 ;;; Alias to do-checks454 (define-syntax d efine-checks455 (syntax-rules () 456 ((_(name? verbose? . arg-val-pairs) xpr expect . xpr-expect-pairs)457 (d o-checks (name? verbose? . arg-val-pairs)458 xpr expect . xpr-expect-pairs))))525 ;;; (do-checks (name? verbose? . var-val-pairs) xpr ypr . xpr-yprs) 526 ;;; --------------------------------------------------------------- 527 ;;; returns a unary predicate, name?, comparing xpr with ypr .... 528 ;;; and using var val ... within this checks, 529 ;;; alias to define-checks 530 (define-syntax do-checks 531 (syntax-rules () 532 ((_(name? verbose? . var-val-pairs) xpr ypr . xpr-ypr-pairs) 533 (define-checks (name? verbose? . var-val-pairs) 534 xpr ypr . xpr-ypr-pairs)))) 459 535 460 536 (define (check-all-proc name . test-name-pairs) ; internal to check-all -
release/5/simple-tests/trunk/tests/run.scm
r38640 r38691 40 40 ;;; new interface 41 41 ;;; define-checks is an alias to do-checks 42 43 (ppp** ((lst '(0 1 2 3))) 44 lst 45 '(0 1 2 3) 46 (car lst) 47 0 48 (cadr lst) 49 1 50 (cddr lst) 51 '(2 3) 52 ) 42 53 43 54 (do-checks (bar? verbose? n 5)
Note: See TracChangeset
for help on using the changeset viewer.