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

Rename test-info' in places where it's really a test-engine'.

Browse Source
This commit is contained in:
Mike Sperber 2010-10-07 17:59:14 +02:00
parent 05d16d9311
commit b4d1e29784
1 changed files with 45 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
collects/test-engine/racket-tests.rkt
View File

@ -79,10 +79,10 @@
(if (eq? 'module (syntax-local-context))
#`(define #,bogus-name
#,(stepper-syntax-property
#`(let ([test-info (namespace-variable-value
#`(let ([test-engine (namespace-variable-value
'test~object #f builder (current-namespace))])
(when test-info
(insert-test test-info
(when test-engine
(insert-test test-engine
(lambda ()
#,(with-stepper-syntax-properties
(['stepper-hint hint-tag]
@ -103,7 +103,7 @@
#,(with-stepper-syntax-properties
(['stepper-no-lifting-info #t]
['stepper-hide-reduction #t])
#'test-info))))))))
#'test-engine))))))))
'stepper-skipto
(append skipto/third ;; let
skipto/third skipto/second ;; unless (it expands into a begin)
@ -111,12 +111,12 @@
'(syntax-e cdr cdr syntax-e car) ;; lambda
)))
#`(begin
(let ([test-info (namespace-variable-value
(let ([test-engine (namespace-variable-value
'test~object #f builder (current-namespace))])
(when test-info
(when test-engine
(begin
(send test-info reset-info)
(insert-test test-info
(send test-engine reset-info)
(insert-test test-engine
(lambda ()
#,(with-stepper-syntax-properties
(['stepper-hint hint-tag]
@ -137,7 +137,7 @@
#,(with-stepper-syntax-properties
(['stepper-no-lifting-info #t]
['stepper-hide-reduction #t])
#'test-info)))))))))
#'test-engine)))))))))
(test))))
(define-for-syntax (check-context?)
@ -154,15 +154,15 @@
'comes-from-check-expect)]
[_ (raise-syntax-error 'check-expect CHECK-EXPECT-STR stx)]))
;; check-values-expected: (-> scheme-val) scheme-val src test-object -> void
(define (check-values-expected test actual src test-info)
;; check-values-expected: (-> scheme-val) scheme-val src test-engine -> void
(define (check-values-expected test actual src test-engine)
(error-check (lambda (v) (if (number? v) (exact? v) #t))
actual INEXACT-NUMBERS-FMT #t)
(error-check (lambda (v) (not (procedure? v))) actual FUNCTION-FMT #f)
(send (send test-info get-info) add-check)
(send (send test-engine get-info) add-check)
(run-and-check (lambda (v1 v2 _) (beginner-equal? v1 v2))
(lambda (src format v1 v2 _) (make-unequal src format v1 v2))
test actual #f src test-info 'check-expect))
test actual #f src test-engine 'check-expect))
;;check-within
(define-syntax (check-within stx)
@ -174,13 +174,13 @@
'comes-from-check-within)]
[_ (raise-syntax-error 'check-within CHECK-WITHIN-STR stx)]))
;; check-values-within: (-> scheme-val) scheme-val number src test-object -> void
(define (check-values-within test actual within src test-info)
;; check-values-within: (-> scheme-val) scheme-val number src test-engine -> void
(define (check-values-within test actual within src test-engine)
(error-check number? within CHECK-WITHIN-INEXACT-FMT #t)
(error-check (lambda (v) (not (procedure? v))) actual CHECK-WITHIN-FUNCTION-FMT #f)
(send (send test-info get-info) add-check)
(send (send test-engine get-info) add-check)
(run-and-check beginner-equal~? make-outofrange test actual within src
test-info
test-engine
'check-within))
;; check-error
@ -196,10 +196,10 @@
'comes-from-check-error)]
[_ (raise-syntax-error 'check-error CHECK-ERROR-STR stx)]))
;; check-values-error: (-> scheme-val) scheme-val src test-object -> void
(define (check-values-error test error src test-info)
;; check-values-error: (-> scheme-val) scheme-val src test-engine -> void
(define (check-values-error test error src test-engine)
(error-check string? error CHECK-ERROR-STR-FMT #t)
(send (send test-info get-info) add-check)
(send (send test-engine get-info) add-check)
(let ([result (with-handlers ([exn?
(lambda (e)
(or (equal? (exn-message e) error)
@ -209,22 +209,22 @@
(make-expected-error src (test-format) error test-val)))])
(if (check-fail? result)
(begin
(send (send test-info get-info) check-failed
(send (send test-engine get-info) check-failed
result (check-fail-src result)
(and (incorrect-error? result) (incorrect-error-exn result)))
#f)
#t)))
;; check-values-error/no-string: (-> scheme-val) src test-object -> void
(define (check-values-error/no-string test src test-info)
(send (send test-info get-info) add-check)
;; check-values-error/no-string: (-> scheme-val) src test-engine -> void
(define (check-values-error/no-string test src test-engine)
(send (send test-engine get-info) add-check)
(let ([result (with-handlers ([exn?
(lambda (e) #t)])
(let ([test-val (test)])
(make-expected-an-error src (test-format) test-val)))])
(if (check-fail? result)
(begin
(send (send test-info get-info) check-failed
(send (send test-engine get-info) check-failed
result (check-fail-src result)
#f)
#f)
@ -247,13 +247,13 @@
'comes-from-check-member-of)]
[_ (raise-syntax-error 'check-member-of CHECK-MEMBER-OF-STR stx)]))
;; check-member-of-values-expected: (-> scheme-val) scheme-val src test-object -> void
(define (check-member-of-values-expected test first-actual actuals src test-info)
;; check-member-of-values-expected: (-> scheme-val) scheme-val src test-engine -> void
(define (check-member-of-values-expected test first-actual actuals src test-engine)
(error-check (lambda (v) (not (procedure? v))) first-actual CHECK-MEMBER-OF-FUNCTION-FMT #f)
(send (send test-info get-info) add-check)
(send (send test-engine get-info) add-check)
(run-and-check (lambda (v2 v1 _) (memf (lambda (i) (beginner-equal? v1 i)) v2))
(lambda (src format v1 v2 _) (make-not-mem src format v1 v2))
test (cons first-actual actuals) #f src test-info 'check-member-of))
test (cons first-actual actuals) #f src test-engine 'check-member-of))
;;check-range
(define-syntax (check-range stx)
@ -265,22 +265,22 @@
'comes-from-check-range)]
[_ (raise-syntax-error 'check-range CHECK-RANGE-STR stx)]))
;; check-range-values-expected: (-> scheme-val) scheme-val src test-object -> void
(define (check-range-values-expected test min max src test-info)
;; check-range-values-expected: (-> scheme-val) scheme-val src test-engine -> void
(define (check-range-values-expected test min max src test-engine)
(error-check number? min RANGE-MIN-FMT #t)
(error-check number? max RANGE-MAX-FMT #t)
(error-check (lambda (v) (not (procedure? v))) min CHECK-RANGE-FUNCTION-FMT #f)
(error-check (lambda (v) (not (procedure? v))) max CHECK-RANGE-FUNCTION-FMT #f)
(send (send test-info get-info) add-check)
(send (send test-engine get-info) add-check)
(run-and-check (lambda (v2 v1 v3) (and (number? v1) (and (<= v2 v1) (<= v1 v3))))
(lambda (src format v1 v2 v3) (make-not-range src format v1 v2 v3))
test min max src test-info 'check-range))
test min max src test-engine 'check-range))
;; run-and-check: (scheme-val scheme-val scheme-val -> boolean)
;; (src format scheme-val scheme-val scheme-val -> check-fail)
;; ( -> scheme-val) scheme-val scheme-val object symbol? -> void
(define (run-and-check check maker test expect range src test-info kind)
;; ( -> scheme-val) scheme-val scheme-val test-engine symbol? -> void
(define (run-and-check check maker test expect range src test-engine kind)
(match-let ([(list result result-val exn)
(with-handlers ([exn:fail?
(lambda (e)
@ -295,7 +295,7 @@
[else
(list (maker src (test-format) test-val expect range) test-val #f)])))])
(cond [(check-fail? result)
(send (send test-info get-info) check-failed result (check-fail-src result) exn)
(send (send test-engine get-info) check-failed result (check-fail-src result) exn)
(if exn
(raise exn)
#f)]
@ -328,18 +328,18 @@
'test-call #t)]))
(define (run)
(let ([test-info
(let ([test-engine
(namespace-variable-value 'test~object #f builder (current-namespace))])
(and test-info (send test-info run))))
(and test-engine (send test-engine run))))
(define (display-results*)
(let ([test-info (namespace-variable-value 'test~object #f builder (current-namespace))])
(and test-info
(let ([test-engine (namespace-variable-value 'test~object #f builder (current-namespace))])
(and test-engine
(let ([display-data (scheme-test-data)])
(when (caddr display-data)
(send test-info refine-display-class (caddr display-data)))
(send test-info setup-display (car display-data) (cadr display-data))
(send test-info summarize-results (current-output-port))))))
(send test-engine refine-display-class (caddr display-data)))
(send test-engine setup-display (car display-data) (cadr display-data))
(send test-engine summarize-results (current-output-port))))))
(define-syntax (display-results stx)
(syntax-case stx ()
@ -355,7 +355,7 @@
(send engine setup-info 'test-check)
engine))
(define (insert-test test-info test) (send test-info add-test test))
(define (insert-test test-engine test) (send test-engine add-test test))
(define scheme-test-data (make-parameter (list #f #f #f)))