60 lines
1.8 KiB
Scheme
60 lines
1.8 KiB
Scheme
#lang scheme/base
|
|
|
|
(require scheme/class)
|
|
|
|
(provide (all-defined-out))
|
|
|
|
;; (make-failed-check src (listof (U string snip%)) (U #f exn))
|
|
(define-struct failed-check (src msg exn?))
|
|
|
|
(define test-info-base%
|
|
(class* object% ()
|
|
(super-instantiate ())
|
|
|
|
(init-field (style 'check-base))
|
|
(field [analyses null])
|
|
|
|
(define total-tsts 0)
|
|
(define failed-tsts 0)
|
|
(define total-cks 0)
|
|
(define failed-cks 0)
|
|
|
|
(define failures null)
|
|
|
|
(define/public (test-style) style)
|
|
(define/public (tests-run) total-tsts)
|
|
(define/public (tests-failed) failed-tsts)
|
|
(define/public (checks-run) total-cks)
|
|
(define/public (checks-failed) failed-cks)
|
|
(define/public (summarize-results)
|
|
(cond [(and (zero? total-tsts) (zero? total-cks)) 'no-tests]
|
|
[(and (zero? failed-cks) (zero? failed-tsts)) 'all-passed]
|
|
[else 'mixed-results]))
|
|
|
|
(define/public (failed-checks) failures)
|
|
|
|
(define/pubment (add-check)
|
|
(set! total-cks (add1 total-cks))
|
|
(inner (void) add-check))
|
|
|
|
(define/pubment (add-test)
|
|
(set! total-tsts (add1 total-tsts))
|
|
(inner (void) add-test))
|
|
|
|
;; check-failed: (list (U string snip%)) src (U exn false) -> void
|
|
(define/pubment (check-failed msg src exn?)
|
|
(set! failed-cks (add1 failed-cks))
|
|
(set! failures (cons (make-failed-check src msg exn?) failures))
|
|
(inner (void) check-failed msg src exn?))
|
|
|
|
(define/pubment (test-failed failed-info)
|
|
(set! failed-tsts (add1 failed-tsts))
|
|
(inner (void) test-failed failed-info))
|
|
|
|
(define/public (add-analysis a) (set! analyses (cons a analyses)))
|
|
|
|
(define/public (analyze-position src . vals)
|
|
(for ([a analyses]) (send a analyze src vals)))
|
|
(define/public (extract-info pred?)
|
|
(filter pred? (map (lambda (a) (send a provide-info)) analyses)))))
|