Rename test-info' in places where it's really a test-engine'.
This commit is contained in:
Mike Sperber
parent
05d16d9311
commit
b4d1e29784
|
|
@ -79,10 +79,10 @@
|
|||
(if (eq? 'module (syntax-local-context))
|
||||
#`(define #,bogus-name
|
||||
#,(stepper-syntax-property
|
||||
#`(let ([test-info (namespace-variable-value
|
||||
'test~object #f builder (current-namespace))])
|
||||
(when test-info
|
||||
(insert-test test-info
|
||||
#`(let ([test-engine (namespace-variable-value
|
||||
'test~object #f builder (current-namespace))])
|
||||
(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)))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user