Renaming schemeunit to rktunit and adding compat layer

This commit is contained in:
Jay McCarthy 2010-04-29 15:00:02 -06:00
parent 3b23f74fc7
commit f70ffca756
206 changed files with 1112 additions and 1098 deletions

View File

@ -1,6 +1,6 @@
#lang scheme/load #lang scheme/load
(require schemeunit) (require rktunit)
(require 2htdp/batch-io) (require 2htdp/batch-io)
(define file "batch-io.txt") (define file "batch-io.txt")

View File

@ -45,7 +45,7 @@
scheme/math scheme/math
scheme/class scheme/class
scheme/gui/base scheme/gui/base
schemeunit rktunit
(prefix-in 1: htdp/image) (prefix-in 1: htdp/image)
(only-in lang/htdp-advanced equal~?)) (only-in lang/htdp-advanced equal~?))

View File

@ -662,6 +662,7 @@ mz-extras :+= (- (package: "unstable")
;; -------------------- plai ;; -------------------- plai
plt-extras :+= (package: "plai/") plt-extras :+= (package: "plai/")
plt-extras :+= (package: "rktunit/")
plt-extras :+= (package: "schemeunit/") plt-extras :+= (package: "schemeunit/")
;; ============================================================================ ;; ============================================================================

View File

@ -615,26 +615,26 @@
("schematics" "port.plt" 1 0 #f) ("schematics" "port.plt" 1 0 #f)
("schematics" "random.plt" 1 0 #f) ("schematics" "random.plt" 1 0 #f)
("schematics" "sake.plt" 1 0 "4.0") ("schematics" "sake.plt" 1 0 "4.0")
("schematics" "schemeunit.plt" 3 4 "4.0") ("schematics" "rktunit.plt" 3 4 "4.0")
("schematics" "schemeunit.plt" 3 3 "4.0") ("schematics" "rktunit.plt" 3 3 "4.0")
("schematics" "schemeunit.plt" 3 2 "4.0") ("schematics" "rktunit.plt" 3 2 "4.0")
("schematics" "schemeunit.plt" 3 1 "4.0") ("schematics" "rktunit.plt" 3 1 "4.0")
("schematics" "schemeunit.plt" 3 0 "4.0") ("schematics" "rktunit.plt" 3 0 "4.0")
("schematics" "schemeunit.plt" 2 11 "4.1.0.3") ("schematics" "rktunit.plt" 2 11 "4.1.0.3")
("schematics" "schemeunit.plt" 2 10 "369.1") ("schematics" "rktunit.plt" 2 10 "369.1")
("schematics" "schemeunit.plt" 2 9 "369.1") ("schematics" "rktunit.plt" 2 9 "369.1")
("schematics" "schemeunit.plt" 2 8 "369.1") ("schematics" "rktunit.plt" 2 8 "369.1")
("schematics" "schemeunit.plt" 2 7 "369.1") ("schematics" "rktunit.plt" 2 7 "369.1")
("schematics" "schemeunit.plt" 2 6 "369.1") ("schematics" "rktunit.plt" 2 6 "369.1")
("schematics" "schemeunit.plt" 2 5 "369.1") ("schematics" "rktunit.plt" 2 5 "369.1")
("schematics" "schemeunit.plt" 2 4 "369.1") ("schematics" "rktunit.plt" 2 4 "369.1")
("schematics" "schemeunit.plt" 2 3 #f) ("schematics" "rktunit.plt" 2 3 #f)
("schematics" "schemeunit.plt" 2 2 #f) ("schematics" "rktunit.plt" 2 2 #f)
("schematics" "schemeunit.plt" 2 1 #f) ("schematics" "rktunit.plt" 2 1 #f)
("schematics" "schemeunit.plt" 2 0 #f) ("schematics" "rktunit.plt" 2 0 #f)
("schematics" "schemeunit.plt" 1 2 #f) ("schematics" "rktunit.plt" 1 2 #f)
("schematics" "schemeunit.plt" 1 1 #f) ("schematics" "rktunit.plt" 1 1 #f)
("schematics" "schemeunit.plt" 1 0 #f) ("schematics" "rktunit.plt" 1 0 #f)
("schematics" "si.plt" 1 0 #f) ("schematics" "si.plt" 1 0 #f)
("schematics" "spgsql.plt" 2 3 "371.3") ("schematics" "spgsql.plt" 2 3 "371.3")
("schematics" "spgsql.plt" 2 2 "371.3") ("schematics" "spgsql.plt" 2 2 "371.3")

View File

@ -1126,16 +1126,17 @@ path/s is either such a string or a list of them.
"collects/scheme/gui.rkt" drdr:command-line "mred-text -t ~s" "collects/scheme/gui.rkt" drdr:command-line "mred-text -t ~s"
"collects/scheme/match" responsible (samth) "collects/scheme/match" responsible (samth)
"collects/scheme/match.rkt" responsible (samth) "collects/scheme/match.rkt" responsible (samth)
"collects/schemeunit" responsible (noel ryanc) "collects/rktunit" responsible (jay noel ryanc)
"collects/schemeunit/gui.rkt" responsible (ryanc) drdr:command-line "mred-text -t ~s" "collects/schemeunit" responsible (jay)
"collects/schemeunit/private/gui" responsible (ryanc) "collects/rktunit/gui.rkt" responsible (ryanc) drdr:command-line "mred-text -t ~s"
"collects/schemeunit/private/gui/config.rkt" drdr:command-line "mred-text -t ~s" "collects/rktunit/private/gui" responsible (ryanc)
"collects/schemeunit/private/gui/controller.rkt" drdr:command-line "mred-text -t ~s" "collects/rktunit/private/gui/config.rkt" drdr:command-line "mred-text -t ~s"
"collects/schemeunit/private/gui/gui.rkt" drdr:command-line "mred-text -t ~s" "collects/rktunit/private/gui/controller.rkt" drdr:command-line "mred-text -t ~s"
"collects/schemeunit/private/gui/model2rml.rkt" drdr:command-line "mred-text -t ~s" "collects/rktunit/private/gui/gui.rkt" drdr:command-line "mred-text -t ~s"
"collects/schemeunit/private/gui/rml.rkt" drdr:command-line "mred-text -t ~s" "collects/rktunit/private/gui/model2rml.rkt" drdr:command-line "mred-text -t ~s"
"collects/schemeunit/private/gui/view.rkt" drdr:command-line "mred-text -t ~s" "collects/rktunit/private/gui/rml.rkt" drdr:command-line "mred-text -t ~s"
"collects/schemeunit/tool.rkt" responsible (ryanc) drdr:command-line "mred-text -t ~s" "collects/rktunit/private/gui/view.rkt" drdr:command-line "mred-text -t ~s"
"collects/rktunit/tool.rkt" responsible (ryanc) drdr:command-line "mred-text -t ~s"
"collects/scribble/run.rkt" drdr:command-line "mzc ~s" "collects/scribble/run.rkt" drdr:command-line "mzc ~s"
"collects/scribble/tools/drscheme-buttons.rkt" drdr:command-line "mred-text ~s" "collects/scribble/tools/drscheme-buttons.rkt" drdr:command-line "mred-text ~s"
"collects/scribble/tools/private/mk-drs-bitmaps.rkt" drdr:command-line "mred-text ~s" drdr:timeout 240 "collects/scribble/tools/private/mk-drs-bitmaps.rkt" drdr:command-line "mred-text ~s" drdr:timeout 240
@ -1582,7 +1583,7 @@ path/s is either such a string or a list of them.
"collects/tests/planet/examples/dummy-module.rkt" drdr:command-line "" "collects/tests/planet/examples/dummy-module.rkt" drdr:command-line ""
"collects/tests/plot/run-tests.rkt" drdr:command-line "mred-text -t ~s" "collects/tests/plot/run-tests.rkt" drdr:command-line "mred-text -t ~s"
"collects/tests/run-automated-tests.rkt" drdr:command-line "mzc -k ~s" drdr:timeout 600 "collects/tests/run-automated-tests.rkt" drdr:command-line "mzc -k ~s" drdr:timeout 600
"collects/tests/schemeunit" responsible (noel) "collects/tests/rktunit" responsible (jay noel)
"collects/tests/srfi/1/run-tests.rkt" drdr:command-line "mzscheme -f ~s" "collects/tests/srfi/1/run-tests.rkt" drdr:command-line "mzscheme -f ~s"
"collects/tests/srfi/40/run-tests.rkt" drdr:command-line "mzscheme -f ~s" "collects/tests/srfi/40/run-tests.rkt" drdr:command-line "mzscheme -f ~s"
"collects/tests/srfi/43/run-tests.rkt" drdr:command-line "mzscheme -f ~s" "collects/tests/srfi/43/run-tests.rkt" drdr:command-line "mzscheme -f ~s"

View File

@ -1,7 +1,7 @@
#lang scheme/base #lang scheme/base
(require (for-syntax scheme/base) (require (for-syntax scheme/base)
"../lex.ss" "../lex.ss"
schemeunit) rktunit)
(define-syntax (catch-syn-error stx) (define-syntax (catch-syn-error stx)
(syntax-case stx () (syntax-case stx ()

18
collects/rktunit/gui.rkt Normal file
View File

@ -0,0 +1,18 @@
#lang racket/base
(require racket/contract
(rename-in "private/base.rkt")
"private/gui/gui.rkt")
(define (test/gui . tests)
(apply (make-gui-runner) tests))
(define test/c (or/c rktunit-test-case? rktunit-test-suite?))
(provide/contract
[test/gui
(->* () () #:rest (listof test/c)
any)]
[make-gui-runner
(->
(->* () () #:rest (listof test/c)
any))])

13
collects/rktunit/info.rkt Normal file
View File

@ -0,0 +1,13 @@
#lang setup/infotab
(define name "RktUnit")
(define blurb '((p "RktUnit is a unit testing framework based on the "
" Extreme Programming unit test frameworks")))
(define scribblings '(("scribblings/rktunit.scrbl" (multi-page) (tool))))
(define tools '[("tool.rkt")])
(define tool-names '["RktUnit DrRacket integration"])
(define homepage "http://schematics.sourceforge.net/")
(define url "http://schematics.sourceforge.net/")

31
collects/rktunit/main.rkt Normal file
View File

@ -0,0 +1,31 @@
;;;
;;; Time-stamp: <2008-07-30 10:46:00 nhw>
;;;
;;; Copyright (C) by Noel Welsh.
;;;
;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.
;;; This library is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE. See the GNU Lesser General Public
;;; License for more details.
;;; You should have received a copy of the GNU Lesser
;;; General Public License along with this library; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA
;;; Author: Noel Welsh <noelwelsh@yahoo.com>
;;
;;
;; Commentary:
#lang racket/base
(require "private/test.rkt")
(provide (all-from-out "private/test.rkt"))

View File

@ -1,13 +1,13 @@
#lang scheme/base #lang racket/base
(require scheme/contract) (require racket/contract)
;; struct test : ;; struct test :
(define-struct test ()) (define-struct test ())
;; struct (schemeunit-test-case test) : (U string #f) thunk ;; struct (rktunit-test-case test) : (U string #f) thunk
(define-struct (schemeunit-test-case test) (name action) #:transparent) (define-struct (rktunit-test-case test) (name action) #:transparent)
;; struct (schemeunit-test-suite test) : string (fdown fup fhere seed -> (listof test-result)) thunk thunk ;; struct (rktunit-test-suite test) : string (fdown fup fhere seed -> (listof test-result)) thunk thunk
(define-struct (schemeunit-test-suite test) (name tests before after) #:transparent) (define-struct (rktunit-test-suite test) (name tests before after) #:transparent)
;; struct exn:test exn : () ;; struct exn:test exn : ()
;; ;;
@ -33,10 +33,10 @@
(define-struct (test-success test-result) (result)) (define-struct (test-success test-result) (result))
(provide/contract (provide/contract
(struct (schemeunit-test-case test) (struct (rktunit-test-case test)
((name (or/c string? false/c)) ((name (or/c string? false/c))
(action (-> any)))) (action (-> any))))
(struct (schemeunit-test-suite test) (struct (rktunit-test-suite test)
((name string?) ((name string?)
(tests procedure?) (tests procedure?)
(before (-> any)) (before (-> any))

View File

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(provide (all-defined-out)) (provide (all-defined-out))
@ -11,7 +11,7 @@
;; Infrastructure ---------------------------------------------- ;; Infrastructure ----------------------------------------------
;; The continuation mark under which all check-info is keyed ;; The continuation mark under which all check-info is keyed
(define check-info-mark (gensym 'schemeunit)) (define check-info-mark (gensym 'rktunit))
;; (continuation-mark-set -> (listof check-info)) ;; (continuation-mark-set -> (listof check-info))
(define (check-info-stack marks) (define (check-info-stack marks)

View File

@ -1,12 +1,12 @@
#lang scheme/base #lang racket/base
(require (for-syntax scheme/base (require (for-syntax racket/base
"location.ss") "location.rkt")
srfi/1 srfi/1
"base.ss" "base.rkt"
"check-info.ss" "check-info.rkt"
"format.ss" "format.rkt"
"location.ss") "location.rkt")
(provide current-check-handler (provide current-check-handler
check-around check-around

View File

@ -26,11 +26,11 @@
;; ;;
;; Commentary: ;; Commentary:
#lang scheme/base #lang racket/base
(require "base.ss" (require "base.rkt"
"monad.ss" "monad.rkt"
"hash-monad.ss") "hash-monad.rkt")
(provide display-counter (provide display-counter
update-counter! update-counter!

View File

@ -1,8 +1,8 @@
#lang scheme/base #lang racket/base
(require scheme/match (require racket/match
srfi/13 srfi/13
"check-info.ss") "check-info.rkt")
(provide display-check-info-name-value (provide display-check-info-name-value
display-check-info display-check-info

View File

@ -1,5 +1,5 @@
#lang scheme/base #lang racket/base
(require scheme/contract) (require racket/contract)
;; Add a new kind of promise instead? ;; Add a new kind of promise instead?

View File

@ -1,24 +1,24 @@
#lang scheme/base #lang racket/base
(require framework (require framework
unstable/gui/prefs) unstable/gui/prefs)
(provide (all-defined-out)) (provide (all-defined-out))
;; Frame size preferences ;; Frame size preferences
(preferences:set-default 'schemeunit:frame:width 400 exact-positive-integer?) (preferences:set-default 'rktunit:frame:width 400 exact-positive-integer?)
(preferences:set-default 'schemeunit:frame:height 400 exact-positive-integer?) (preferences:set-default 'rktunit:frame:height 400 exact-positive-integer?)
(define pref:width (pref:get/set 'schemeunit:frame:width)) (define pref:width (pref:get/set 'rktunit:frame:width))
(define pref:height (pref:get/set 'schemeunit:frame:height)) (define pref:height (pref:get/set 'rktunit:frame:height))
;; CONSTANTS ;; CONSTANTS
;; Some of these are obsolete, given the preferences above. ;; Some of these are obsolete, given the preferences above.
(define DETAILS-CANVAS-INIT-WIDTH 400) (define DETAILS-CANVAS-INIT-WIDTH 400)
(define FRAME-LABEL "SchemeUnit") (define FRAME-LABEL "RktUnit")
(define FRAME-INIT-HEIGHT 400) (define FRAME-INIT-HEIGHT 400)
(define TREE-INIT-WIDTH 240) (define TREE-INIT-WIDTH 240)
(define TREE-COLORIZE-CASES #t) (define TREE-COLORIZE-CASES #t)
(define DIALOG-ERROR-TITLE "SchemeUnit: Error") (define DIALOG-ERROR-TITLE "RktUnit: Error")
(define STATUS-SUCCESS 'success) (define STATUS-SUCCESS 'success)
(define STATUS-FAILURE 'failure) (define STATUS-FAILURE 'failure)
(define STATUS-ERROR 'error) (define STATUS-ERROR 'error)
@ -28,7 +28,7 @@
(list (/ TREE-INIT-WIDTH total) (/ DETAILS-CANVAS-INIT-WIDTH total)))) (list (/ TREE-INIT-WIDTH total) (/ DETAILS-CANVAS-INIT-WIDTH total))))
;; Conventional assertion-info keys. ;; Conventional assertion-info keys.
;; These must be kept in sync with assert-base.ss. ;; These must be kept in sync with assert-base.rkt.
(define prop:failure-assertion 'name) (define prop:failure-assertion 'name)
(define prop:failure-parameters 'params) (define prop:failure-parameters 'params)
(define prop:failure-location 'location) (define prop:failure-location 'location)

View File

@ -1,11 +1,11 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
unstable/class-iop unstable/class-iop
unstable/gui/notify unstable/gui/notify
"../base.ss" "../base.rkt"
"interfaces.ss" "interfaces.rkt"
"model.ss" "model.rkt"
"view.ss") "view.rkt")
(provide controller%) (provide controller%)
(define controller% (define controller%
@ -25,18 +25,18 @@
;; create-model : test suite<%>/#f -> result<%> ;; create-model : test suite<%>/#f -> result<%>
(define/public (create-model test parent) (define/public (create-model test parent)
(define result (define result
(cond [(schemeunit-test-case? test) (cond [(rktunit-test-case? test)
(new case-result% (new case-result%
(controller this) (controller this)
(test test) (test test)
(name (or (schemeunit-test-case-name test) (name (or (rktunit-test-case-name test)
"<unnamed test-case>")) "<unnamed test-case>"))
(parent parent))] (parent parent))]
[(schemeunit-test-suite? test) [(rktunit-test-suite? test)
(new suite-result% (new suite-result%
(controller this) (controller this)
(test test) (test test)
(name (or (schemeunit-test-suite-name test) (name (or (rktunit-test-suite-name test)
"<unnamed test-suite>")) "<unnamed test-suite>"))
(parent parent))])) (parent parent))]))
(send/i view view<%> create-view-link result parent) (send/i view view<%> create-view-link result parent)

View File

@ -1,7 +1,7 @@
;; Written in #%kernel to avoid adding any module-attachment ;; Written in #%kernel to avoid adding any module-attachment
;; dependencies. Initialized by the DrScheme integration tool. ;; dependencies. Initialized by the DrRacket integration tool.
(module drscheme-link '#%kernel (module drracket-link '#%kernel
(#%provide link) (#%provide link)
#| #|

View File

@ -1,10 +1,10 @@
#lang scheme/base #lang racket/base
(require scheme/list (require racket/list
scheme/string racket/string
mzlib/etc mzlib/etc
"drscheme-link.ss") "drracket-link.rkt")
;; Procedures which *may* be overridden by DrScheme to do useful things. ;; Procedures which *may* be overridden by DrRacket to do useful things.
;; Or they may not be. ;; Or they may not be.
(provide has-backtrace? (provide has-backtrace?

View File

@ -1,13 +1,13 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
unstable/class-iop unstable/class-iop
scheme/gui racket/gui
"../base.ss" "../base.rkt"
"../result.ss" "../result.rkt"
"../check-info.ss" "../check-info.rkt"
"interfaces.ss" "interfaces.rkt"
"controller.ss" "controller.rkt"
"view.ss") "view.rkt")
(provide make-gui-runner) (provide make-gui-runner)
(define (make-gui-runner) (define (make-gui-runner)
@ -48,8 +48,8 @@
#| #|
(define/public (run) (define/public (run)
(let ([custodian (make-custodian)] (let ([custodian (make-custodian)]
[before (schemeunit-test-suite-before test)] [before (rktunit-test-suite-before test)]
[after (schemeunit-test-suite-after test)]) [after (rktunit-test-suite-after test)])
(parameterize [(current-custodian custodian)] (parameterize [(current-custodian custodian)]
(dynamic-wind (dynamic-wind
before before
@ -112,8 +112,8 @@
(call-with-continuation-prompt (call-with-continuation-prompt
(lambda () (lambda ()
(time-apply run-test-case (time-apply run-test-case
(list (schemeunit-test-case-name test) (list (rktunit-test-case-name test)
(schemeunit-test-case-action test)))))]) (rktunit-test-case-action test)))))])
(values (car results) (list cputime realtime gctime)))) (values (car results) (list cputime realtime gctime))))
(define (make-output-ports) (define (make-output-ports)

View File

@ -1,6 +1,6 @@
#lang scheme/base #lang racket/base
(require scheme/contract (require racket/contract
scheme/dict) racket/dict)
(define (make-gvector* #:capacity [capacity 10]) (define (make-gvector* #:capacity [capacity 10])
(make-gvector (make-vector capacity #f) 0)) (make-gvector (make-vector capacity #f) 0))

View File

@ -1,5 +1,5 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
unstable/class-iop) unstable/class-iop)
(provide (all-defined-out)) (provide (all-defined-out))

View File

@ -1,11 +1,11 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
unstable/class-iop unstable/class-iop
scheme/list racket/list
"gvector.ss" "gvector.rkt"
"../base.ss" "../base.rkt"
"interfaces.ss" "interfaces.rkt"
"cache-box.ss") "cache-box.rkt")
(provide case-result% (provide case-result%
suite-result%) suite-result%)

View File

@ -1,14 +1,14 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
unstable/class-iop unstable/class-iop
scheme/list racket/list
scheme/gui racket/gui
scheme/match racket/match
scheme/file racket/file
mrlib/include-bitmap mrlib/include-bitmap
(prefix-in drlink: "drscheme-ui.ss") (prefix-in drlink: "drracket-ui.rkt")
"interfaces.ss" "interfaces.rkt"
"config.ss") "config.rkt")
(provide model-renderer% (provide model-renderer%
output-icon) output-icon)
@ -404,12 +404,12 @@
(put '() " ") (put '() " ")
(put+click '(clickback) (put+click '(clickback)
(lambda _ (drlink:show-errortrace-backtrace exn)) (lambda _ (drlink:show-errortrace-backtrace exn))
"[from DrScheme]")) "[from DrRacket]"))
(when (drlink:has-primitive-backtrace? exn) (when (drlink:has-primitive-backtrace? exn)
(put '() " ") (put '() " ")
(put+click '(clickback) (put+click '(clickback)
(lambda _ (drlink:show-primitive-backtrace exn)) (lambda _ (drlink:show-primitive-backtrace exn))
"[from mzscheme]"))) "[from racket]")))
(define/private (render-output model) (define/private (render-output model)
(let [(output (send/i model case<%> get-output))] (let [(output (send/i model case<%> get-output))]

View File

Before

Width:  |  Height:  |  Size: 513 B

After

Width:  |  Height:  |  Size: 513 B

View File

@ -1,13 +1,13 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
unstable/class-iop unstable/class-iop
scheme/gui racket/gui
framework framework
"interfaces.ss") "interfaces.rkt")
(provide insert-text (provide insert-text
ext:text% ext:text%
schemeunit-style-map) rktunit-style-map)
;; insert-text : text% string style-delta% -> void ;; insert-text : text% string style-delta% -> void
(define (insert-text e text style) (define (insert-text e text style)
@ -20,7 +20,7 @@
(define ext:text-mixin (define ext:text-mixin
(mixin (text<%>) () (mixin (text<%>) ()
(init-field (style-map schemeunit-style-map)) (init-field (style-map rktunit-style-map))
(inherit last-position (inherit last-position
change-style change-style
set-clickback set-clickback
@ -139,7 +139,7 @@
[error . ,style:red] [error . ,style:red]
[value . ,style:darkblue])) [value . ,style:darkblue]))
(define schemeunit-styles (define rktunit-styles
`([test-unexecuted . ,style:gray] `([test-unexecuted . ,style:gray]
[test-success . ,style:green] [test-success . ,style:green]
[test-failure . ,style:red] [test-failure . ,style:red]
@ -181,7 +181,7 @@
(extend-style-map empty-style-map (extend-style-map empty-style-map
basic-styles)) basic-styles))
;; schemeunit-style-map : style-map<%> ;; rktunit-style-map : style-map<%>
(define schemeunit-style-map (define rktunit-style-map
(extend-style-map basic-style-map (extend-style-map basic-style-map
schemeunit-styles)) rktunit-styles))

View File

@ -1,19 +1,19 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
unstable/class-iop unstable/class-iop
scheme/list racket/list
scheme/gui racket/gui
framework framework
mrlib/hierlist mrlib/hierlist
"interfaces.ss" "interfaces.rkt"
"config.ss" "config.rkt"
"model2rml.ss" "model2rml.rkt"
"rml.ss") "rml.rkt")
(provide make-view-frame (provide make-view-frame
view%) view%)
(define style-map schemeunit-style-map) (define style-map rktunit-style-map)
#| #|
@ -50,7 +50,7 @@ still be there, just not visible?
controller) controller)
(super-new) (super-new)
(define editor (new ext:text% (style-map schemeunit-style-map))) (define editor (new ext:text% (style-map rktunit-style-map)))
(define renderer (define renderer
(new model-renderer% (new model-renderer%
(controller controller) (controller controller)
@ -146,7 +146,7 @@ still be there, just not visible?
;; If the view-link has not been created, ;; If the view-link has not been created,
;; yield until it is. ;; yield until it is.
(unless (yield) (unless (yield)
(error 'schemeunit-gui (error 'rktunit-gui
"internal error: no progress waiting for view-link")) "internal error: no progress waiting for view-link"))
(do-model-update model)]))) (do-model-update model)])))

View File

@ -26,9 +26,9 @@
;; ;;
;; Commentary: ;; Commentary:
#lang scheme/base #lang racket/base
(require "monad.ss") (require "monad.rkt")
(provide (all-defined-out)) (provide (all-defined-out))

View File

@ -1,6 +1,6 @@
#lang scheme/base #lang racket/base
(require scheme/list) (require racket/list)
(provide location-source (provide location-source
location-line location-line

View File

@ -26,7 +26,7 @@
;; ;;
;; Commentary: ;; Commentary:
#lang scheme/base #lang racket/base
(provide (all-defined-out)) (provide (all-defined-out))

View File

@ -26,11 +26,11 @@
;; ;;
;; Commentary: ;; Commentary:
#lang scheme/base #lang racket/base
(require "base.ss" (require "base.rkt"
"monad.ss" "monad.rkt"
"hash-monad.ss" "hash-monad.rkt"
srfi/1) srfi/1)
(provide display-test-case-name (provide display-test-case-name

View File

@ -26,10 +26,10 @@
;; ;;
;; Commentary: ;; Commentary:
#lang scheme/base #lang racket/base
(require "base.ss" (require "base.rkt"
"test-suite.ss") "test-suite.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
@ -51,12 +51,12 @@
;; data so FP is a bit ugly]. ;; data so FP is a bit ugly].
(define (foldts fdown fup fhere seed test) (define (foldts fdown fup fhere seed test)
(cond (cond
((schemeunit-test-case? test) ((rktunit-test-case? test)
(fhere test (fhere test
(schemeunit-test-case-name test) (rktunit-test-case-name test)
(schemeunit-test-case-action test) (rktunit-test-case-action test)
seed)) seed))
((schemeunit-test-suite? test) ((rktunit-test-suite? test)
(apply-test-suite test fdown fup fhere seed)) (apply-test-suite test fdown fup fhere seed))
(else (else
(raise (raise

View File

@ -1,10 +1,10 @@
#lang scheme/base #lang racket/base
(require (for-syntax scheme/base) (require (for-syntax racket/base)
"base.ss" "base.rkt"
"format.ss" "format.rkt"
"check-info.ss" "check-info.rkt"
"check.ss") "check.rkt")
(provide current-test-name (provide current-test-name
current-test-case-around current-test-case-around

View File

@ -1,9 +1,9 @@
#lang scheme/base #lang racket/base
(require (for-syntax scheme/base) (require (for-syntax racket/base)
"base.ss" "base.rkt"
"test-case.ss" "test-case.rkt"
"check.ss") "check.rkt")
(provide test-suite (provide test-suite
test-suite-test-case-around test-suite-test-case-around
@ -27,14 +27,14 @@
(define (test-suite-test-case-around fhere) (define (test-suite-test-case-around fhere)
(lambda (thunk) (lambda (thunk)
(let* ([name (current-test-name)] (let* ([name (current-test-name)]
[test (make-schemeunit-test-case name thunk)] [test (make-rktunit-test-case name thunk)]
[seed (current-seed)]) [seed (current-seed)])
(current-seed (fhere test name thunk seed))))) (current-seed (fhere test name thunk seed)))))
(define (test-suite-check-around fhere) (define (test-suite-check-around fhere)
(lambda (thunk) (lambda (thunk)
(let* ([name #f] (let* ([name #f]
[test (make-schemeunit-test-case name thunk)] [test (make-rktunit-test-case name thunk)]
[seed (current-seed)]) [seed (current-seed)])
(current-seed (fhere test name thunk seed))))) (current-seed (fhere test name thunk seed)))))
@ -42,12 +42,12 @@
(define delayed-test-case-around (define delayed-test-case-around
(lambda (thunk) (lambda (thunk)
(let ([name (current-test-name)]) (let ([name (current-test-name)])
(make-schemeunit-test-case name thunk)))) (make-rktunit-test-case name thunk))))
(define delayed-check-around (define delayed-check-around
(lambda (thunk) (lambda (thunk)
(let ([name #f]) (let ([name #f])
(make-schemeunit-test-case name thunk)))) (make-rktunit-test-case name thunk))))
(define-syntax delay-test (define-syntax delay-test
(syntax-rules () (syntax-rules ()
@ -58,12 +58,12 @@
test test1 ...)])) test test1 ...)]))
(define (apply-test-suite suite fdown fup fhere seed) (define (apply-test-suite suite fdown fup fhere seed)
(let* ([name (schemeunit-test-suite-name suite)] (let* ([name (rktunit-test-suite-name suite)]
[tests (schemeunit-test-suite-tests suite)] [tests (rktunit-test-suite-tests suite)]
[before (schemeunit-test-suite-before suite)] [before (rktunit-test-suite-before suite)]
[after (schemeunit-test-suite-after suite)] [after (rktunit-test-suite-after suite)]
[kid-seed (fdown suite name before after seed)] [kid-seed (fdown suite name before after seed)]
[kid-seed ((schemeunit-test-suite-tests suite) fdown fup fhere kid-seed)]) [kid-seed ((rktunit-test-suite-tests suite) fdown fup fhere kid-seed)])
(fup suite name before after seed kid-seed))) (fup suite name before after seed kid-seed)))
;; test-suite : name [#:before thunk] [#:after thunk] test ... ;; test-suite : name [#:before thunk] [#:after thunk] test ...
@ -84,7 +84,7 @@
[the-tests [the-tests
(lambda (fdown fup fhere seed) (lambda (fdown fup fhere seed)
(define (run/inner x) (define (run/inner x)
(cond [(schemeunit-test-suite? x) (cond [(rktunit-test-suite? x)
(current-seed (current-seed
(apply-test-suite x fdown fup fhere (current-seed)))] (apply-test-suite x fdown fup fhere (current-seed)))]
[(list? x) [(list? x)
@ -103,7 +103,7 @@
[(not (string? the-name)) [(not (string? the-name))
(raise-type-error 'test-suite "test-suite name as string" the-name)] (raise-type-error 'test-suite "test-suite name as string" the-name)]
[else [else
(make-schemeunit-test-suite (make-rktunit-test-suite
the-name the-name
the-tests the-tests
before-thunk before-thunk
@ -138,13 +138,13 @@
(for-each (for-each
(lambda (t) (lambda (t)
(cond (cond
[(schemeunit-test-suite? t) [(rktunit-test-suite? t)
(current-seed (apply-test-suite t fdown fup fhere (current-seed)))] (current-seed (apply-test-suite t fdown fup fhere (current-seed)))]
[(schemeunit-test-case? t) [(rktunit-test-case? t)
(current-seed (current-seed
(fhere t (fhere t
(schemeunit-test-case-name t) (rktunit-test-case-name t)
(schemeunit-test-case-action t) (rktunit-test-case-action t)
(current-seed)))] (current-seed)))]
[else [else
(raise (raise
@ -158,7 +158,7 @@
;; ;;
;; Construct a test suite from a list of tests ;; Construct a test suite from a list of tests
(define (make-test-suite name #:before [before void-thunk] #:after [after void-thunk] tests) (define (make-test-suite name #:before [before void-thunk] #:after [after void-thunk] tests)
(make-schemeunit-test-suite name (make-rktunit-test-suite name
(tests->test-suite-action tests) (tests->test-suite-action tests)
before before
after)) after))

View File

@ -1,13 +1,13 @@
#lang scheme/base #lang racket/base
(require (for-syntax scheme/base) (require (for-syntax racket/base)
"base.ss" "base.rkt"
"check.ss" "check.rkt"
"check-info.ss" "check-info.rkt"
"result.ss" "result.rkt"
"test-case.ss" "test-case.rkt"
"test-suite.ss" "test-suite.rkt"
"util.ss") "util.rkt")
(provide (struct-out exn:test:check) (provide (struct-out exn:test:check)
(struct-out check-info) (struct-out check-info)
@ -15,8 +15,8 @@
(struct-out test-failure) (struct-out test-failure)
(struct-out test-error) (struct-out test-error)
(struct-out test-success) (struct-out test-success)
(struct-out schemeunit-test-case) (struct-out rktunit-test-case)
(struct-out schemeunit-test-suite) (struct-out rktunit-test-suite)
with-check-info with-check-info
with-check-info* with-check-info*
@ -42,9 +42,9 @@
test-suite test-suite
make-test-suite make-test-suite
delay-test delay-test
(rename-out [make-schemeunit-test-case make-test-case] (rename-out [make-rktunit-test-case make-test-case]
[schemeunit-test-case? test-case?] [rktunit-test-case? test-case?]
[schemeunit-test-suite? test-suite?]) [rktunit-test-suite? test-suite?])
define-test-suite define-test-suite
define/provide-test-suite define/provide-test-suite

View File

@ -26,7 +26,7 @@
;; ;;
;; Commentary: ;; Commentary:
#lang scheme/base #lang racket/base
(require (only-in srfi/13 string-contains string-drop)) (require (only-in srfi/13 string-contains string-drop))

View File

@ -26,13 +26,13 @@
;; ;;
;; Commentary: ;; Commentary:
#lang scheme/base #lang racket/base
(require (for-syntax scheme/base) (require (for-syntax racket/base)
mzlib/etc mzlib/etc
"check.ss" "check.rkt"
"test-suite.ss" "test-suite.rkt"
"test-case.ss") "test-case.rkt")
(provide require/expose (provide require/expose
test-suite* test-suite*
@ -41,7 +41,7 @@
;; Requires a module and exposes some of its unprovided ;; Requires a module and exposes some of its unprovided
;; (non-syntax!) identifiers. ;; (non-syntax!) identifiers.
;; USAGE: (require/expose MODULE-NAME (IDS ...)) ;; USAGE: (require/expose MODULE-NAME (IDS ...))
;; where MODULE-NAME is as in the MzScheme manual (i.e., ;; where MODULE-NAME is as in the MzRacket manual (i.e.,
;; a standard module spec) and IDS are the un-provided ;; a standard module spec) and IDS are the un-provided
;; identifiers that you wish to expose in the current ;; identifiers that you wish to expose in the current
;; module. ;; module.

View File

@ -1,18 +1,18 @@
#lang scribble/doc #lang scribble/doc
@(require "base.ss") @(require "base.rkt")
@title{Acknowlegements} @title{Acknowlegements}
The following people have contributed to SchemeUnit: The following people have contributed to RktUnit:
@itemize[ @itemize[
@item{Robby Findler pushed me to release version 3} @item{Robby Findler pushed me to release version 3}
@item{Matt Jadud and his students at Olin College @item{Matt Jadud and his students at Olin College
suggested renaming @scheme[test/text-ui]} suggested renaming @racket[test/text-ui]}
@item{Dave Gurnell reported a bug in check-not-exn and @item{Dave Gurnell reported a bug in check-not-exn and
suggested improvements to SchemeUnit} suggested improvements to RktUnit}
@item{Danny Yoo reported a bug in and provided a fix for @item{Danny Yoo reported a bug in and provided a fix for
trim-current-directory} trim-current-directory}
@ -30,15 +30,15 @@ The following people have contributed to SchemeUnit:
@item{Jose A. Ortega Ruiz alerted me a problem in the @item{Jose A. Ortega Ruiz alerted me a problem in the
packaging system and helped fix it.} packaging system and helped fix it.}
@item{Sebastian H. Seidel provided help packaging SchemeUnit @item{Sebastian H. Seidel provided help packaging RktUnit
into a .plt} into a .plt}
@item{Don Blaheta provided the method for grabbing line number @item{Don Blaheta provided the method for grabbing line number
and file name in checks} and file name in checks}
@item{Patrick Logan ported example.ss to version 1.3} @item{Patrick Logan ported example.rkt to version 1.3}
@item{The PLT team made PLT Scheme} @item{The PLT team made Racket}
@item{The Extreme Programming community started the whole @item{The Extreme Programming community started the whole
testing framework thing} testing framework thing}

View File

@ -1,10 +1,10 @@
#lang scribble/doc #lang scribble/doc
@(require "base.ss") @(require "base.rkt")
@title[#:tag "api"]{SchemeUnit API} @title[#:tag "api"]{RktUnit API}
@defmodule[schemeunit @defmodule[rktunit
#:use-sources (schemeunit)] #:use-sources (rktunit)]
@include-section["overview.scrbl"] @include-section["overview.scrbl"]
@include-section["check.scrbl"] @include-section["check.scrbl"]

View File

@ -6,15 +6,15 @@
(for-label scheme/base (for-label scheme/base
scheme/contract scheme/contract
schemeunit rktunit
schemeunit/text-ui rktunit/text-ui
schemeunit/gui)) rktunit/gui))
(provide (provide
(all-from-out scribble/eval (all-from-out scribble/eval
scribble/manual) scribble/manual)
(for-label (all-from-out scheme/base (for-label (all-from-out scheme/base
scheme/contract scheme/contract
schemeunit rktunit
schemeunit/text-ui rktunit/text-ui
schemeunit/gui))) rktunit/gui)))

View File

@ -1,12 +1,12 @@
#lang scribble/doc #lang scribble/doc
@(require "base.ss") @(require "base.rkt")
@title{Checks} @title{Checks}
Checks are the basic building block of SchemeUnit. A check Checks are the basic building block of RktUnit. A check
checks some condition. If the condition holds the check checks some condition. If the condition holds the check
evaluates to @scheme[#t]. If the condition doesn't hold the evaluates to @racket[#t]. If the condition doesn't hold the
check raises an instance of @scheme[exn:test:check] with check raises an instance of @racket[exn:test:check] with
information detailing the failure. information detailing the failure.
Although checks are implemented as macros, which is Although checks are implemented as macros, which is
@ -16,8 +16,8 @@ their arguments. You can use check as first class
functions, though you will lose precision in the reported functions, though you will lose precision in the reported
source locations if you do so. source locations if you do so.
The following are the basic checks SchemeUnit provides. You The following are the basic checks RktUnit provides. You
can create your own checks using @scheme[define-check]. can create your own checks using @racket[define-check].
@defproc[(check (op (-> any any any)) @defproc[(check (op (-> any any any))
(v1 any) (v1 any)
@ -25,11 +25,11 @@ can create your own checks using @scheme[define-check].
(message string? "")) (message string? ""))
any]{ any]{
The simplest check. Succeeds if @scheme[op] applied to @scheme[v1] and @scheme[v2] is not @scheme[#f], otherwise raises an exception of type @scheme[exn:test:check]. The optional @scheme[message] is included in the output if the check fails. If the check succeeds, the value returned by @scheme[op] is the value returned by the check.} The simplest check. Succeeds if @racket[op] applied to @racket[v1] and @racket[v2] is not @racket[#f], otherwise raises an exception of type @racket[exn:test:check]. The optional @racket[message] is included in the output if the check fails. If the check succeeds, the value returned by @racket[op] is the value returned by the check.}
For example, the following check succeeds: For example, the following check succeeds:
@schemeblock[ @racketblock[
(check < 2 3) (check < 2 3)
] ]
@ -39,14 +39,14 @@ For example, the following check succeeds:
[(check-equal? (v1 any) (v2 any) (message string? "")) #t] [(check-equal? (v1 any) (v2 any) (message string? "")) #t]
[(check-not-equal? (v1 any) (v2 any) (message string? "")) #t])]{ [(check-not-equal? (v1 any) (v2 any) (message string? "")) #t])]{
Checks that @scheme[v1] is (not) @scheme[eq?], Checks that @racket[v1] is (not) @racket[eq?],
@scheme[eqv?], or @scheme[equal?] to @scheme[v2]. The @racket[eqv?], or @racket[equal?] to @racket[v2]. The
optional @scheme[message] is included in the output if the optional @racket[message] is included in the output if the
check fails.} check fails.}
For example, the following checks all fail: For example, the following checks all fail:
@schemeblock[ @racketblock[
(check-eq? (list 1) (list 1) "allocated data not eq?") (check-eq? (list 1) (list 1) "allocated data not eq?")
(check-not-eq? 1 1 "integers are eq?") (check-not-eq? 1 1 "integers are eq?")
(check-eqv? 1 1.0 "not eqv?") (check-eqv? 1 1.0 "not eqv?")
@ -55,11 +55,11 @@ For example, the following checks all fail:
] ]
@defproc[(check-pred (pred (-> any any)) (v any) (message string? "")) @defproc[(check-pred (pred (-> any any)) (v any) (message string? ""))
#t]{Checks that @scheme[pred] returns a value that is not @scheme[#f] when applied to @scheme[v]. The optional @scheme[message] is included in the output if the check fails. The value returned by a successful check is the value returned by @scheme[pred].} #t]{Checks that @racket[pred] returns a value that is not @racket[#f] when applied to @racket[v]. The optional @racket[message] is included in the output if the check fails. The value returned by a successful check is the value returned by @racket[pred].}
Here's an example that passes and an example that fails: Here's an example that passes and an example that fails:
@schemeblock[ @racketblock[
(check-pred string? "I work") (check-pred string? "I work")
(check-pred number? "I fail") (check-pred number? "I fail")
] ]
@ -67,14 +67,14 @@ Here's an example that passes and an example that fails:
@defproc[(check-= (v1 any) (v2 any) (epsilon number?) (message string? "")) #t]{ @defproc[(check-= (v1 any) (v2 any) (epsilon number?) (message string? "")) #t]{
Checks that @scheme[v1] and @scheme[v2] are within Checks that @racket[v1] and @racket[v2] are within
@scheme[epsilon] of one another. The optional @racket[epsilon] of one another. The optional
@scheme[message] is included in the output if the check @racket[message] is included in the output if the check
fails.} fails.}
Here's an example that passes and an example that fails: Here's an example that passes and an example that fails:
@schemeblock[ @racketblock[
(check-= 1.0 1.01 0.01 "I work") (check-= 1.0 1.01 0.01 "I work")
(check-= 1.0 1.01 0.005 "I fail") (check-= 1.0 1.01 0.005 "I fail")
] ]
@ -83,13 +83,13 @@ Here's an example that passes and an example that fails:
[(check-false (v any) (message string? "")) #t] [(check-false (v any) (message string? "")) #t]
[(check-not-false (v any) (message string? "")) #t])]{ [(check-not-false (v any) (message string? "")) #t])]{
Checks that @scheme[v] is @scheme[#t], @scheme[#f], or not Checks that @racket[v] is @racket[#t], @racket[#f], or not
@scheme[#f] as appropriate. The optional @scheme[message] @racket[#f] as appropriate. The optional @racket[message]
is included in the output if the check fails.} is included in the output if the check fails.}
For example, the following checks all fail: For example, the following checks all fail:
@schemeblock[ @racketblock[
(check-true 1) (check-true 1)
(check-false 1) (check-false 1)
(check-not-false #f) (check-not-false #f)
@ -99,16 +99,16 @@ For example, the following checks all fail:
@defproc[(check-exn (exn-predicate (-> any (or/c #t #f))) (thunk (-> any)) (message string? "")) @defproc[(check-exn (exn-predicate (-> any (or/c #t #f))) (thunk (-> any)) (message string? ""))
#t]{ #t]{
Checks that @scheme[thunk] raises an exception for which Checks that @racket[thunk] raises an exception for which
@scheme[exn-predicate] returns @scheme[#t]. The optional @racket[exn-predicate] returns @racket[#t]. The optional
@scheme[message] is included in the output if the check @racket[message] is included in the output if the check
fails. A common error is to use an expression instead of a fails. A common error is to use an expression instead of a
function of no arguments for @scheme[thunk]. Remember that function of no arguments for @racket[thunk]. Remember that
checks are conceptually functions.} checks are conceptually functions.}
Here are two example, one showing a test that succeeds, and one showing a common error: Here are two example, one showing a test that succeeds, and one showing a common error:
@schemeblock[ @racketblock[
(check-exn exn? (check-exn exn?
(lambda () (lambda ()
(raise (make-exn "Hi there" (raise (make-exn "Hi there"
@ -121,22 +121,22 @@ Here are two example, one showing a test that succeeds, and one showing a common
@defproc[(check-not-exn (thunk (-> any)) (message string? "")) #t]{ @defproc[(check-not-exn (thunk (-> any)) (message string? "")) #t]{
Checks that @scheme[thunk] does not raise any exceptions. Checks that @racket[thunk] does not raise any exceptions.
The optional @scheme[message] is included in the output if The optional @racket[message] is included in the output if
the check fails.} the check fails.}
@defproc[(fail (message string? "")) #t]{This checks fails unconditionally. Good for creating test stubs that youintend to fill out later. The optional @scheme[message] is included in the output if the check fails.} @defproc[(fail (message string? "")) #t]{This checks fails unconditionally. Good for creating test stubs that youintend to fill out later. The optional @racket[message] is included in the output if the check fails.}
@defproc[(check-regexp-match (regexp regexp?) (string string?)) #t]{Checks that @scheme[regexp] matches the @scheme[string].} @defproc[(check-regexp-match (regexp regexp?) (string string?)) #t]{Checks that @racket[regexp] matches the @racket[string].}
The following check will succeed: The following check will succeed:
@schemeblock[(check-regexp-match "a+bba" "aaaaaabba")] @racketblock[(check-regexp-match "a+bba" "aaaaaabba")]
This check will fail: This check will fail:
@schemeblock[(check-regexp-match "a+bba" "aaaabbba")] @racketblock[(check-regexp-match "a+bba" "aaaabbba")]
@ -146,8 +146,8 @@ When an check fails it stores information including the name
of the check, the location and message (if available), the of the check, the location and message (if available), the
expression the check is called with, and the parameters to expression the check is called with, and the parameters to
the check. Additional information can be stored by using the check. Additional information can be stored by using
the @scheme[with-check-info*] function, and the the @racket[with-check-info*] function, and the
@scheme[with-check-info] macro. @racket[with-check-info] macro.
@defstruct[check-info ([name symbol?] [value any])]{ @defstruct[check-info ([name symbol?] [value any])]{
@ -170,13 +170,13 @@ misspelling errors:
@defproc[(with-check-info* (info (listof check-info?)) (thunk (-> any))) any]{ @defproc[(with-check-info* (info (listof check-info?)) (thunk (-> any))) any]{
Stores the given @scheme[info] on the check-info stack for Stores the given @racket[info] on the check-info stack for
the duration (the dynamic extent) of the execution of the duration (the dynamic extent) of the execution of
@scheme[thunk]} @racket[thunk]}
Example: Example:
@schemeblock[ @racketblock[
(with-check-info* (with-check-info*
(list (make-check-info 'time (current-seconds))) (list (make-check-info 'time (current-seconds)))
(lambda () (check = 1 2))) (lambda () (check = 1 2)))
@ -191,14 +191,14 @@ check failure.
@defform[(with-check-info ((name val) ...) body ...)]{ @defform[(with-check-info ((name val) ...) body ...)]{
The @scheme[with-check-info] macro stores the given The @racket[with-check-info] macro stores the given
information in the check information stack for the duration information in the check information stack for the duration
of the execution of the body expressions. @scheme[Name] is of the execution of the body expressions. @racket[Name] is
a quoted symbol and @scheme[val] is any value.} a quoted symbol and @racket[val] is any value.}
Example: Example:
@schemeblock[ @racketblock[
(for-each (for-each
(lambda (elt) (lambda (elt)
(with-check-info (with-check-info
@ -218,7 +218,7 @@ check failure.
@section{Custom Checks} @section{Custom Checks}
Custom checks can be defined using @scheme[define-check] and Custom checks can be defined using @racket[define-check] and
its variants. To effectively use these macros it is useful its variants. To effectively use these macros it is useful
to understand a few details about a check's evaluation to understand a few details about a check's evaluation
model. model.
@ -229,17 +229,17 @@ always evaluate their arguments exactly once before
executing any expressions in the body of the checks. Hence executing any expressions in the body of the checks. Hence
if you wish to write checks that evalute user defined code if you wish to write checks that evalute user defined code
that code must be wrapped in a thunk (a function of no that code must be wrapped in a thunk (a function of no
arguments) by the user. The predefined @scheme[check-exn] arguments) by the user. The predefined @racket[check-exn]
is an example of this type of check. is an example of this type of check.
It is also useful to understand how the check information It is also useful to understand how the check information
stack operates. The stack is stored in a parameter and the stack operates. The stack is stored in a parameter and the
@scheme[with-check-info] forms evaluate to calls to @racket[with-check-info] forms evaluate to calls to
@scheme[parameterize]. Hence check information has lexical @racket[parameterize]. Hence check information has lexical
scope. For this reason simple checks (see below) cannot scope. For this reason simple checks (see below) cannot
usefully contain calls to @scheme[with-check-info] to report usefully contain calls to @racket[with-check-info] to report
additional information. All checks created using additional information. All checks created using
@scheme[define-simple-check] or @scheme[define-check] grab @racket[define-simple-check] or @racket[define-check] grab
some information by default: the name of the checks and the some information by default: the name of the checks and the
values of the parameters. Additionally the macro forms of values of the parameters. Additionally the macro forms of
checks grab location information and the expressions passed checks grab location information and the expressions passed
@ -247,26 +247,26 @@ as parameters.
@defform[(define-simple-check (name param ...) expr ...)]{ @defform[(define-simple-check (name param ...) expr ...)]{
The @scheme[define-simple-check] macro constructs a check The @racket[define-simple-check] macro constructs a check
called @scheme[name] that takes the params and an optional called @racket[name] that takes the params and an optional
message as arguments and evaluates the @scheme[expr]s. The message as arguments and evaluates the @racket[expr]s. The
check fails if the result of the @scheme[expr]s is check fails if the result of the @racket[expr]s is
@scheme[#f]. Otherwise the check succeeds. Note that @racket[#f]. Otherwise the check succeeds. Note that
simple checks cannot report extra information using simple checks cannot report extra information using
@scheme[with-check-info].} @racket[with-check-info].}
Example: Example:
To define a check @scheme[check-odd?] To define a check @racket[check-odd?]
@schemeblock[ @racketblock[
(define-simple-check (check-odd? number) (define-simple-check (check-odd? number)
(odd? number)) (odd? number))
] ]
We can use these checks in the usual way: We can use these checks in the usual way:
@schemeblock[ @racketblock[
(check-odd? 3) (code:comment "Success") (check-odd? 3) (code:comment "Success")
(check-odd? 2) (code:comment "Failure") (check-odd? 2) (code:comment "Failure")
] ]
@ -274,12 +274,12 @@ We can use these checks in the usual way:
@defform*[[(define-binary-check (name pred actual expected)) @defform*[[(define-binary-check (name pred actual expected))
(define-binary-check (name actual expected) expr ...)]]{ (define-binary-check (name actual expected) expr ...)]]{
The @scheme[define-binary-check] macro constructs a check The @racket[define-binary-check] macro constructs a check
that tests a binary predicate. It's benefit over that tests a binary predicate. It's benefit over
@scheme[define-simple-check] is in better reporting on check @racket[define-simple-check] is in better reporting on check
failure. The first form of the macro accepts a binary failure. The first form of the macro accepts a binary
predicate and tests if the predicate holds for the given predicate and tests if the predicate holds for the given
values. The second form tests if @scheme[expr] non-false. values. The second form tests if @racket[expr] non-false.
} }
Examples: Examples:
@ -287,13 +287,13 @@ Examples:
Here's the first form, where we use a predefined predicate Here's the first form, where we use a predefined predicate
to construct a binary check: to construct a binary check:
@schemeblock[ @racketblock[
(define-binary-check (check-char=? char=? actual expected)) (define-binary-check (check-char=? char=? actual expected))
] ]
In use: In use:
@schemeblock[ @racketblock[
(check-char=? (read-char a-port) #\a) (check-char=? (read-char a-port) #\a)
] ]
@ -301,7 +301,7 @@ If the expression is more complicated the second form should
be used. For example, below we define a binary check that be used. For example, below we define a binary check that
tests a number if within 0.01 of the expected value: tests a number if within 0.01 of the expected value:
@schemeblock[ @racketblock[
(define-binary-check (check-in-tolerance actual expected) (define-binary-check (check-in-tolerance actual expected)
(< (abs (- actual expected)) 0.01)) (< (abs (- actual expected)) 0.01))
] ]
@ -309,22 +309,22 @@ tests a number if within 0.01 of the expected value:
@defform[(define-check (name param ...) expr ...)]{ @defform[(define-check (name param ...) expr ...)]{
The @scheme[define-check] macro acts in exactly the same way The @racket[define-check] macro acts in exactly the same way
as @scheme[define-simple-check], except the check only fails as @racket[define-simple-check], except the check only fails
if the macro @scheme[fail-check] is called in the body of if the macro @racket[fail-check] is called in the body of
the check. This allows more flexible checks, and in the check. This allows more flexible checks, and in
particular more flexible reporting options.} particular more flexible reporting options.}
@defform[(fail-check)]{The @scheme[fail-check] macro raises an @scheme[exn:test:check] with @defform[(fail-check)]{The @racket[fail-check] macro raises an @racket[exn:test:check] with
the contents of the check information stack.} the contents of the check information stack.}
@section{The Check Evaluation Context} @section{The Check Evaluation Context}
The semantics of checks are determined by the parameters The semantics of checks are determined by the parameters
@scheme[current-check-around] and @racket[current-check-around] and
@scheme[current-check-handler]. Other testing form such as @racket[current-check-handler]. Other testing form such as
@scheme[test-begin] and @scheme[test-suite] change the value @racket[test-begin] and @racket[test-suite] change the value
of these parameters. of these parameters.
@defparam[current-check-handler handler (-> any/c any/c)]{ @defparam[current-check-handler handler (-> any/c any/c)]{
@ -338,8 +338,8 @@ trace. }
Parameter containing the function that handles the execution Parameter containing the function that handles the execution
of checks. The default value wraps the evaluation of of checks. The default value wraps the evaluation of
@scheme[thunk] in a @scheme[with-handlers] call that calls @racket[thunk] in a @racket[with-handlers] call that calls
@scheme[current-check-handler] if an exception is raised and then @racket[current-check-handler] if an exception is raised and then
(when an exception is not raised) discards the result, returning (when an exception is not raised) discards the result, returning
@scheme[(void)]. @racket[(void)].
} }

View File

@ -1,5 +1,5 @@
#lang scribble/doc #lang scribble/doc
@(require "base.ss") @(require "base.rkt")
@title{Compound Testing Forms} @title{Compound Testing Forms}
@ -15,14 +15,14 @@ will not be evaluated.
@defform[(test-begin expr ...)]{ @defform[(test-begin expr ...)]{
A @scheme[test-begin] form groups the @scheme[expr]s into a A @racket[test-begin] form groups the @racket[expr]s into a
single unit. If any @scheme[expr] fails the following ones single unit. If any @racket[expr] fails the following ones
are not evaluated. } are not evaluated. }
For example, in the following code the world is not For example, in the following code the world is not
destroyed as the preceding check fails: destroyed as the preceding check fails:
@schemeblock[ @racketblock[
(test-begin (test-begin
(check-eq? 'a 'b) (check-eq? 'a 'b)
(code:comment "This line won't be run") (code:comment "This line won't be run")
@ -31,14 +31,14 @@ destroyed as the preceding check fails:
@defform[(test-case name expr ...)]{ @defform[(test-case name expr ...)]{
Like a @scheme[test-begin] except a name is associated with Like a @racket[test-begin] except a name is associated with
the group of @scheme[expr]s. The name will be reported if the group of @racket[expr]s. The name will be reported if
the test fails. } the test fails. }
Here's the above example rewritten to use @scheme[test-case] Here's the above example rewritten to use @racket[test-case]
so the test can be named. so the test can be named.
@schemeblock[ @racketblock[
(test-case (test-case
"Example test" "Example test"
(check-eq? 'a 'b) (check-eq? 'a 'b)
@ -48,7 +48,7 @@ so the test can be named.
@defproc[(test-case? (obj any)) boolean?]{ @defproc[(test-case? (obj any)) boolean?]{
True if @scheme[obj] is a test case, and false otherwise True if @racket[obj] is a test case, and false otherwise
} }
@ -69,10 +69,10 @@ run. Instead use one of the functions described in
#:contracts ([name-expr string?])]{ #:contracts ([name-expr string?])]{
Constructs a test suite with the given name and tests. The Constructs a test suite with the given name and tests. The
tests may be test cases, constructed using @scheme[test-begin] or tests may be test cases, constructed using @racket[test-begin] or
@scheme[test-case], or other test suites. @racket[test-case], or other test suites.
The @scheme[before-thunk] and @scheme[after-thunk] are The @racket[before-thunk] and @racket[after-thunk] are
optional thunks (functions with no argument). They are run optional thunks (functions with no argument). They are run
before and after the tests are run, respectively. before and after the tests are run, respectively.
@ -84,7 +84,7 @@ For example, here is a test suite that displays @tt{Before}
before any tests are run, and @tt{After} when the tests have before any tests are run, and @tt{After} when the tests have
finished. finished.
@schemeblock[ @racketblock[
(test-suite (test-suite
"An example suite" "An example suite"
#:before (lambda () (display "Before")) #:before (lambda () (display "Before"))
@ -103,13 +103,13 @@ finished.
[#:after after-thunk (-> any) void]) [#:after after-thunk (-> any) void])
test-suite?]{ test-suite?]{
Constructs a test suite with the given @scheme[name] containing the Constructs a test suite with the given @racket[name] containing the
given @scheme[tests]. Unlike the @scheme[test-suite] form, the tests given @racket[tests]. Unlike the @racket[test-suite] form, the tests
are represented as a list of test values. are represented as a list of test values.
} }
@defproc[(test-suite? (obj any)) boolean?]{ True if @defproc[(test-suite? (obj any)) boolean?]{ True if
@scheme[obj] is a test suite, and false otherwise} @racket[obj] is a test suite, and false otherwise}
@ -119,25 +119,25 @@ There are some macros that simplify the common cases of
defining test suites: defining test suites:
@defform[(define-test-suite name test ...)]{ The @defform[(define-test-suite name test ...)]{ The
@scheme[define-test-suite] form creates a test suite with @racket[define-test-suite] form creates a test suite with
the given name (converted to a string) and tests, and binds the given name (converted to a string) and tests, and binds
it to the same name.} it to the same name.}
For example, this code creates a binding for the name For example, this code creates a binding for the name
@scheme[example-suite] as well as creating a test suite with @racket[example-suite] as well as creating a test suite with
the name @scheme["example-suite"]: the name @racket["example-suite"]:
@schemeblock[ @racketblock[
(define-test-suite example-suite (define-test-suite example-suite
(check = 1 1)) (check = 1 1))
] ]
@defform[(define/provide-test-suite name test ...)]{ This @defform[(define/provide-test-suite name test ...)]{ This
for is just like @scheme[define-test-suite], and in addition for is just like @racket[define-test-suite], and in addition
it @scheme[provide]s the test suite.} it @racket[provide]s the test suite.}
@;{ @;{
Finally, there is the @scheme[test-suite*] macro, which Finally, there is the @racket[test-suite*] macro, which
defines a test suite and test cases using a shorthand defines a test suite and test cases using a shorthand
syntax: syntax:
@ -147,7 +147,7 @@ creates test cases within the suite, with the given names and
body expressions. body expressions.
As far I know no-one uses this macro, so it might disappear As far I know no-one uses this macro, so it might disappear
in future versions of SchemeUnit.} in future versions of RktUnit.}
} }
@ -159,8 +159,8 @@ control the semantics of compound testing forms.
@defparam[current-test-name name (or/c string? false/c)]{ @defparam[current-test-name name (or/c string? false/c)]{
This parameter stores the name of the current test case. A This parameter stores the name of the current test case. A
value of @scheme[#f] indicates a test case with no name, value of @racket[#f] indicates a test case with no name,
such as one constructed by @scheme[test-begin]. } such as one constructed by @racket[test-begin]. }
@defparam[current-test-case-around handler (-> (-> any/c) any/c)]{ @defparam[current-test-case-around handler (-> (-> any/c) any/c)]{
@ -168,20 +168,20 @@ This parameter handles evaluation of test cases. The value
of the parameter is a function that is passed a thunk (a of the parameter is a function that is passed a thunk (a
function of no arguments). The function, when applied, function of no arguments). The function, when applied,
evaluates the expressions within a test case. The default evaluates the expressions within a test case. The default
value of the @scheme[current-test-case-around] parameters value of the @racket[current-test-case-around] parameters
evaluates the thunk in a context that catches exceptions and evaluates the thunk in a context that catches exceptions and
prints an appropriate message indicating test case failure.} prints an appropriate message indicating test case failure.}
@defproc[(test-suite-test-case-around [thunk (-> any/c)]) any/c]{ @defproc[(test-suite-test-case-around [thunk (-> any/c)]) any/c]{
The @scheme[current-test-case-around] parameter is The @racket[current-test-case-around] parameter is
parameterized to this value within the scope of a parameterized to this value within the scope of a
@scheme[test-suite]. This function creates a test case @racket[test-suite]. This function creates a test case
structure instead of immediately evaluating the thunk.} structure instead of immediately evaluating the thunk.}
@defproc[(test-suite-check-around [thunk (-> any/c)]) any/c]{ @defproc[(test-suite-check-around [thunk (-> any/c)]) any/c]{
The @scheme[current-check-around] parameter is parameterized The @racket[current-check-around] parameter is parameterized
to this value within the scope of a @scheme[test-suite]. to this value within the scope of a @racket[test-suite].
This function creates a test case structure instead of This function creates a test case structure instead of
immediately evaluating a check.} immediately evaluating a check.}

View File

@ -1,28 +1,28 @@
#lang scribble/doc #lang scribble/doc
@(require "base.ss") @(require "base.rkt")
@title{Test Control Flow} @title{Test Control Flow}
The @scheme[before], @scheme[after], and @scheme[around] The @racket[before], @racket[after], and @racket[around]
macros allow you to specify code that is always run before, macros allow you to specify code that is always run before,
after, or around expressions in a test case. after, or around expressions in a test case.
@defform[(before before-expr expr1 expr2 ...)]{ @defform[(before before-expr expr1 expr2 ...)]{
Whenever control enters the scope execute the @scheme[before-expr] Whenever control enters the scope execute the @racket[before-expr]
before executing @scheme[expr-1], and @scheme[expr-2 ...]} before executing @racket[expr-1], and @racket[expr-2 ...]}
@defform[(after expr-1 expr-2 ... after-expr)]{ @defform[(after expr-1 expr-2 ... after-expr)]{
Whenever control exits the scope execute the @scheme[after-expr] Whenever control exits the scope execute the @racket[after-expr]
after executing @scheme[expr-1], and @scheme[expr-2 ...] The @scheme[after-expr] is after executing @racket[expr-1], and @racket[expr-2 ...] The @racket[after-expr] is
executed even if control exits via an exception or other means.} executed even if control exits via an exception or other means.}
@defform[(around before-expr expr-1 expr-2 ... after-expr)]{ @defform[(around before-expr expr-1 expr-2 ... after-expr)]{
Whenever control enters the scope execute the Whenever control enters the scope execute the
@scheme[before-expr] before executing @scheme[expr-1 expr-2 @racket[before-expr] before executing @racket[expr-1 expr-2
...], and execute @scheme[after-expr] whenever control ...], and execute @racket[after-expr] whenever control
leaves the scope.} leaves the scope.}
Example: Example:
@ -31,7 +31,7 @@ The test below checks that the file @tt{test.dat} contains
the string @tt{"foo"}. The before action writes to this the string @tt{"foo"}. The before action writes to this
file. The after action deletes it. file. The after action deletes it.
@schemeblock[ @racketblock[
(around (around
(with-output-to-file "test.dat" (with-output-to-file "test.dat"
(lambda () (lambda ()
@ -46,7 +46,7 @@ file. The after action deletes it.
@defform[(delay-test test1 test2 ...)]{ @defform[(delay-test test1 test2 ...)]{
This somewhat curious macro evaluates the given tests in a This somewhat curious macro evaluates the given tests in a
context where @scheme[current-test-case-around] is context where @racket[current-test-case-around] is
parameterized to @scheme[test-suite-test-case-around]. This parameterized to @racket[test-suite-test-case-around]. This
has been useful in testing SchemeUnit. It might be useful has been useful in testing RktUnit. It might be useful
for you if you create test cases that create test cases.} for you if you create test cases that create test cases.}

View File

@ -1,7 +1,7 @@
#lang scheme/base #lang scheme/base
(require schemeunit (require rktunit
"file.scm") "file.rkt")
(check-equal? (my-+ 1 1) 2) (check-equal? (my-+ 1 1) 2)
(check-equal? (my-* 1 2) 2) (check-equal? (my-* 1 2) 2)

View File

@ -0,0 +1,21 @@
#lang scribble/doc
@(require "base.rkt")
@title{Miscellaneous Utilities}
The @racket[require/expose] macro allows you to access
bindings that a module does not provide. It is useful for
testing the private functions of modules.
@defform[(require/expose module (id ...))]{
Requires @racket[id] from @racket[module] into the current module. It doesn't matter if the source module provides the bindings or not; @racket[require/expose] can still get at them.
Note that @racket[require/expose] can be a bit fragile,
especially when mixed with compiled code. Use at your own risk!
}
This example gets @racket[make-failure-test], which is defined in a RktUnit test:
@racketblock[
(require/expose rktunit/private/check-test (make-failure-test))
]

View File

@ -1,9 +1,9 @@
#lang scribble/doc #lang scribble/doc
@(require "base.ss") @(require "base.rkt")
@title{Overview of SchemeUnit} @title{Overview of RktUnit}
There are three basic data types in SchemeUnit: There are three basic data types in RktUnit:
@itemize[ @itemize[

View File

@ -1,10 +1,10 @@
#lang scribble/doc #lang scribble/doc
@(require "base.ss") @(require "base.rkt")
@title[#:tag "philosophy"]{The Philosophy of SchemeUnit} @title[#:tag "philosophy"]{The Philosophy of RktUnit}
SchemeUnit is designed to allow tests to evolve in step with RktUnit is designed to allow tests to evolve in step with
the evolution of the program under testing. SchemeUnit the evolution of the program under testing. RktUnit
scales from the unstructed checks suitable for simple scales from the unstructed checks suitable for simple
programs to the complex structure necessary for large programs to the complex structure necessary for large
projects. projects.
@ -19,23 +19,23 @@ For example, a HtDP student may be writing simple list
functions such as length, and the properties they are functions such as length, and the properties they are
checking are of the form: checking are of the form:
@schemeblock[ @racketblock[
(equal? (length null) 0) (equal? (length null) 0)
(equal? (length '(a)) 1) (equal? (length '(a)) 1)
(equal? (length '(a b)) 2) (equal? (length '(a b)) 2)
] ]
SchemeUnit directly supports this style of testing. A check RktUnit directly supports this style of testing. A check
on its own is a valid test. So the above examples may be on its own is a valid test. So the above examples may be
written in SchemeUnit as: written in RktUnit as:
@schemeblock[ @racketblock[
(check-equal? (length null) 0) (check-equal? (length null) 0)
(check-equal? (length '(a)) 1) (check-equal? (length '(a)) 1)
(check-equal? (length '(a b)) 2) (check-equal? (length '(a b)) 2)
] ]
Simple programs now get all the benefits of SchemeUnit with Simple programs now get all the benefits of RktUnit with
very little overhead. very little overhead.
There are limitations to this style of testing that more There are limitations to this style of testing that more
@ -45,31 +45,31 @@ it does not make sense to evaluate some expressions if
earlier ones have failed. This type of program needs a way earlier ones have failed. This type of program needs a way
to group expressions so that a failure in one group causes to group expressions so that a failure in one group causes
evaluation of that group to stop and immediately proceed to evaluation of that group to stop and immediately proceed to
the next group. In SchemeUnit all that is required is to the next group. In RktUnit all that is required is to
wrap a @scheme[test-begin] expression around a group of wrap a @racket[test-begin] expression around a group of
expressions: expressions:
@schemeblock[ @racketblock[
(test-begin (test-begin
(setup-some-state!) (setup-some-state!)
(check-equal? (foo! 1) 'expected-value-1) (check-equal? (foo! 1) 'expected-value-1)
(check-equal? (foo! 2) 'expected-value-2)) (check-equal? (foo! 2) 'expected-value-2))
] ]
Now if any expression within the @scheme[test-begin] Now if any expression within the @racket[test-begin]
expression fails no further expressions in that group will expression fails no further expressions in that group will
be evaluated. be evaluated.
Notice that all the previous tests written in the simple Notice that all the previous tests written in the simple
style are still valid. Introducing grouping is a local style are still valid. Introducing grouping is a local
change only. This is a key feature of SchemeUnit's support change only. This is a key feature of RktUnit's support
for the evolution of the program. for the evolution of the program.
The programmer may wish to name a group of tests. This is The programmer may wish to name a group of tests. This is
done using the @scheme[test-case] expression, a simple done using the @racket[test-case] expression, a simple
variant on test-begin: variant on test-begin:
@schemeblock[ @racketblock[
(test-case (test-case
"The name" "The name"
... test expressions ...) ... test expressions ...)
@ -79,7 +79,7 @@ Most programs will stick with this style. However,
programmers writing very complex programs may wish to programmers writing very complex programs may wish to
maintain separate groups of tests for different parts of the maintain separate groups of tests for different parts of the
program, or run their tests in different ways to the normal program, or run their tests in different ways to the normal
SchemeUnit manner (for example, test results may be logged RktUnit manner (for example, test results may be logged
for the purpose of improving software quality, or they may for the purpose of improving software quality, or they may
be displayed on a website to indicate service quality). For be displayed on a website to indicate service quality). For
these programmers it is necessary to delay the execution of these programmers it is necessary to delay the execution of
@ -87,7 +87,7 @@ tests so they can processed in the programmer's chosen
manner. To do this, the programmer simply wraps a test-suite manner. To do this, the programmer simply wraps a test-suite
around their tests: around their tests:
@schemeblock[ @racketblock[
(test-suite (test-suite
"Suite name" "Suite name"
(check ...) (check ...)
@ -104,15 +104,15 @@ outside the suite continue to evaluate as before.
@section{Historical Context} @section{Historical Context}
Most testing frameworks, including earlier versions of Most testing frameworks, including earlier versions of
SchemeUnit, support only the final form of testing. This is RktUnit, support only the final form of testing. This is
likely due to the influence of the SUnit testing framework, likely due to the influence of the SUnit testing framework,
which is the ancestor of SchemeUnit and the most widely used which is the ancestor of RktUnit and the most widely used
frameworks in Java, .Net, Python, and Ruby, and many other frameworks in Java, .Net, Python, and Ruby, and many other
languages. That this is insufficient for all users is languages. That this is insufficient for all users is
apparent if one considers the proliferation of ``simpler'' apparent if one considers the proliferation of ``simpler''
testing frameworks in Scheme such as SRFI-78, or the testing frameworks in Racket such as SRFI-78, or the
practice of beginner programmers. Unfortunately these practice of beginner programmers. Unfortunately these
simpler methods are inadequate for testing larger simpler methods are inadequate for testing larger
systems. To the best of my knowledge SchemeUnit is the only systems. To the best of my knowledge RktUnit is the only
testing framework that makes a conscious effort to support testing framework that makes a conscious effort to support
the testing style of all levels of programmer. the testing style of all levels of programmer.

View File

@ -1,14 +1,14 @@
#lang scribble/doc #lang scribble/doc
@(require "base.ss") @(require "base.rkt")
@title[#:tag "quick-start"]{Quick Start Guide for SchemeUnit} @title[#:tag "quick-start"]{Quick Start Guide for RktUnit}
Suppose we have code contained in @tt{file.scm}, which Suppose we have code contained in @tt{file.rkt}, which
implements buggy versions of @scheme[+] and @scheme[-] implements buggy versions of @racket[+] and @racket[-]
called @scheme[my-+] and @scheme[my--]: called @racket[my-+] and @racket[my--]:
@schememod[ @racketmod[
scheme/base racket/base
(define (my-+ a b) (define (my-+ a b)
(if (zero? a) (if (zero? a)
@ -24,26 +24,26 @@ scheme/base
my-*) my-*)
] ]
We want to test this code with SchemeUnit. We start by We want to test this code with RktUnit. We start by
creating a file called @tt{file-test.scm} to contain our creating a file called @tt{file-test.rkt} to contain our
tests. At the top of @tt{file-test.scm} we import tests. At the top of @tt{file-test.rkt} we import
SchemeUnit and @tt{file.scm}: RktUnit and @tt{file.rkt}:
@schememod[ @racketmod[
scheme/base racket/base
(require schemeunit (require rktunit
"file.scm") "file.rkt")
] ]
Now we add some tests to check our library: Now we add some tests to check our library:
@schemeblock[ @racketblock[
(check-equal? (my-+ 1 1) 2 "Simple addition") (check-equal? (my-+ 1 1) 2 "Simple addition")
(check-equal? (my-* 1 2) 2 "Simple multiplication") (check-equal? (my-* 1 2) 2 "Simple multiplication")
] ]
This is all it takes to define tests in SchemeUnit. Now This is all it takes to define tests in RktUnit. Now
evaluate this file and see if the library is correct. evaluate this file and see if the library is correct.
Here's the result I get: Here's the result I get:
@ -52,7 +52,7 @@ Here's the result I get:
-------------------- --------------------
FAILURE FAILURE
name: check-equal? name: check-equal?
location: (file-test.scm 7 0 117 27) location: (file-test.rkt 7 0 117 27)
expression: (check-equal? (my-* 1 2) 2) expression: (check-equal? (my-* 1 2) 2)
params: (4 2) params: (4 2)
actual: 4 actual: 4
@ -60,21 +60,21 @@ expected: 2
--------------------} --------------------}
The first @scheme[#t] indicates the first test passed. The The first @racket[#t] indicates the first test passed. The
second test failed, as shown by the message. second test failed, as shown by the message.
Requiring SchemeUnit and writing checks is all you need to Requiring RktUnit and writing checks is all you need to
get started testing, but let's take a little bit more time get started testing, but let's take a little bit more time
to look at some features beyond the essentials. to look at some features beyond the essentials.
Let's say we want to check that a number of properties hold. Let's say we want to check that a number of properties hold.
How do we do this? So far we've only seen checks of a How do we do this? So far we've only seen checks of a
single expression. In SchemeUnit a check is always a single single expression. In RktUnit a check is always a single
expression, but we can group checks into units called test expression, but we can group checks into units called test
cases. Here's a simple test case written using the cases. Here's a simple test case written using the
@scheme[test-begin] form: @racket[test-begin] form:
@schemeblock[ @racketblock[
(test-begin (test-begin
(let ((lst (list 2 4 6 9))) (let ((lst (list 2 4 6 9)))
(check = (length lst) 4) (check = (length lst) 4)
@ -91,24 +91,24 @@ Evalute this and you should see an error message like:
A test A test
... has a FAILURE ... has a FAILURE
name: check-pred name: check-pred
location: (#<path:/Users/noel/programming/schematics/schemeunit/branches/v3/doc/file-test.scm> 14 6 252 22) location: (#<path:/Users/noel/programming/schematics/rktunit/branches/v3/doc/file-test.rkt> 14 6 252 22)
expression: (check-pred even? elt) expression: (check-pred even? elt)
params: (#<procedure:even?> 9) params: (#<procedure:even?> 9)
-------------------- --------------------
} }
This tells us that the expression @scheme[(check-pred even? This tells us that the expression @racket[(check-pred even?
elt)] failed. The arguments of this check were elt)] failed. The arguments of this check were
@scheme[even?] and @scheme[9], and as 9 is not even the @racket[even?] and @racket[9], and as 9 is not even the
check failed. A test case fails as soon as any check within check failed. A test case fails as soon as any check within
it fails, and no further checks are evaluated once this it fails, and no further checks are evaluated once this
takes place. takes place.
Naming our test cases if useful as it helps remind us what Naming our test cases if useful as it helps remind us what
we're testing. We can give a test case a name with the we're testing. We can give a test case a name with the
@scheme[test-case] form: @racket[test-case] form:
@schemeblock[ @racketblock[
(test-case (test-case
"List has length 4 and all elements even" "List has length 4 and all elements even"
(let ((lst (list 2 4 6 9))) (let ((lst (list 2 4 6 9)))
@ -122,10 +122,10 @@ we're testing. We can give a test case a name with the
Now if we want to structure our tests are bit more we can Now if we want to structure our tests are bit more we can
group them into a test suite: group them into a test suite:
@schemeblock[ @racketblock[
(define file-tests (define file-tests
(test-suite (test-suite
"Tests for file.scm" "Tests for file.rkt"
(check-equal? (my-+ 1 1) 2 "Simple addition") (check-equal? (my-+ 1 1) 2 "Simple addition")
@ -147,13 +147,13 @@ tests, allowing you to choose how you run your tests. You
might, for example, print the results to the screen or log might, for example, print the results to the screen or log
them to a file. them to a file.
Let's run our tests, using SchemeUnit's simple textual user Let's run our tests, using RktUnit's simple textual user
interface (there are fancier interfaces available but this interface (there are fancier interfaces available but this
will do for our example). In @tt{file-test.scm} add the will do for our example). In @tt{file-test.rkt} add the
following lines: following lines:
@schemeblock[ @racketblock[
(require schemeunit/text-ui) (require rktunit/text-ui)
(run-tests file-tests) (run-tests file-tests)
] ]
@ -161,6 +161,6 @@ following lines:
Now evaluate the file and you should see similar output Now evaluate the file and you should see similar output
again. again.
These are the basics of SchemeUnit. Refer to the These are the basics of RktUnit. Refer to the
documentation below for more advanced topics, such as documentation below for more advanced topics, such as
defining your own checks. Have fun! defining your own checks. Have fun!

View File

@ -1,5 +1,5 @@
#lang scribble/doc #lang scribble/doc
@(require "base.ss") @(require "base.rkt")
@title{Release Notes} @title{Release Notes}
@ -12,7 +12,7 @@ There are also miscellaneous Scribble fixes.
@section{Version 3} @section{Version 3}
This version of SchemeUnit is largely backwards compatible This version of RktUnit is largely backwards compatible
with version 2 but there are significant changes to the with version 2 but there are significant changes to the
underlying model, justifying incrementing the major version underlying model, justifying incrementing the major version
number. These changes are best explained in number. These changes are best explained in
@ -24,9 +24,9 @@ hopefully be corrected in later minor version releases:
@itemize[ @itemize[
@item{There is no graphical UI, and in particular no @item{There is no graphical UI, and in particular no
integration with DrScheme.} integration with DrRacket.}
@item{The semantics of @scheme[test-suite] are not the @item{The semantics of @racket[test-suite] are not the
desired ones. In particular, only checks and test cases desired ones. In particular, only checks and test cases
have their evaluation delayed by a test suite; other have their evaluation delayed by a test suite; other
expressions will be evaluated before the suite is expressions will be evaluated before the suite is

View File

@ -1,13 +1,13 @@
#lang scribble/doc #lang scribble/doc
@(require "base.ss") @(require "base.rkt")
@title{@bold{SchemeUnit}: Unit Testing for Scheme} @title{@bold{RktUnit}: Unit Testing for Racket}
@author[(author+email "Noel Welsh" "noelwelsh@gmail.com") @author[(author+email "Noel Welsh" "noelwelsh@gmail.com")
(author+email "Ryan Culpepper" "ryan_sml@yahoo.com")] (author+email "Ryan Culpepper" "ryan_sml@yahoo.com")]
SchemeUnit is a unit-testing framework for PLT Scheme. It RktUnit is a unit-testing framework for Racket. It
is designed to handle the needs of all Scheme programmers, is designed to handle the needs of all Racket programmers,
from novices to experts. from novices to experts.
@table-of-contents[] @table-of-contents[]

View File

@ -1,29 +1,29 @@
#lang scribble/doc #lang scribble/doc
@(require "base.ss") @(require "base.rkt")
@title[#:tag "running"]{Programmatically Running Tests and Inspecting Results} @title[#:tag "running"]{Programmatically Running Tests and Inspecting Results}
SchemeUnit provides an API for running tests, from which RktUnit provides an API for running tests, from which
custom UIs can be created. custom UIs can be created.
@section{Result Types} @section{Result Types}
@defstruct[(exn:test exn) ()]{ @defstruct[(exn:test exn) ()]{
The base structure for SchemeUnit exceptions. You should The base structure for RktUnit exceptions. You should
never catch instances of this type, only the subtypes never catch instances of this type, only the subtypes
documented below.} documented below.}
@defstruct[(exn:test:check exn:test) ([stack (listof check-info)])]{ @defstruct[(exn:test:check exn:test) ([stack (listof check-info)])]{
A @scheme[exn:test:check] is raised when an check fails, and A @racket[exn:test:check] is raised when an check fails, and
contains the contents of the check-info stack at the contains the contents of the check-info stack at the
time of failure.} time of failure.}
@defstruct[test-result ([test-case-name (or/c string #f)])]{ @defstruct[test-result ([test-case-name (or/c string #f)])]{
A test-result is the result of running the test with A test-result is the result of running the test with
the given name (with @scheme[#f] indicating no name is available).} the given name (with @racket[#f] indicating no name is available).}
@defstruct[(test-failure test-result) ([result any])]{ @defstruct[(test-failure test-result) ([result any])]{
@ -54,7 +54,7 @@ tree (list of lists) of results}
Example: Example:
@schemeblock[ @racketblock[
(run-test (run-test
(test-suite (test-suite
"Dummy" "Dummy"
@ -69,22 +69,22 @@ Example:
[#:fup fup (string 'a . -> . 'a)]) [#:fup fup (string 'a . -> . 'a)])
'a]{ 'a]{
Fold @scheme[result-fn] pre-order left-to-right depth-first Fold @racket[result-fn] pre-order left-to-right depth-first
over the results of @scheme[run]. By default @scheme[run] over the results of @racket[run]. By default @racket[run]
is @scheme[run-test-case] and @scheme[fdown] and is @racket[run-test-case] and @racket[fdown] and
@scheme[fup] just return the seed, so @scheme[result-fn] is @racket[fup] just return the seed, so @racket[result-fn] is
folded over the test results. folded over the test results.
This function is useful for writing custom folds (and hence This function is useful for writing custom folds (and hence
UIs) over test results without you having to take care of UIs) over test results without you having to take care of
all the expected setup and teardown. For example, all the expected setup and teardown. For example,
@scheme[fold-test-results] will run test suite before and @racket[fold-test-results] will run test suite before and
after actions for you. However it is still flexible enough, after actions for you. However it is still flexible enough,
via its keyword arguments, to do almost anything that foldts via its keyword arguments, to do almost anything that foldts
can. Hence it should be used in preference to foldts. can. Hence it should be used in preference to foldts.
@scheme[result-fn] is a function from the results of @racket[result-fn] is a function from the results of
@scheme[run] (defaults to a @scheme[test-result]) and the @racket[run] (defaults to a @racket[test-result]) and the
seed to a new seed seed to a new seed
Seed is any value Seed is any value
@ -104,7 +104,7 @@ Examples:
The following code counts the number of successes The following code counts the number of successes
@schemeblock[ @racketblock[
(define (count-successes test) (define (count-successes test)
(fold-test-results (fold-test-results
(lambda (result seed) (lambda (result seed)
@ -114,11 +114,11 @@ The following code counts the number of successes
0 0
test))] test))]
The following code returns the symbol @scheme['burp] instead The following code returns the symbol @racket['burp] instead
of running test cases. Note how the result-fn receives the of running test cases. Note how the result-fn receives the
value of run. value of run.
@schemeblock[ @racketblock[
(define (burp test) (define (burp test)
(fold-test-results (fold-test-results
(lambda (result seed) (cons result seed)) (lambda (result seed) (cons result seed))
@ -159,7 +159,7 @@ Example:
Here's the implementation of fold-test-results in terms of Here's the implementation of fold-test-results in terms of
foldts: foldts:
@schemeblock[ @racketblock[
(define (fold-test-results suite-fn case-fn seed test) (define (fold-test-results suite-fn case-fn seed test)
(foldts (foldts
(lambda (suite name before after seed) (lambda (suite name before after seed)
@ -187,9 +187,9 @@ recorded, and so on. To do so the functions that run the
test cases need to know what type the test case has, and test cases need to know what type the test case has, and
hence is is necessary to provide this information. hence is is necessary to provide this information.
If you've made it this far you truly are a master SchemeUnit If you've made it this far you truly are a master RktUnit
hacker. As a bonus prize we'll just mention that the code hacker. As a bonus prize we'll just mention that the code
in hash-monad.ss and monad.ss might be of interest for in hash-monad.rkt and monad.rkt might be of interest for
constructing user interfaces. The API is still in flux, so constructing user interfaces. The API is still in flux, so
isn't documented here. However, do look at the isn't documented here. However, do look at the
implementation of @scheme[run-tests] for examples of use. implementation of @racket[run-tests] for examples of use.

View File

@ -1,47 +1,47 @@
#lang scribble/doc #lang scribble/doc
@(require "base.ss") @(require "base.rkt")
@title[#:tag "ui"]{User Interfaces} @title[#:tag "ui"]{User Interfaces}
SchemeUnit provides a textual and a graphical user interface RktUnit provides a textual and a graphical user interface
@section{Textual User Interface} @section{Textual User Interface}
@defmodule[schemeunit/text-ui] @defmodule[rktunit/text-ui]
The textual UI is in the @schememodname[schemeunit/text-ui] module. The textual UI is in the @racketmodname[rktunit/text-ui] module.
It is run via the @scheme[run-tests] function. It is run via the @racket[run-tests] function.
@defproc[(run-tests (test (or/c test-case? test-suite?)) @defproc[(run-tests (test (or/c test-case? test-suite?))
(verbosity (symbols 'quiet 'normal 'verbose) 'normal)) (verbosity (symbols 'quiet 'normal 'verbose) 'normal))
natural-number/c]{ natural-number/c]{
The given @scheme[test] is run and the result of running it The given @racket[test] is run and the result of running it
output to the @scheme[current-output-port]. The output is output to the @racket[current-output-port]. The output is
compatable with the (X)Emacs next-error command (as used, compatable with the (X)Emacs next-error command (as used,
for example, by (X)Emacs's compile function) for example, by (X)Emacs's compile function)
The optional @scheme[verbosity] is one of @scheme['quiet], The optional @racket[verbosity] is one of @racket['quiet],
@scheme['normal], or @scheme['verbose]. Quiet output @racket['normal], or @racket['verbose]. Quiet output
displays only the number of successes, failures, and errors. displays only the number of successes, failures, and errors.
Normal reporting suppresses some extraneous check Normal reporting suppresses some extraneous check
information (such as the expression). Verbose reports all information (such as the expression). Verbose reports all
information. information.
@scheme[run-tests] returns the number of unsuccessful tests.} @racket[run-tests] returns the number of unsuccessful tests.}
@section{Graphical User Interface} @section{Graphical User Interface}
@defmodule[schemeunit/gui] @defmodule[rktunit/gui]
SchemeUnit also provides a GUI test runner, available from the RktUnit also provides a GUI test runner, available from the
@schememodname[schemeunit/gui] module. @racketmodname[rktunit/gui] module.
@defproc[(test/gui [test (or/c test-case? test-suite?)] ...) @defproc[(test/gui [test (or/c test-case? test-suite?)] ...)
any]{ any]{
Creates a new SchemeUnit GUI window and runs each @scheme[test]. The Creates a new RktUnit GUI window and runs each @racket[test]. The
GUI is updated as tests complete. GUI is updated as tests complete.
} }
@ -49,7 +49,7 @@ GUI is updated as tests complete.
@defproc[(make-gui-runner) @defproc[(make-gui-runner)
(-> (or/c test-case? test-suite?) ... any)]{ (-> (or/c test-case? test-suite?) ... any)]{
Creates a new SchemeUnit GUI window and returns a procedure that, when Creates a new RktUnit GUI window and returns a procedure that, when
applied, runs the given tests and displays the results in the GUI. applied, runs the given tests and displays the results in the GUI.
} }

View File

@ -0,0 +1,267 @@
;;;
;;; Time-stamp: <2009-06-11 17:11:22 noel>
;;;
;;; Copyright (C) 2005 by Noel Welsh.
;;;
;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.
;;; This library is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE. See the GNU Lesser General Public
;;; License for more details.
;;; You should have received a copy of the GNU Lesser
;;; General Public License along with this library; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA
;;; Author: Noel Welsh <noelwelsh@yahoo.com>
;;
;;
;; Commentary:
#lang racket/base
(require racket/match
racket/pretty
srfi/13
srfi/26
"main.rkt"
"private/base.rkt"
"private/counter.rkt"
"private/format.rkt"
"private/location.rkt"
"private/result.rkt"
"private/check-info.rkt"
"private/monad.rkt"
"private/hash-monad.rkt"
"private/name-collector.rkt"
"private/text-ui-util.rkt")
(provide run-tests
display-context
display-exn
display-summary+return
display-ticker
display-result)
;; display-ticker : test-result -> void
;;
;; Prints a summary of the test result
(define (display-ticker result)
(cond
((test-error? result)
(display "!"))
((test-failure? result)
(display "-"))
(else
(display "."))))
;; display-test-preamble : test-result -> (hash-monad-of void)
(define (display-test-preamble result)
(lambda (hash)
(if (test-success? result)
hash
(begin
(display-delimiter)
hash))))
;; display-test-postamble : test-result -> (hash-monad-of void)
(define (display-test-postamble result)
(lambda (hash)
(if (test-success? result)
hash
(begin
(display-delimiter)
hash))))
;; display-result : test-result -> void
(define (display-result result)
(cond
((test-error? result)
(display-test-name (test-result-test-case-name result))
(display-error)
(newline))
((test-failure? result)
(display-test-name (test-result-test-case-name result))
(display-failure)
(newline))
(else
(void))))
;; strip-redundant-parms : (list-of check-info) -> (list-of check-info)
;;
;; Strip any check-params? is there is an
;; actual/expected check-info in the same stack frame. A
;; stack frame is delimited by occurrence of a check-name?
(define (strip-redundant-params stack)
(define (binary-check-this-frame? stack)
(let loop ([stack stack])
(cond
[(null? stack) #f]
[(check-name? (car stack)) #f]
[(check-actual? (car stack)) #t]
[else (loop (cdr stack))])))
(let loop ([stack stack])
(cond
[(null? stack) null]
[(check-params? (car stack))
(if (binary-check-this-frame? stack)
(loop (cdr stack))
(cons (car stack) (loop (cdr stack))))]
[else (cons (car stack) (loop (cdr stack)))])))
;; display-context : test-result [(U #t #f)] -> void
(define (display-context result [verbose? #f])
(cond
[(test-failure? result)
(let* ([exn (test-failure-result result)]
[stack (exn:test:check-stack exn)])
(textui-display-check-info-stack stack verbose?))]
[(test-error? result)
(let ([exn (test-error-result result)])
(textui-display-check-info-stack (check-info-stack (exn-continuation-marks exn)))
(display-exn exn))]
[else (void)]))
(define (textui-display-check-info-stack stack [verbose? #f])
(for-each
(lambda (info)
(cond
[(check-name? info)
(display-check-info info)]
[(check-location? info)
(display-check-info-name-value
'location
(trim-current-directory
(location->string
(check-info-value info)))
display)]
[(check-params? info)
(display-check-info-name-value
'params
(check-info-value info)
(lambda (v) (map pretty-print v)))]
[(check-actual? info)
(display-check-info-name-value
'actual
(check-info-value info)
pretty-print)]
[(check-expected? info)
(display-check-info-name-value
'expected
(check-info-value info)
pretty-print)]
[(and (check-expression? info)
(not verbose?))
(void)]
[else
(display-check-info info)]))
(if verbose?
stack
(strip-redundant-params stack))))
;; display-verbose-check-info : test-result -> void
(define (display-verbose-check-info result)
(cond
((test-failure? result)
(let* ((exn (test-failure-result result))
(stack (exn:test:check-stack exn)))
(for-each
(lambda (info)
(cond
((check-location? info)
(display "location: ")
(display (trim-current-directory
(location->string
(check-info-value info)))))
(else
(display (check-info-name info))
(display ": ")
(write (check-info-value info))))
(newline))
stack)))
((test-error? result)
(display-exn (test-error-result result)))
(else
(void))))
(define (std-test/text-ui display-context test)
(parameterize ([current-output-port (current-error-port)])
(fold-test-results
(lambda (result seed)
((sequence* (update-counter! result)
(display-test-preamble result)
(display-test-case-name result)
(lambda (hash)
(display-result result)
(display-context result)
hash)
(display-test-postamble result))
seed))
((sequence
(put-initial-counter)
(put-initial-name))
(make-empty-hash))
test
#:fdown (lambda (name seed) ((push-suite-name! name) seed))
#:fup (lambda (name kid-seed) ((pop-suite-name!) kid-seed)))))
(define (display-summary+return monad)
(monad-value
((compose
(sequence*
(display-counter*)
(counter->vector))
(match-lambda
((vector s f e)
(return-hash (+ f e)))))
monad)))
(define (display-counter*)
(compose (counter->vector)
(match-lambda
[(vector s f e)
(if (and (zero? f) (zero? e))
(display-counter)
(lambda args
(parameterize ([current-output-port (current-error-port)])
(apply (display-counter) args))))])))
;; run-tests : test [(U 'quiet 'normal 'verbose)] -> integer
(define (run-tests test [mode 'normal])
(monad-value
((compose
(sequence*
(case mode
[(normal verbose)
(display-counter*)]
[(quiet)
(lambda (a) a)])
(counter->vector))
(match-lambda
((vector s f e)
(return-hash (+ f e)))))
(case mode
((quiet)
(fold-test-results
(lambda (result seed)
((update-counter! result) seed))
((put-initial-counter)
(make-empty-hash))
test))
((normal) (std-test/text-ui display-context test))
((verbose) (std-test/text-ui
(cut display-context <> #t)
test))))))

View File

@ -1,19 +1,19 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/gui racket/gui
framework framework
drscheme/tool drscheme/tool
scheme/unit racket/unit
(prefix-in drlink: "private/gui/drscheme-link.ss")) (prefix-in drlink: "private/gui/drracket-link.rkt"))
(provide tool@) (provide tool@)
;; CONSTANTS ;; CONSTANTS
(define BACKTRACE-NO-MESSAGE "No message.") (define BACKTRACE-NO-MESSAGE "No message.")
(define LINK-MODULE-SPEC 'schemeunit/private/gui/drscheme-link) (define LINK-MODULE-SPEC 'rktunit/private/gui/drracket-link)
(define-namespace-anchor drscheme-ns-anchor) (define-namespace-anchor drracket-ns-anchor)
;; ---- ;; ----
@ -71,7 +71,7 @@
show-backtrace show-backtrace
show-source)) show-source))
(define drscheme-ns (namespace-anchor->namespace drscheme-ns-anchor)) (define drracket-ns (namespace-anchor->namespace drracket-ns-anchor))
(define interactions-text-mixin (define interactions-text-mixin
(mixin ((class->interface drscheme:rep:text%)) () (mixin ((class->interface drscheme:rep:text%)) ()
@ -79,7 +79,7 @@
(super-new) (super-new)
(define/private (setup-helper-module) (define/private (setup-helper-module)
(namespace-attach-module drscheme-ns (namespace-attach-module drracket-ns
LINK-MODULE-SPEC LINK-MODULE-SPEC
(get-user-namespace))) (get-user-namespace)))

View File

@ -1,18 +1,3 @@
#lang scheme/base #lang racket
(require scheme/contract (require rktunit/gui)
(rename-in "private/base.ss") (provide (all-from-out rktunit/gui))
"private/gui/gui.ss")
(define (test/gui . tests)
(apply (make-gui-runner) tests))
(define test/c (or/c schemeunit-test-case? schemeunit-test-suite?))
(provide/contract
[test/gui
(->* () () #:rest (listof test/c)
any)]
[make-gui-runner
(->
(->* () () #:rest (listof test/c)
any))])

View File

@ -1,13 +1,3 @@
#lang setup/infotab #lang setup/infotab
(define name "SchemeUnit") (define name "SchemeUnit")
(define blurb '((p "SchemeUnit is a unit testing framework based on the "
" Extreme Programming unit test frameworks")))
(define scribblings '(("scribblings/schemeunit.scrbl" (multi-page) (tool))))
(define tools '[("tool.ss")])
(define tool-names '["SchemeUnit DrScheme integration"])
(define homepage "http://schematics.sourceforge.net/")
(define url "http://schematics.sourceforge.net/")

View File

@ -1,31 +1,3 @@
;;; #lang racket
;;; Time-stamp: <2008-07-30 10:46:00 nhw> (require rktunit)
;;; (provide (all-from-out rktunit))
;;; Copyright (C) by Noel Welsh.
;;;
;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.
;;; This library is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE. See the GNU Lesser General Public
;;; License for more details.
;;; You should have received a copy of the GNU Lesser
;;; General Public License along with this library; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA
;;; Author: Noel Welsh <noelwelsh@yahoo.com>
;;
;;
;; Commentary:
#lang scheme/base
(require "private/test.ss")
(provide (all-from-out "private/test.ss"))

View File

@ -1,21 +0,0 @@
#lang scribble/doc
@(require "base.ss")
@title{Miscellaneous Utilities}
The @scheme[require/expose] macro allows you to access
bindings that a module does not provide. It is useful for
testing the private functions of modules.
@defform[(require/expose module (id ...))]{
Requires @scheme[id] from @scheme[module] into the current module. It doesn't matter if the source module provides the bindings or not; @scheme[require/expose] can still get at them.
Note that @scheme[require/expose] can be a bit fragile,
especially when mixed with compiled code. Use at your own risk!
}
This example gets @scheme[make-failure-test], which is defined in a SchemeUnit test:
@schemeblock[
(require/expose schemeunit/private/check-test (make-failure-test))
]

View File

@ -1,267 +1,3 @@
;;; #lang racket
;;; Time-stamp: <2009-06-11 17:11:22 noel> (require rktunit/text-ui)
;;; (provide (all-from-out rktunit/text-ui))
;;; Copyright (C) 2005 by Noel Welsh.
;;;
;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.
;;; This library is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE. See the GNU Lesser General Public
;;; License for more details.
;;; You should have received a copy of the GNU Lesser
;;; General Public License along with this library; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA
;;; Author: Noel Welsh <noelwelsh@yahoo.com>
;;
;;
;; Commentary:
#lang scheme/base
(require scheme/match
scheme/pretty
srfi/13
srfi/26
"main.ss"
"private/base.ss"
"private/counter.ss"
"private/format.ss"
"private/location.ss"
"private/result.ss"
"private/check-info.ss"
"private/monad.ss"
"private/hash-monad.ss"
"private/name-collector.ss"
"private/text-ui-util.ss")
(provide run-tests
display-context
display-exn
display-summary+return
display-ticker
display-result)
;; display-ticker : test-result -> void
;;
;; Prints a summary of the test result
(define (display-ticker result)
(cond
((test-error? result)
(display "!"))
((test-failure? result)
(display "-"))
(else
(display "."))))
;; display-test-preamble : test-result -> (hash-monad-of void)
(define (display-test-preamble result)
(lambda (hash)
(if (test-success? result)
hash
(begin
(display-delimiter)
hash))))
;; display-test-postamble : test-result -> (hash-monad-of void)
(define (display-test-postamble result)
(lambda (hash)
(if (test-success? result)
hash
(begin
(display-delimiter)
hash))))
;; display-result : test-result -> void
(define (display-result result)
(cond
((test-error? result)
(display-test-name (test-result-test-case-name result))
(display-error)
(newline))
((test-failure? result)
(display-test-name (test-result-test-case-name result))
(display-failure)
(newline))
(else
(void))))
;; strip-redundant-parms : (list-of check-info) -> (list-of check-info)
;;
;; Strip any check-params? is there is an
;; actual/expected check-info in the same stack frame. A
;; stack frame is delimited by occurrence of a check-name?
(define (strip-redundant-params stack)
(define (binary-check-this-frame? stack)
(let loop ([stack stack])
(cond
[(null? stack) #f]
[(check-name? (car stack)) #f]
[(check-actual? (car stack)) #t]
[else (loop (cdr stack))])))
(let loop ([stack stack])
(cond
[(null? stack) null]
[(check-params? (car stack))
(if (binary-check-this-frame? stack)
(loop (cdr stack))
(cons (car stack) (loop (cdr stack))))]
[else (cons (car stack) (loop (cdr stack)))])))
;; display-context : test-result [(U #t #f)] -> void
(define (display-context result [verbose? #f])
(cond
[(test-failure? result)
(let* ([exn (test-failure-result result)]
[stack (exn:test:check-stack exn)])
(textui-display-check-info-stack stack verbose?))]
[(test-error? result)
(let ([exn (test-error-result result)])
(textui-display-check-info-stack (check-info-stack (exn-continuation-marks exn)))
(display-exn exn))]
[else (void)]))
(define (textui-display-check-info-stack stack [verbose? #f])
(for-each
(lambda (info)
(cond
[(check-name? info)
(display-check-info info)]
[(check-location? info)
(display-check-info-name-value
'location
(trim-current-directory
(location->string
(check-info-value info)))
display)]
[(check-params? info)
(display-check-info-name-value
'params
(check-info-value info)
(lambda (v) (map pretty-print v)))]
[(check-actual? info)
(display-check-info-name-value
'actual
(check-info-value info)
pretty-print)]
[(check-expected? info)
(display-check-info-name-value
'expected
(check-info-value info)
pretty-print)]
[(and (check-expression? info)
(not verbose?))
(void)]
[else
(display-check-info info)]))
(if verbose?
stack
(strip-redundant-params stack))))
;; display-verbose-check-info : test-result -> void
(define (display-verbose-check-info result)
(cond
((test-failure? result)
(let* ((exn (test-failure-result result))
(stack (exn:test:check-stack exn)))
(for-each
(lambda (info)
(cond
((check-location? info)
(display "location: ")
(display (trim-current-directory
(location->string
(check-info-value info)))))
(else
(display (check-info-name info))
(display ": ")
(write (check-info-value info))))
(newline))
stack)))
((test-error? result)
(display-exn (test-error-result result)))
(else
(void))))
(define (std-test/text-ui display-context test)
(parameterize ([current-output-port (current-error-port)])
(fold-test-results
(lambda (result seed)
((sequence* (update-counter! result)
(display-test-preamble result)
(display-test-case-name result)
(lambda (hash)
(display-result result)
(display-context result)
hash)
(display-test-postamble result))
seed))
((sequence
(put-initial-counter)
(put-initial-name))
(make-empty-hash))
test
#:fdown (lambda (name seed) ((push-suite-name! name) seed))
#:fup (lambda (name kid-seed) ((pop-suite-name!) kid-seed)))))
(define (display-summary+return monad)
(monad-value
((compose
(sequence*
(display-counter*)
(counter->vector))
(match-lambda
((vector s f e)
(return-hash (+ f e)))))
monad)))
(define (display-counter*)
(compose (counter->vector)
(match-lambda
[(vector s f e)
(if (and (zero? f) (zero? e))
(display-counter)
(lambda args
(parameterize ([current-output-port (current-error-port)])
(apply (display-counter) args))))])))
;; run-tests : test [(U 'quiet 'normal 'verbose)] -> integer
(define (run-tests test [mode 'normal])
(monad-value
((compose
(sequence*
(case mode
[(normal verbose)
(display-counter*)]
[(quiet)
(lambda (a) a)])
(counter->vector))
(match-lambda
((vector s f e)
(return-hash (+ f e)))))
(case mode
((quiet)
(fold-test-results
(lambda (result seed)
((update-counter! result) seed))
((put-initial-counter)
(make-empty-hash))
test))
((normal) (std-test/text-ui display-context test))
((verbose) (std-test/text-ui
(cut display-context <> #t)
test))))))

View File

@ -1,5 +1,5 @@
#lang scheme #lang scheme
(require schemeunit schemeunit/text-ui "1.ss" "1b.ss") (require rktunit rktunit/text-ui "1.ss" "1b.ss")
(add (make-basic-customer 'mf "matthias" "brookstone")) (add (make-basic-customer 'mf "matthias" "brookstone"))
(add (make-basic-customer 'rf "robby" "beverly hills park")) (add (make-basic-customer 'rf "robby" "beverly hills park"))

View File

@ -1,5 +1,5 @@
#lang scheme #lang scheme
(require schemeunit schemeunit/text-ui "2.ss") (require rktunit rktunit/text-ui "2.ss")
(define s0 (initialize (flat-contract integer?) =)) (define s0 (initialize (flat-contract integer?) =))
(define s2 (push (push s0 2) 1)) (define s2 (push (push s0 2) 1))

View File

@ -1,5 +1,5 @@
#lang scheme #lang scheme
(require schemeunit schemeunit/text-ui "3.ss") (require rktunit rktunit/text-ui "3.ss")
(define d0 (initialize (flat-contract integer?) =)) (define d0 (initialize (flat-contract integer?) =))
(define d (put (put (put d0 'a 2) 'b 2) 'c 1)) (define d (put (put (put d0 'a 2) 'b 2) 'c 1))

View File

@ -1,5 +1,5 @@
#lang scheme #lang scheme
(require schemeunit schemeunit/text-ui "5.ss") (require rktunit rktunit/text-ui "5.ss")
(define s (put (put (initialize (flat-contract integer?) =) 2) 1)) (define s (put (put (initialize (flat-contract integer?) =) 2) 1))

View File

@ -2,7 +2,7 @@
(provide all-contract-tests) (provide all-contract-tests)
(require schemeunit (require rktunit
deinprogramm/define-record-procedures deinprogramm/define-record-procedures
deinprogramm/contract/contract deinprogramm/contract/contract
deinprogramm/contract/contract-syntax) deinprogramm/contract/contract-syntax)

View File

@ -2,7 +2,7 @@
(provide all-image-tests) (provide all-image-tests)
(require schemeunit (require rktunit
deinprogramm/image deinprogramm/image
(only-in lang/private/imageeq image=?) (only-in lang/private/imageeq image=?)
mred mred

View File

@ -1,6 +1,6 @@
#lang scheme/base #lang scheme/base
(require schemeunit/text-ui) (require rktunit/text-ui)
(require tests/deinprogramm/contract) (require tests/deinprogramm/contract)
(run-tests all-contract-tests) (run-tests all-contract-tests)

View File

@ -1,6 +1,6 @@
#lang scheme/base #lang scheme/base
(require schemeunit/text-ui) (require rktunit/text-ui)
(require tests/deinprogramm/image) (require tests/deinprogramm/image)
(run-tests all-image-tests) (run-tests all-image-tests)

View File

@ -216,7 +216,7 @@
=> '(#"1 test passed\n" #"2 tests passed\n") => '(#"1 test passed\n" #"2 tests passed\n")
) )
;; SchemeUnit stuff ;; RktUnit stuff
;; (examples that should fail modified to ones that shouldn't) ;; (examples that should fail modified to ones that shouldn't)
#| #|

View File

@ -1,7 +1,7 @@
#lang scheme/base #lang scheme/base
(require scheme/future (require scheme/future
schemeunit) rktunit)
#|Need to add expressions which raise exceptions inside a #|Need to add expressions which raise exceptions inside a
future thunk which can be caught at the touch site future thunk which can be caught at the touch site

View File

@ -1,6 +1,6 @@
#lang racket #lang racket
(require schemeunit (require rktunit
schemeunit/text-ui rktunit/text-ui
net/url net/url
(prefix-in h: html) (prefix-in h: html)
(prefix-in x: xml)) (prefix-in x: xml))

View File

@ -21,7 +21,7 @@
"plot" "plot"
"profj" "profj"
"r6rs" "r6rs"
"schemeunit" "rktunit"
"srfi" "srfi"
"srpersist" "srpersist"
"stepper" "stepper"

View File

@ -1,6 +1,6 @@
#lang scheme/base #lang scheme/base
(require schemeunit (require rktunit
schemeunit/gui) rktunit/gui)
(require macro-debugger/model/debug (require macro-debugger/model/debug
"gentest-framework.ss" "gentest-framework.ss"
"gentests.ss" "gentests.ss"

View File

@ -1,5 +1,5 @@
#lang scheme/base #lang scheme/base
(require schemeunit) (require rktunit)
(require macro-debugger/model/debug (require macro-debugger/model/debug
macro-debugger/model/stx-util macro-debugger/model/stx-util
"gentest-framework.ss" "gentest-framework.ss"

View File

@ -1,6 +1,6 @@
#lang scheme/base #lang scheme/base
(require schemeunit (require rktunit
schemeunit/gui) rktunit/gui)
(require macro-debugger/model/debug (require macro-debugger/model/debug
scheme/path scheme/path
scheme/gui) scheme/gui)

View File

@ -1,5 +1,5 @@
#lang scheme/base #lang scheme/base
(require schemeunit) (require rktunit)
(require macro-debugger/model/debug (require macro-debugger/model/debug
"../test-setup.ss") "../test-setup.ss")
(provide specialized-hiding-tests) (provide specialized-hiding-tests)

View File

@ -1,5 +1,5 @@
#lang scheme/base #lang scheme/base
(require schemeunit) (require rktunit)
(require macro-debugger/model/debug (require macro-debugger/model/debug
"../test-setup.ss") "../test-setup.ss")
(provide policy-tests) (provide policy-tests)

View File

@ -1,5 +1,5 @@
#lang scheme/base #lang scheme/base
(require schemeunit) (require rktunit)
(require macro-debugger/model/debug (require macro-debugger/model/debug
macro-debugger/model/steps macro-debugger/model/steps
"../test-setup.ss") "../test-setup.ss")

View File

@ -6,7 +6,7 @@
(for-syntax scheme/base) (for-syntax scheme/base)
(prefix-in m: mzlib/match) (prefix-in m: mzlib/match)
(only-in srfi/13 string-contains) (only-in srfi/13 string-contains)
schemeunit) rktunit)
(define-syntax (comp stx) (define-syntax (comp stx)
(syntax-case stx () (syntax-case stx ()

View File

@ -1,5 +1,5 @@
(module match-tests mzscheme (module match-tests mzscheme
(require mzlib/match schemeunit) (require mzlib/match rktunit)
(provide match-tests) (provide match-tests)

View File

@ -1,6 +1,6 @@
(module other-plt-tests mzscheme (module other-plt-tests mzscheme
(require schemeunit net/uri-codec mzlib/pregexp mzlib/plt-match (require rktunit net/uri-codec mzlib/pregexp mzlib/plt-match
mzlib/list mzlib/etc) mzlib/list mzlib/etc)
(define-struct shape (color)) (define-struct shape (color))

View File

@ -1,5 +1,5 @@
(module other-tests mzscheme (module other-tests mzscheme
(require mzlib/match schemeunit) (require mzlib/match rktunit)
(provide other-tests) (provide other-tests)

View File

@ -2,7 +2,7 @@
(require (for-syntax scheme/base) (require (for-syntax scheme/base)
"match-tests.ss" "other-plt-tests.ss" "other-tests.ss" "examples.ss" "match-tests.ss" "other-plt-tests.ss" "other-tests.ss" "examples.ss"
schemeunit schemeunit/text-ui) rktunit rktunit/text-ui)
(require mzlib/plt-match) (require mzlib/plt-match)

View File

@ -1,5 +1,5 @@
#lang scheme #lang scheme
(require schemeunit (require rktunit
plai/random-mutator plai/random-mutator
scheme/runtime-path scheme/runtime-path
;; test find-heap-values and save-random-mutator via the contract'd ;; test find-heap-values and save-random-mutator via the contract'd

View File

@ -1,7 +1,7 @@
(module contract-opt-tests mzscheme (module contract-opt-tests mzscheme
(require mzlib/contract (require mzlib/contract
schemeunit rktunit
schemeunit/text-ui) rktunit/text-ui)
(define (exn:fail:contract-violation? exn) (define (exn:fail:contract-violation? exn)
(if (regexp-match #rx"broke" (exn-message exn)) #t #f)) (if (regexp-match #rx"broke" (exn-message exn)) #t #f))

View File

@ -1,7 +1,7 @@
#lang racket #lang racket
(require raclog (require raclog
schemeunit) rktunit)
;The following is the "Biblical" database from "The Art of ;The following is the "Biblical" database from "The Art of
;Prolog", Sterling & Shapiro, ch. 1. ;Prolog", Sterling & Shapiro, ch. 1.
@ -142,4 +142,4 @@
dad-kids))))) dad-kids)))))
(check-equal? (dad-kids-test-5) (check-equal? (dad-kids-test-5)
`((dad-kids . ((terach (abraham nachor haran)) (abraham (isaac)) (haran (lot milcah yiscah)))))) `((dad-kids . ((terach (abraham nachor haran)) (abraham (isaac)) (haran (lot milcah yiscah))))))

View File

@ -1,7 +1,7 @@
#lang racket #lang racket
(require raclog (require raclog
schemeunit) rktunit)
;The following is a simple database about a certain family in England. ;The following is a simple database about a certain family in England.
;Should be a piece of cake, but given here so that you can hone ;Should be a piece of cake, but given here so that you can hone

View File

@ -2,7 +2,7 @@
(require raclog (require raclog
"./puzzle.rkt" "./puzzle.rkt"
schemeunit) rktunit)
;;This example is from Sterling & Shapiro, p. 214. ;;This example is from Sterling & Shapiro, p. 214.
;; ;;

View File

@ -1,28 +1,28 @@
#lang scheme/base #lang racket/base
(require schemeunit (require rktunit
"check-test.ss" "check-test.rkt"
"check-info-test.ss" "check-info-test.rkt"
"format-test.ss" "format-test.rkt"
"test-case-test.ss" "test-case-test.rkt"
"test-suite-test.ss" "test-suite-test.rkt"
"base-test.ss" "base-test.rkt"
"location-test.ss" "location-test.rkt"
"result-test.ss" "result-test.rkt"
"test-test.ss" "test-test.rkt"
"util-test.ss" "util-test.rkt"
"text-ui-test.ss" "text-ui-test.rkt"
"monad-test.ss" "monad-test.rkt"
"hash-monad-test.ss" "hash-monad-test.rkt"
"counter-test.ss" "counter-test.rkt"
"text-ui-util-test.ss") "text-ui-util-test.rkt")
(provide all-schemeunit-tests (provide all-rktunit-tests
failure-tests) failure-tests)
(define all-schemeunit-tests (define all-rktunit-tests
(test-suite (test-suite
"All SchemeUnit Tests" "All RktUnit Tests"
check-tests check-tests
base-tests base-tests
check-info-tests check-info-tests

View File

@ -26,10 +26,10 @@
;; ;;
;; Commentary: ;; Commentary:
#lang scheme/base #lang racket/base
(require schemeunit (require rktunit
schemeunit/private/base) rktunit/private/base)
(provide base-tests) (provide base-tests)
@ -37,45 +37,45 @@
(test-suite (test-suite
"All tests for base" "All tests for base"
(test-case (test-case
"schemeunit-test-case structure has a contract on name" "rktunit-test-case structure has a contract on name"
(check-exn exn:fail? (check-exn exn:fail?
(lambda () (lambda ()
(make-schemeunit-test-case (make-rktunit-test-case
'foo 'foo
(lambda () #t))))) (lambda () #t)))))
(test-case (test-case
"schemeunit-test-case structure has a contract on action" "rktunit-test-case structure has a contract on action"
(check-exn exn:fail? (check-exn exn:fail?
(lambda () (lambda ()
(make-schemeunit-test-case (make-rktunit-test-case
"Name" "Name"
#f)))) #f))))
(test-case (test-case
"schemeunit-test-suite has a contract on its fields" "rktunit-test-suite has a contract on its fields"
(check-exn exn:fail? (check-exn exn:fail?
(lambda () (lambda ()
(make-schemeunit-test-suite (make-rktunit-test-suite
#f #f
(list) (list)
(lambda () 3) (lambda () 3)
(lambda () 2)))) (lambda () 2))))
(check-exn exn:fail? (check-exn exn:fail?
(lambda () (lambda ()
(make-schemeunit-test-suite (make-rktunit-test-suite
"Name" "Name"
#f #f
(lambda () 3) (lambda () 3)
(lambda () 2)))) (lambda () 2))))
(check-exn exn:fail? (check-exn exn:fail?
(lambda () (lambda ()
(make-schemeunit-test-suite (make-rktunit-test-suite
"Name" "Name"
(list) (list)
#f #f
(lambda () 2)))) (lambda () 2))))
(check-exn exn:fail? (check-exn exn:fail?
(lambda () (lambda ()
(make-schemeunit-test-suite (make-rktunit-test-suite
"Name" "Name"
(list) (list)
(lambda () 3) (lambda () 3)

View File

@ -1,23 +1,23 @@
;;; ;;;
;;; <check-util-test.ss> ---- Tests for check-util ;;; <check-util-test.rkt> ---- Tests for check-util
;;; Time-stamp: <2009-06-11 17:03:21 noel> ;;; Time-stamp: <2009-06-11 17:03:21 noel>
;;; ;;;
;;; Copyright (C) 2003 by Noel Welsh. ;;; Copyright (C) 2003 by Noel Welsh.
;;; ;;;
;;; This file is part of SchemeUnit. ;;; This file is part of RktUnit.
;;; SchemeUnit is free software; you can redistribute it and/or ;;; RktUnit is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public ;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either ;;; License as published by the Free Software Foundation; either
;;; version 2.1 of the License, or (at your option) any later version. ;;; version 2.1 of the License, or (at your option) any later version.
;;; SchemeUnitis distributed in the hope that it will be useful, ;;; RktUnitis distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Lesser General Public License for more details. ;;; Lesser General Public License for more details.
;;; You should have received a copy of the GNU Lesser General Public ;;; You should have received a copy of the GNU Lesser General Public
;;; License along with SchemeUnit; if not, write to the Free Software ;;; License along with RktUnit; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;; Author: Noel Welsh <noelwelsh@yahoo.com> ;;; Author: Noel Welsh <noelwelsh@yahoo.com>
@ -25,10 +25,10 @@
;; ;;
;; Commentary: ;; Commentary:
#lang scheme/base #lang racket/base
(require schemeunit (require rktunit
schemeunit/private/check-info) rktunit/private/check-info)
(provide check-info-tests) (provide check-info-tests)

View File

@ -26,14 +26,14 @@
;; ;;
;; Commentary: ;; Commentary:
#lang scheme/base #lang racket/base
(require scheme/runtime-path (require racket/runtime-path
srfi/1 srfi/1
schemeunit rktunit
schemeunit/private/check rktunit/private/check
schemeunit/private/result rktunit/private/result
schemeunit/private/test-suite) rktunit/private/test-suite)
(provide check-tests) (provide check-tests)
@ -287,8 +287,8 @@
(let ((destns (make-base-namespace)) (let ((destns (make-base-namespace))
(cns (current-namespace))) (cns (current-namespace)))
(parameterize ((current-namespace destns)) (parameterize ((current-namespace destns))
(namespace-require '(for-syntax scheme/base)) (namespace-require '(for-syntax racket/base))
(namespace-require 'schemeunit/private/check) (namespace-require 'rktunit/private/check)
;; First check that the right check macro got ;; First check that the right check macro got
;; used: ie that it didn't just compile the thing ;; used: ie that it didn't just compile the thing
;; as an application. ;; as an application.

View File

@ -25,13 +25,13 @@
;; ;;
;; ;;
;; Commentary: ;; Commentary:
#lang scheme/base #lang racket/base
(require scheme/match (require racket/match
schemeunit rktunit
schemeunit/private/counter rktunit/private/counter
schemeunit/private/monad rktunit/private/monad
schemeunit/private/hash-monad) rktunit/private/hash-monad)
(provide counter-tests) (provide counter-tests)

View File

@ -1,8 +1,8 @@
#lang scheme/base #lang racket/base
(require schemeunit (require rktunit
schemeunit/private/check-info rktunit/private/check-info
schemeunit/private/format) rktunit/private/format)
(provide format-tests) (provide format-tests)

View File

@ -26,11 +26,11 @@
;; ;;
;; Commentary: ;; Commentary:
#lang scheme/base #lang racket/base
(require schemeunit (require rktunit
schemeunit/private/monad rktunit/private/monad
schemeunit/private/hash-monad) rktunit/private/hash-monad)
(provide hash-monad-tests) (provide hash-monad-tests)

View File

@ -25,10 +25,10 @@
;; ;;
;; ;;
;; Commentary: ;; Commentary:
#lang scheme/base #lang racket/base
(require schemeunit (require rktunit
schemeunit/private/location) rktunit/private/location)
(provide location-tests) (provide location-tests)
@ -43,10 +43,10 @@
(test-case (test-case
"syntax->location ok" "syntax->location ok"
(around (around
(with-output-to-file "test-file.ss" (with-output-to-file "test-file.rkt"
(lambda () (display "#lang scheme\n'foo\n"))) (lambda () (display "#lang racket\n'foo\n")))
(let* ([stx (read-syntax/lang (string->path "test-file.ss") (let* ([stx (read-syntax/lang (string->path "test-file.rkt")
(open-input-file "test-file.ss"))] (open-input-file "test-file.rkt"))]
[rep (syntax->location stx)]) [rep (syntax->location stx)])
(check-equal? (location-source rep) (check-equal? (location-source rep)
(syntax-source stx)) (syntax-source stx))
@ -54,7 +54,7 @@
(syntax-position stx)) (syntax-position stx))
(check-equal? (location-span rep) (check-equal? (location-span rep)
(syntax-span stx))) (syntax-span stx)))
(delete-file "test-file.ss"))) (delete-file "test-file.rkt")))
(test-case (test-case
"Emacs compatible location strings" "Emacs compatible location strings"
@ -63,15 +63,15 @@
(syntax->location (syntax->location
(datum->syntax (datum->syntax
#f #f #f #f
(list "file.ss" 42 38 1240 2)))) (list "file.rkt" 42 38 1240 2))))
"file.ss:42:38") "file.rkt:42:38")
(check string=? (check string=?
(location->string (location->string
(syntax->location (syntax->location
(datum->syntax (datum->syntax
#f #f #f #f
(list (string->path "file.ss") 42 38 1240 2)))) (list (string->path "file.rkt") 42 38 1240 2))))
"file.ss:42:38") "file.rkt:42:38")
(check string=? (check string=?
(location->string (location->string
(syntax->location (syntax->location
@ -84,14 +84,14 @@
(syntax->location (syntax->location
(datum->syntax (datum->syntax
#f #f #f #f
(list 'foo.ss 42 38 1240 2)))) (list 'foo.rkt 42 38 1240 2))))
"foo.ss:42:38") "foo.rkt:42:38")
(check string=? (check string=?
(location->string (location->string
(syntax->location (syntax->location
(datum->syntax (datum->syntax
#f #f #f #f
(list "foo.ss" #f #f #f #f)))) (list "foo.rkt" #f #f #f #f))))
"foo.ss:?:?")) "foo.rkt:?:?"))
)) ))

View File

@ -27,10 +27,10 @@
;; Commentary: ;; Commentary:
#lang scheme/base #lang racket/base
(require schemeunit (require rktunit
schemeunit/private/monad) rktunit/private/monad)
(provide monad-tests) (provide monad-tests)

View File

@ -1,7 +1,7 @@
#lang scheme/base #lang racket/base
(require schemeunit (require rktunit
schemeunit/private/result) rktunit/private/result)
(provide result-tests) (provide result-tests)

View File

@ -1,10 +1,10 @@
#lang scheme/base #lang racket/base
(require schemeunit (require rktunit
schemeunit/text-ui rktunit/text-ui
"all-schemeunit-tests.ss") "all-rktunit-tests.rkt")
(run-tests all-schemeunit-tests) (run-tests all-rktunit-tests)
;; These tests should all error, so we switch the meaning of correct and incorrect. If the error display changes significantly, DrDr will catch it ;; These tests should all error, so we switch the meaning of correct and incorrect. If the error display changes significantly, DrDr will catch it
(parameterize ([current-error-port (current-output-port)] (parameterize ([current-error-port (current-output-port)]

View File

@ -29,9 +29,9 @@
;; part of the standard test suite and must be run ;; part of the standard test suite and must be run
;; separately. ;; separately.
#lang scheme/base #lang racket/base
(require schemeunit/private/check) (require rktunit/private/check)
;; This check should succeed ;; This check should succeed
(check = 1 1 0.0) (check = 1 1 0.0)

Some files were not shown because too many files have changed in this diff Show More