suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added 'test-case-box property

Browse Source 
svn: r209
This commit is contained in:
Matthew Flatt 2005-06-17 01:43:09 +00:00
parent 4e9be63437
commit 4f19cb1230
1 changed files with 38 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
collects/test-suite/private/test-case-box.ss
View File

@ -87,43 +87,44 @@
(syntax-column next)
(syntax-position next)
(syntax-span next))]))
(if enabled?
(with-syntax ([to-test-stx (syntax-property (text->syntax-object to-test #f)
'stepper-test-suite-hint
true)]
[update-stx (lambda (x) (update x))] ; eta public method
[set-actuals-stx set-actuals]
[w printf])
(if error-box?
(with-syntax ([exn-pred-stx (text->syntax-object should-raise #'exn:fail?)]
[exn-handler-stx
(if (empty-text? error-message)
#'(lambda (v) true)
#`(lambda (v)
(equal? (exn-message v)
#,(text->syntax-object
error-message
#f))))])
(syntax/loc (datum->syntax-object
false 'ignored (list source line column position 1))
(test-error-case to-test-stx
exn-pred-stx
exn-handler-stx
update-stx
set-actuals-stx)))
(with-syntax ([exp-stx (text->syntax-object expected #f)]
[pred-stx (text->syntax-object predicate beginner-equal?)])
(syntax/loc (datum->syntax-object
false 'ignored (list source line column position 1))
(test-case pred-stx
to-test-stx
exp-stx
update-stx
set-actuals-stx)))))
(syntax-property #'(define-values () (values))
'stepper-skip-completely
true))))
(syntax-property
(if enabled?
(with-syntax ([to-test-stx (syntax-property (text->syntax-object to-test #f)
'stepper-test-suite-hint
true)]
[update-stx (lambda (x) (update x))] ; eta public method
[set-actuals-stx set-actuals]
[w printf])
(if error-box?
(with-syntax ([exn-pred-stx (text->syntax-object should-raise #'exn:fail?)]
[exn-handler-stx
(if (empty-text? error-message)
#'(lambda (v) true)
#`(lambda (v)
(equal? (exn-message v)
#,(text->syntax-object
error-message
#f))))])
(syntax/loc (datum->syntax-object
false 'ignored (list source line column position 1))
(test-error-case to-test-stx
exn-pred-stx
exn-handler-stx
update-stx
set-actuals-stx)))
(with-syntax ([exp-stx (text->syntax-object expected #f)]
[pred-stx (text->syntax-object predicate beginner-equal?)])
(syntax/loc (datum->syntax-object
false 'ignored (list source line column position 1))
(test-case pred-stx
to-test-stx
exp-stx
update-stx
set-actuals-stx)))))
(syntax-property #'(define-values () (values))
'stepper-skip-completely
true))
'test-case-box #t)))
#;(boolean? . -> . void?)
;; sets the test case to the proper result bassed on if it was correct