Renaming schemeunit to rktunit and adding compat layer
This commit is contained in:
Jay McCarthy
parent
3b23f74fc7
commit
f70ffca756
|
|
@ -1,6 +1,6 @@
|
|||
#lang scheme/load
|
||||
|
||||
(require schemeunit)
|
||||
(require rktunit)
|
||||
(require 2htdp/batch-io)
|
||||
|
||||
(define file "batch-io.txt")
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@
|
|||
scheme/math
|
||||
scheme/class
|
||||
scheme/gui/base
|
||||
schemeunit
|
||||
rktunit
|
||||
(prefix-in 1: htdp/image)
|
||||
(only-in lang/htdp-advanced equal~?))
|
||||
|
||||
|
|
|
|||
|
|
@ -662,6 +662,7 @@ mz-extras :+= (- (package: "unstable")
|
|||
;; -------------------- plai
|
||||
plt-extras :+= (package: "plai/")
|
||||
|
||||
plt-extras :+= (package: "rktunit/")
|
||||
plt-extras :+= (package: "schemeunit/")
|
||||
|
||||
;; ============================================================================
|
||||
|
|
|
|||
|
|
@ -615,26 +615,26 @@
|
|||
("schematics" "port.plt" 1 0 #f)
|
||||
("schematics" "random.plt" 1 0 #f)
|
||||
("schematics" "sake.plt" 1 0 "4.0")
|
||||
("schematics" "schemeunit.plt" 3 4 "4.0")
|
||||
("schematics" "schemeunit.plt" 3 3 "4.0")
|
||||
("schematics" "schemeunit.plt" 3 2 "4.0")
|
||||
("schematics" "schemeunit.plt" 3 1 "4.0")
|
||||
("schematics" "schemeunit.plt" 3 0 "4.0")
|
||||
("schematics" "schemeunit.plt" 2 11 "4.1.0.3")
|
||||
("schematics" "schemeunit.plt" 2 10 "369.1")
|
||||
("schematics" "schemeunit.plt" 2 9 "369.1")
|
||||
("schematics" "schemeunit.plt" 2 8 "369.1")
|
||||
("schematics" "schemeunit.plt" 2 7 "369.1")
|
||||
("schematics" "schemeunit.plt" 2 6 "369.1")
|
||||
("schematics" "schemeunit.plt" 2 5 "369.1")
|
||||
("schematics" "schemeunit.plt" 2 4 "369.1")
|
||||
("schematics" "schemeunit.plt" 2 3 #f)
|
||||
("schematics" "schemeunit.plt" 2 2 #f)
|
||||
("schematics" "schemeunit.plt" 2 1 #f)
|
||||
("schematics" "schemeunit.plt" 2 0 #f)
|
||||
("schematics" "schemeunit.plt" 1 2 #f)
|
||||
("schematics" "schemeunit.plt" 1 1 #f)
|
||||
("schematics" "schemeunit.plt" 1 0 #f)
|
||||
("schematics" "rktunit.plt" 3 4 "4.0")
|
||||
("schematics" "rktunit.plt" 3 3 "4.0")
|
||||
("schematics" "rktunit.plt" 3 2 "4.0")
|
||||
("schematics" "rktunit.plt" 3 1 "4.0")
|
||||
("schematics" "rktunit.plt" 3 0 "4.0")
|
||||
("schematics" "rktunit.plt" 2 11 "4.1.0.3")
|
||||
("schematics" "rktunit.plt" 2 10 "369.1")
|
||||
("schematics" "rktunit.plt" 2 9 "369.1")
|
||||
("schematics" "rktunit.plt" 2 8 "369.1")
|
||||
("schematics" "rktunit.plt" 2 7 "369.1")
|
||||
("schematics" "rktunit.plt" 2 6 "369.1")
|
||||
("schematics" "rktunit.plt" 2 5 "369.1")
|
||||
("schematics" "rktunit.plt" 2 4 "369.1")
|
||||
("schematics" "rktunit.plt" 2 3 #f)
|
||||
("schematics" "rktunit.plt" 2 2 #f)
|
||||
("schematics" "rktunit.plt" 2 1 #f)
|
||||
("schematics" "rktunit.plt" 2 0 #f)
|
||||
("schematics" "rktunit.plt" 1 2 #f)
|
||||
("schematics" "rktunit.plt" 1 1 #f)
|
||||
("schematics" "rktunit.plt" 1 0 #f)
|
||||
("schematics" "si.plt" 1 0 #f)
|
||||
("schematics" "spgsql.plt" 2 3 "371.3")
|
||||
("schematics" "spgsql.plt" 2 2 "371.3")
|
||||
|
|
|
|||
|
|
@ -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/match" responsible (samth)
|
||||
"collects/scheme/match.rkt" responsible (samth)
|
||||
"collects/schemeunit" responsible (noel ryanc)
|
||||
"collects/schemeunit/gui.rkt" responsible (ryanc) drdr:command-line "mred-text -t ~s"
|
||||
"collects/schemeunit/private/gui" responsible (ryanc)
|
||||
"collects/schemeunit/private/gui/config.rkt" drdr:command-line "mred-text -t ~s"
|
||||
"collects/schemeunit/private/gui/controller.rkt" drdr:command-line "mred-text -t ~s"
|
||||
"collects/schemeunit/private/gui/gui.rkt" drdr:command-line "mred-text -t ~s"
|
||||
"collects/schemeunit/private/gui/model2rml.rkt" drdr:command-line "mred-text -t ~s"
|
||||
"collects/schemeunit/private/gui/rml.rkt" drdr:command-line "mred-text -t ~s"
|
||||
"collects/schemeunit/private/gui/view.rkt" drdr:command-line "mred-text -t ~s"
|
||||
"collects/schemeunit/tool.rkt" responsible (ryanc) drdr:command-line "mred-text -t ~s"
|
||||
"collects/rktunit" responsible (jay noel ryanc)
|
||||
"collects/schemeunit" responsible (jay)
|
||||
"collects/rktunit/gui.rkt" responsible (ryanc) drdr:command-line "mred-text -t ~s"
|
||||
"collects/rktunit/private/gui" responsible (ryanc)
|
||||
"collects/rktunit/private/gui/config.rkt" drdr:command-line "mred-text -t ~s"
|
||||
"collects/rktunit/private/gui/controller.rkt" drdr:command-line "mred-text -t ~s"
|
||||
"collects/rktunit/private/gui/gui.rkt" drdr:command-line "mred-text -t ~s"
|
||||
"collects/rktunit/private/gui/model2rml.rkt" drdr:command-line "mred-text -t ~s"
|
||||
"collects/rktunit/private/gui/rml.rkt" 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/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
|
||||
|
|
@ -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/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/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/40/run-tests.rkt" drdr:command-line "mzscheme -f ~s"
|
||||
"collects/tests/srfi/43/run-tests.rkt" drdr:command-line "mzscheme -f ~s"
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#lang scheme/base
|
||||
(require (for-syntax scheme/base)
|
||||
"../lex.ss"
|
||||
schemeunit)
|
||||
rktunit)
|
||||
|
||||
(define-syntax (catch-syn-error stx)
|
||||
(syntax-case stx ()
|
||||
|
|
|
|||
18
collects/rktunit/gui.rkt
Normal file
18
collects/rktunit/gui.rkt
Normal 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
13
collects/rktunit/info.rkt
Normal 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
31
collects/rktunit/main.rkt
Normal 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"))
|
||||
|
|
@ -1,13 +1,13 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require scheme/contract)
|
||||
(require racket/contract)
|
||||
|
||||
;; struct test :
|
||||
(define-struct test ())
|
||||
;; struct (schemeunit-test-case test) : (U string #f) thunk
|
||||
(define-struct (schemeunit-test-case test) (name action) #:transparent)
|
||||
;; struct (schemeunit-test-suite test) : string (fdown fup fhere seed -> (listof test-result)) thunk thunk
|
||||
(define-struct (schemeunit-test-suite test) (name tests before after) #:transparent)
|
||||
;; struct (rktunit-test-case test) : (U string #f) thunk
|
||||
(define-struct (rktunit-test-case test) (name action) #:transparent)
|
||||
;; struct (rktunit-test-suite test) : string (fdown fup fhere seed -> (listof test-result)) thunk thunk
|
||||
(define-struct (rktunit-test-suite test) (name tests before after) #:transparent)
|
||||
|
||||
;; struct exn:test exn : ()
|
||||
;;
|
||||
|
|
@ -33,10 +33,10 @@
|
|||
(define-struct (test-success test-result) (result))
|
||||
|
||||
(provide/contract
|
||||
(struct (schemeunit-test-case test)
|
||||
(struct (rktunit-test-case test)
|
||||
((name (or/c string? false/c))
|
||||
(action (-> any))))
|
||||
(struct (schemeunit-test-suite test)
|
||||
(struct (rktunit-test-suite test)
|
||||
((name string?)
|
||||
(tests procedure?)
|
||||
(before (-> any))
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
||||
|
|
@ -11,7 +11,7 @@
|
|||
;; Infrastructure ----------------------------------------------
|
||||
|
||||
;; 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))
|
||||
(define (check-info-stack marks)
|
||||
|
|
@ -1,12 +1,12 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require (for-syntax scheme/base
|
||||
"location.ss")
|
||||
(require (for-syntax racket/base
|
||||
"location.rkt")
|
||||
srfi/1
|
||||
"base.ss"
|
||||
"check-info.ss"
|
||||
"format.ss"
|
||||
"location.ss")
|
||||
"base.rkt"
|
||||
"check-info.rkt"
|
||||
"format.rkt"
|
||||
"location.rkt")
|
||||
|
||||
(provide current-check-handler
|
||||
check-around
|
||||
|
|
@ -26,11 +26,11 @@
|
|||
;;
|
||||
;; Commentary:
|
||||
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require "base.ss"
|
||||
"monad.ss"
|
||||
"hash-monad.ss")
|
||||
(require "base.rkt"
|
||||
"monad.rkt"
|
||||
"hash-monad.rkt")
|
||||
|
||||
(provide display-counter
|
||||
update-counter!
|
||||
|
|
@ -1,8 +1,8 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require scheme/match
|
||||
(require racket/match
|
||||
srfi/13
|
||||
"check-info.ss")
|
||||
"check-info.rkt")
|
||||
|
||||
(provide display-check-info-name-value
|
||||
display-check-info
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require scheme/contract)
|
||||
#lang racket/base
|
||||
(require racket/contract)
|
||||
|
||||
;; Add a new kind of promise instead?
|
||||
|
||||
|
|
@ -1,24 +1,24 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
(require framework
|
||||
unstable/gui/prefs)
|
||||
(provide (all-defined-out))
|
||||
|
||||
;; Frame size preferences
|
||||
|
||||
(preferences:set-default 'schemeunit:frame:width 400 exact-positive-integer?)
|
||||
(preferences:set-default 'schemeunit:frame:height 400 exact-positive-integer?)
|
||||
(define pref:width (pref:get/set 'schemeunit:frame:width))
|
||||
(define pref:height (pref:get/set 'schemeunit:frame:height))
|
||||
(preferences:set-default 'rktunit:frame:width 400 exact-positive-integer?)
|
||||
(preferences:set-default 'rktunit:frame:height 400 exact-positive-integer?)
|
||||
(define pref:width (pref:get/set 'rktunit:frame:width))
|
||||
(define pref:height (pref:get/set 'rktunit:frame:height))
|
||||
|
||||
;; CONSTANTS
|
||||
;; Some of these are obsolete, given the preferences above.
|
||||
|
||||
(define DETAILS-CANVAS-INIT-WIDTH 400)
|
||||
(define FRAME-LABEL "SchemeUnit")
|
||||
(define FRAME-LABEL "RktUnit")
|
||||
(define FRAME-INIT-HEIGHT 400)
|
||||
(define TREE-INIT-WIDTH 240)
|
||||
(define TREE-COLORIZE-CASES #t)
|
||||
(define DIALOG-ERROR-TITLE "SchemeUnit: Error")
|
||||
(define DIALOG-ERROR-TITLE "RktUnit: Error")
|
||||
(define STATUS-SUCCESS 'success)
|
||||
(define STATUS-FAILURE 'failure)
|
||||
(define STATUS-ERROR 'error)
|
||||
|
|
@ -28,7 +28,7 @@
|
|||
(list (/ TREE-INIT-WIDTH total) (/ DETAILS-CANVAS-INIT-WIDTH total))))
|
||||
|
||||
;; 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-parameters 'params)
|
||||
(define prop:failure-location 'location)
|
||||
|
|
@ -1,11 +1,11 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
#lang racket/base
|
||||
(require racket/class
|
||||
unstable/class-iop
|
||||
unstable/gui/notify
|
||||
"../base.ss"
|
||||
"interfaces.ss"
|
||||
"model.ss"
|
||||
"view.ss")
|
||||
"../base.rkt"
|
||||
"interfaces.rkt"
|
||||
"model.rkt"
|
||||
"view.rkt")
|
||||
(provide controller%)
|
||||
|
||||
(define controller%
|
||||
|
|
@ -25,18 +25,18 @@
|
|||
;; create-model : test suite<%>/#f -> result<%>
|
||||
(define/public (create-model test parent)
|
||||
(define result
|
||||
(cond [(schemeunit-test-case? test)
|
||||
(cond [(rktunit-test-case? test)
|
||||
(new case-result%
|
||||
(controller this)
|
||||
(test test)
|
||||
(name (or (schemeunit-test-case-name test)
|
||||
(name (or (rktunit-test-case-name test)
|
||||
"<unnamed test-case>"))
|
||||
(parent parent))]
|
||||
[(schemeunit-test-suite? test)
|
||||
[(rktunit-test-suite? test)
|
||||
(new suite-result%
|
||||
(controller this)
|
||||
(test test)
|
||||
(name (or (schemeunit-test-suite-name test)
|
||||
(name (or (rktunit-test-suite-name test)
|
||||
"<unnamed test-suite>"))
|
||||
(parent parent))]))
|
||||
(send/i view view<%> create-view-link result parent)
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
;; 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)
|
||||
|
||||
#|
|
||||
|
|
@ -1,10 +1,10 @@
|
|||
#lang scheme/base
|
||||
(require scheme/list
|
||||
scheme/string
|
||||
#lang racket/base
|
||||
(require racket/list
|
||||
racket/string
|
||||
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.
|
||||
|
||||
(provide has-backtrace?
|
||||
|
|
@ -1,13 +1,13 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
#lang racket/base
|
||||
(require racket/class
|
||||
unstable/class-iop
|
||||
scheme/gui
|
||||
"../base.ss"
|
||||
"../result.ss"
|
||||
"../check-info.ss"
|
||||
"interfaces.ss"
|
||||
"controller.ss"
|
||||
"view.ss")
|
||||
racket/gui
|
||||
"../base.rkt"
|
||||
"../result.rkt"
|
||||
"../check-info.rkt"
|
||||
"interfaces.rkt"
|
||||
"controller.rkt"
|
||||
"view.rkt")
|
||||
(provide make-gui-runner)
|
||||
|
||||
(define (make-gui-runner)
|
||||
|
|
@ -48,8 +48,8 @@
|
|||
#|
|
||||
(define/public (run)
|
||||
(let ([custodian (make-custodian)]
|
||||
[before (schemeunit-test-suite-before test)]
|
||||
[after (schemeunit-test-suite-after test)])
|
||||
[before (rktunit-test-suite-before test)]
|
||||
[after (rktunit-test-suite-after test)])
|
||||
(parameterize [(current-custodian custodian)]
|
||||
(dynamic-wind
|
||||
before
|
||||
|
|
@ -112,8 +112,8 @@
|
|||
(call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(time-apply run-test-case
|
||||
(list (schemeunit-test-case-name test)
|
||||
(schemeunit-test-case-action test)))))])
|
||||
(list (rktunit-test-case-name test)
|
||||
(rktunit-test-case-action test)))))])
|
||||
(values (car results) (list cputime realtime gctime))))
|
||||
|
||||
(define (make-output-ports)
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
#lang scheme/base
|
||||
(require scheme/contract
|
||||
scheme/dict)
|
||||
#lang racket/base
|
||||
(require racket/contract
|
||||
racket/dict)
|
||||
|
||||
(define (make-gvector* #:capacity [capacity 10])
|
||||
(make-gvector (make-vector capacity #f) 0))
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
#lang racket/base
|
||||
(require racket/class
|
||||
unstable/class-iop)
|
||||
(provide (all-defined-out))
|
||||
|
||||
|
|
@ -1,11 +1,11 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
#lang racket/base
|
||||
(require racket/class
|
||||
unstable/class-iop
|
||||
scheme/list
|
||||
"gvector.ss"
|
||||
"../base.ss"
|
||||
"interfaces.ss"
|
||||
"cache-box.ss")
|
||||
racket/list
|
||||
"gvector.rkt"
|
||||
"../base.rkt"
|
||||
"interfaces.rkt"
|
||||
"cache-box.rkt")
|
||||
(provide case-result%
|
||||
suite-result%)
|
||||
|
||||
|
|
@ -1,14 +1,14 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
#lang racket/base
|
||||
(require racket/class
|
||||
unstable/class-iop
|
||||
scheme/list
|
||||
scheme/gui
|
||||
scheme/match
|
||||
scheme/file
|
||||
racket/list
|
||||
racket/gui
|
||||
racket/match
|
||||
racket/file
|
||||
mrlib/include-bitmap
|
||||
(prefix-in drlink: "drscheme-ui.ss")
|
||||
"interfaces.ss"
|
||||
"config.ss")
|
||||
(prefix-in drlink: "drracket-ui.rkt")
|
||||
"interfaces.rkt"
|
||||
"config.rkt")
|
||||
(provide model-renderer%
|
||||
output-icon)
|
||||
|
||||
|
|
@ -404,12 +404,12 @@
|
|||
(put '() " ")
|
||||
(put+click '(clickback)
|
||||
(lambda _ (drlink:show-errortrace-backtrace exn))
|
||||
"[from DrScheme]"))
|
||||
"[from DrRacket]"))
|
||||
(when (drlink:has-primitive-backtrace? exn)
|
||||
(put '() " ")
|
||||
(put+click '(clickback)
|
||||
(lambda _ (drlink:show-primitive-backtrace exn))
|
||||
"[from mzscheme]")))
|
||||
"[from racket]")))
|
||||
|
||||
(define/private (render-output model)
|
||||
(let [(output (send/i model case<%> get-output))]
|
||||
|
Before Width: | Height: | Size: 513 B After Width: | Height: | Size: 513 B |
|
|
@ -1,13 +1,13 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
#lang racket/base
|
||||
(require racket/class
|
||||
unstable/class-iop
|
||||
scheme/gui
|
||||
racket/gui
|
||||
framework
|
||||
"interfaces.ss")
|
||||
"interfaces.rkt")
|
||||
|
||||
(provide insert-text
|
||||
ext:text%
|
||||
schemeunit-style-map)
|
||||
rktunit-style-map)
|
||||
|
||||
;; insert-text : text% string style-delta% -> void
|
||||
(define (insert-text e text style)
|
||||
|
|
@ -20,7 +20,7 @@
|
|||
|
||||
(define ext:text-mixin
|
||||
(mixin (text<%>) ()
|
||||
(init-field (style-map schemeunit-style-map))
|
||||
(init-field (style-map rktunit-style-map))
|
||||
(inherit last-position
|
||||
change-style
|
||||
set-clickback
|
||||
|
|
@ -139,7 +139,7 @@
|
|||
[error . ,style:red]
|
||||
[value . ,style:darkblue]))
|
||||
|
||||
(define schemeunit-styles
|
||||
(define rktunit-styles
|
||||
`([test-unexecuted . ,style:gray]
|
||||
[test-success . ,style:green]
|
||||
[test-failure . ,style:red]
|
||||
|
|
@ -181,7 +181,7 @@
|
|||
(extend-style-map empty-style-map
|
||||
basic-styles))
|
||||
|
||||
;; schemeunit-style-map : style-map<%>
|
||||
(define schemeunit-style-map
|
||||
;; rktunit-style-map : style-map<%>
|
||||
(define rktunit-style-map
|
||||
(extend-style-map basic-style-map
|
||||
schemeunit-styles))
|
||||
rktunit-styles))
|
||||
|
|
@ -1,19 +1,19 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
#lang racket/base
|
||||
(require racket/class
|
||||
unstable/class-iop
|
||||
scheme/list
|
||||
scheme/gui
|
||||
racket/list
|
||||
racket/gui
|
||||
framework
|
||||
mrlib/hierlist
|
||||
"interfaces.ss"
|
||||
"config.ss"
|
||||
"model2rml.ss"
|
||||
"rml.ss")
|
||||
"interfaces.rkt"
|
||||
"config.rkt"
|
||||
"model2rml.rkt"
|
||||
"rml.rkt")
|
||||
|
||||
(provide make-view-frame
|
||||
view%)
|
||||
|
||||
(define style-map schemeunit-style-map)
|
||||
(define style-map rktunit-style-map)
|
||||
|
||||
#|
|
||||
|
||||
|
|
@ -50,7 +50,7 @@ still be there, just not visible?
|
|||
controller)
|
||||
(super-new)
|
||||
|
||||
(define editor (new ext:text% (style-map schemeunit-style-map)))
|
||||
(define editor (new ext:text% (style-map rktunit-style-map)))
|
||||
(define renderer
|
||||
(new model-renderer%
|
||||
(controller controller)
|
||||
|
|
@ -146,7 +146,7 @@ still be there, just not visible?
|
|||
;; If the view-link has not been created,
|
||||
;; yield until it is.
|
||||
(unless (yield)
|
||||
(error 'schemeunit-gui
|
||||
(error 'rktunit-gui
|
||||
"internal error: no progress waiting for view-link"))
|
||||
(do-model-update model)])))
|
||||
|
||||
|
|
@ -26,9 +26,9 @@
|
|||
;;
|
||||
;; Commentary:
|
||||
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require "monad.ss")
|
||||
(require "monad.rkt")
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require scheme/list)
|
||||
(require racket/list)
|
||||
|
||||
(provide location-source
|
||||
location-line
|
||||
|
|
@ -26,7 +26,7 @@
|
|||
;;
|
||||
;; Commentary:
|
||||
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
||||
|
|
@ -26,11 +26,11 @@
|
|||
;;
|
||||
;; Commentary:
|
||||
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require "base.ss"
|
||||
"monad.ss"
|
||||
"hash-monad.ss"
|
||||
(require "base.rkt"
|
||||
"monad.rkt"
|
||||
"hash-monad.rkt"
|
||||
srfi/1)
|
||||
|
||||
(provide display-test-case-name
|
||||
|
|
@ -26,10 +26,10 @@
|
|||
;;
|
||||
;; Commentary:
|
||||
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require "base.ss"
|
||||
"test-suite.ss")
|
||||
(require "base.rkt"
|
||||
"test-suite.rkt")
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
||||
|
|
@ -51,12 +51,12 @@
|
|||
;; data so FP is a bit ugly].
|
||||
(define (foldts fdown fup fhere seed test)
|
||||
(cond
|
||||
((schemeunit-test-case? test)
|
||||
((rktunit-test-case? test)
|
||||
(fhere test
|
||||
(schemeunit-test-case-name test)
|
||||
(schemeunit-test-case-action test)
|
||||
(rktunit-test-case-name test)
|
||||
(rktunit-test-case-action test)
|
||||
seed))
|
||||
((schemeunit-test-suite? test)
|
||||
((rktunit-test-suite? test)
|
||||
(apply-test-suite test fdown fup fhere seed))
|
||||
(else
|
||||
(raise
|
||||
|
|
@ -1,10 +1,10 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require (for-syntax scheme/base)
|
||||
"base.ss"
|
||||
"format.ss"
|
||||
"check-info.ss"
|
||||
"check.ss")
|
||||
(require (for-syntax racket/base)
|
||||
"base.rkt"
|
||||
"format.rkt"
|
||||
"check-info.rkt"
|
||||
"check.rkt")
|
||||
|
||||
(provide current-test-name
|
||||
current-test-case-around
|
||||
|
|
@ -1,9 +1,9 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require (for-syntax scheme/base)
|
||||
"base.ss"
|
||||
"test-case.ss"
|
||||
"check.ss")
|
||||
(require (for-syntax racket/base)
|
||||
"base.rkt"
|
||||
"test-case.rkt"
|
||||
"check.rkt")
|
||||
|
||||
(provide test-suite
|
||||
test-suite-test-case-around
|
||||
|
|
@ -27,14 +27,14 @@
|
|||
(define (test-suite-test-case-around fhere)
|
||||
(lambda (thunk)
|
||||
(let* ([name (current-test-name)]
|
||||
[test (make-schemeunit-test-case name thunk)]
|
||||
[test (make-rktunit-test-case name thunk)]
|
||||
[seed (current-seed)])
|
||||
(current-seed (fhere test name thunk seed)))))
|
||||
|
||||
(define (test-suite-check-around fhere)
|
||||
(lambda (thunk)
|
||||
(let* ([name #f]
|
||||
[test (make-schemeunit-test-case name thunk)]
|
||||
[test (make-rktunit-test-case name thunk)]
|
||||
[seed (current-seed)])
|
||||
(current-seed (fhere test name thunk seed)))))
|
||||
|
||||
|
|
@ -42,12 +42,12 @@
|
|||
(define delayed-test-case-around
|
||||
(lambda (thunk)
|
||||
(let ([name (current-test-name)])
|
||||
(make-schemeunit-test-case name thunk))))
|
||||
(make-rktunit-test-case name thunk))))
|
||||
|
||||
(define delayed-check-around
|
||||
(lambda (thunk)
|
||||
(let ([name #f])
|
||||
(make-schemeunit-test-case name thunk))))
|
||||
(make-rktunit-test-case name thunk))))
|
||||
|
||||
(define-syntax delay-test
|
||||
(syntax-rules ()
|
||||
|
|
@ -58,12 +58,12 @@
|
|||
test test1 ...)]))
|
||||
|
||||
(define (apply-test-suite suite fdown fup fhere seed)
|
||||
(let* ([name (schemeunit-test-suite-name suite)]
|
||||
[tests (schemeunit-test-suite-tests suite)]
|
||||
[before (schemeunit-test-suite-before suite)]
|
||||
[after (schemeunit-test-suite-after suite)]
|
||||
(let* ([name (rktunit-test-suite-name suite)]
|
||||
[tests (rktunit-test-suite-tests suite)]
|
||||
[before (rktunit-test-suite-before suite)]
|
||||
[after (rktunit-test-suite-after suite)]
|
||||
[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)))
|
||||
|
||||
;; test-suite : name [#:before thunk] [#:after thunk] test ...
|
||||
|
|
@ -84,7 +84,7 @@
|
|||
[the-tests
|
||||
(lambda (fdown fup fhere seed)
|
||||
(define (run/inner x)
|
||||
(cond [(schemeunit-test-suite? x)
|
||||
(cond [(rktunit-test-suite? x)
|
||||
(current-seed
|
||||
(apply-test-suite x fdown fup fhere (current-seed)))]
|
||||
[(list? x)
|
||||
|
|
@ -103,7 +103,7 @@
|
|||
[(not (string? the-name))
|
||||
(raise-type-error 'test-suite "test-suite name as string" the-name)]
|
||||
[else
|
||||
(make-schemeunit-test-suite
|
||||
(make-rktunit-test-suite
|
||||
the-name
|
||||
the-tests
|
||||
before-thunk
|
||||
|
|
@ -138,13 +138,13 @@
|
|||
(for-each
|
||||
(lambda (t)
|
||||
(cond
|
||||
[(schemeunit-test-suite? t)
|
||||
[(rktunit-test-suite? t)
|
||||
(current-seed (apply-test-suite t fdown fup fhere (current-seed)))]
|
||||
[(schemeunit-test-case? t)
|
||||
[(rktunit-test-case? t)
|
||||
(current-seed
|
||||
(fhere t
|
||||
(schemeunit-test-case-name t)
|
||||
(schemeunit-test-case-action t)
|
||||
(rktunit-test-case-name t)
|
||||
(rktunit-test-case-action t)
|
||||
(current-seed)))]
|
||||
[else
|
||||
(raise
|
||||
|
|
@ -158,7 +158,7 @@
|
|||
;;
|
||||
;; Construct a test suite from a list of 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)
|
||||
before
|
||||
after))
|
||||
|
|
@ -1,13 +1,13 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require (for-syntax scheme/base)
|
||||
"base.ss"
|
||||
"check.ss"
|
||||
"check-info.ss"
|
||||
"result.ss"
|
||||
"test-case.ss"
|
||||
"test-suite.ss"
|
||||
"util.ss")
|
||||
(require (for-syntax racket/base)
|
||||
"base.rkt"
|
||||
"check.rkt"
|
||||
"check-info.rkt"
|
||||
"result.rkt"
|
||||
"test-case.rkt"
|
||||
"test-suite.rkt"
|
||||
"util.rkt")
|
||||
|
||||
(provide (struct-out exn:test:check)
|
||||
(struct-out check-info)
|
||||
|
|
@ -15,8 +15,8 @@
|
|||
(struct-out test-failure)
|
||||
(struct-out test-error)
|
||||
(struct-out test-success)
|
||||
(struct-out schemeunit-test-case)
|
||||
(struct-out schemeunit-test-suite)
|
||||
(struct-out rktunit-test-case)
|
||||
(struct-out rktunit-test-suite)
|
||||
|
||||
with-check-info
|
||||
with-check-info*
|
||||
|
|
@ -42,9 +42,9 @@
|
|||
test-suite
|
||||
make-test-suite
|
||||
delay-test
|
||||
(rename-out [make-schemeunit-test-case make-test-case]
|
||||
[schemeunit-test-case? test-case?]
|
||||
[schemeunit-test-suite? test-suite?])
|
||||
(rename-out [make-rktunit-test-case make-test-case]
|
||||
[rktunit-test-case? test-case?]
|
||||
[rktunit-test-suite? test-suite?])
|
||||
|
||||
define-test-suite
|
||||
define/provide-test-suite
|
||||
|
|
@ -26,7 +26,7 @@
|
|||
;;
|
||||
;; Commentary:
|
||||
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require (only-in srfi/13 string-contains string-drop))
|
||||
|
||||
|
|
@ -26,13 +26,13 @@
|
|||
;;
|
||||
;; Commentary:
|
||||
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require (for-syntax scheme/base)
|
||||
(require (for-syntax racket/base)
|
||||
mzlib/etc
|
||||
"check.ss"
|
||||
"test-suite.ss"
|
||||
"test-case.ss")
|
||||
"check.rkt"
|
||||
"test-suite.rkt"
|
||||
"test-case.rkt")
|
||||
|
||||
(provide require/expose
|
||||
test-suite*
|
||||
|
|
@ -41,7 +41,7 @@
|
|||
;; Requires a module and exposes some of its unprovided
|
||||
;; (non-syntax!) identifiers.
|
||||
;; 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
|
||||
;; identifiers that you wish to expose in the current
|
||||
;; module.
|
||||
|
|
@ -1,18 +1,18 @@
|
|||
#lang scribble/doc
|
||||
@(require "base.ss")
|
||||
@(require "base.rkt")
|
||||
|
||||
@title{Acknowlegements}
|
||||
|
||||
The following people have contributed to SchemeUnit:
|
||||
The following people have contributed to RktUnit:
|
||||
|
||||
@itemize[
|
||||
@item{Robby Findler pushed me to release version 3}
|
||||
|
||||
@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
|
||||
suggested improvements to SchemeUnit}
|
||||
suggested improvements to RktUnit}
|
||||
|
||||
@item{Danny Yoo reported a bug in and provided a fix for
|
||||
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
|
||||
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}
|
||||
|
||||
@item{Don Blaheta provided the method for grabbing line number
|
||||
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
|
||||
testing framework thing}
|
||||
|
|
@ -1,10 +1,10 @@
|
|||
#lang scribble/doc
|
||||
@(require "base.ss")
|
||||
@(require "base.rkt")
|
||||
|
||||
@title[#:tag "api"]{SchemeUnit API}
|
||||
@title[#:tag "api"]{RktUnit API}
|
||||
|
||||
@defmodule[schemeunit
|
||||
#:use-sources (schemeunit)]
|
||||
@defmodule[rktunit
|
||||
#:use-sources (rktunit)]
|
||||
|
||||
@include-section["overview.scrbl"]
|
||||
@include-section["check.scrbl"]
|
||||
|
|
@ -6,15 +6,15 @@
|
|||
|
||||
(for-label scheme/base
|
||||
scheme/contract
|
||||
schemeunit
|
||||
schemeunit/text-ui
|
||||
schemeunit/gui))
|
||||
rktunit
|
||||
rktunit/text-ui
|
||||
rktunit/gui))
|
||||
|
||||
(provide
|
||||
(all-from-out scribble/eval
|
||||
scribble/manual)
|
||||
(for-label (all-from-out scheme/base
|
||||
scheme/contract
|
||||
schemeunit
|
||||
schemeunit/text-ui
|
||||
schemeunit/gui)))
|
||||
rktunit
|
||||
rktunit/text-ui
|
||||
rktunit/gui)))
|
||||
|
|
@ -1,12 +1,12 @@
|
|||
#lang scribble/doc
|
||||
@(require "base.ss")
|
||||
@(require "base.rkt")
|
||||
|
||||
@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
|
||||
evaluates to @scheme[#t]. If the condition doesn't hold the
|
||||
check raises an instance of @scheme[exn:test:check] with
|
||||
evaluates to @racket[#t]. If the condition doesn't hold the
|
||||
check raises an instance of @racket[exn:test:check] with
|
||||
information detailing the failure.
|
||||
|
||||
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
|
||||
source locations if you do so.
|
||||
|
||||
The following are the basic checks SchemeUnit provides. You
|
||||
can create your own checks using @scheme[define-check].
|
||||
The following are the basic checks RktUnit provides. You
|
||||
can create your own checks using @racket[define-check].
|
||||
|
||||
@defproc[(check (op (-> any any any))
|
||||
(v1 any)
|
||||
|
|
@ -25,11 +25,11 @@ can create your own checks using @scheme[define-check].
|
|||
(message string? ""))
|
||||
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:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(check < 2 3)
|
||||
]
|
||||
|
||||
|
|
@ -39,14 +39,14 @@ For example, the following check succeeds:
|
|||
[(check-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?],
|
||||
@scheme[eqv?], or @scheme[equal?] to @scheme[v2]. The
|
||||
optional @scheme[message] is included in the output if the
|
||||
Checks that @racket[v1] is (not) @racket[eq?],
|
||||
@racket[eqv?], or @racket[equal?] to @racket[v2]. The
|
||||
optional @racket[message] is included in the output if the
|
||||
check fails.}
|
||||
|
||||
For example, the following checks all fail:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(check-eq? (list 1) (list 1) "allocated data not eq?")
|
||||
(check-not-eq? 1 1 "integers are eq?")
|
||||
(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? ""))
|
||||
#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:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(check-pred string? "I work")
|
||||
(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]{
|
||||
|
||||
Checks that @scheme[v1] and @scheme[v2] are within
|
||||
@scheme[epsilon] of one another. The optional
|
||||
@scheme[message] is included in the output if the check
|
||||
Checks that @racket[v1] and @racket[v2] are within
|
||||
@racket[epsilon] of one another. The optional
|
||||
@racket[message] is included in the output if the check
|
||||
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.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-not-false (v any) (message string? "")) #t])]{
|
||||
|
||||
Checks that @scheme[v] is @scheme[#t], @scheme[#f], or not
|
||||
@scheme[#f] as appropriate. The optional @scheme[message]
|
||||
Checks that @racket[v] is @racket[#t], @racket[#f], or not
|
||||
@racket[#f] as appropriate. The optional @racket[message]
|
||||
is included in the output if the check fails.}
|
||||
|
||||
For example, the following checks all fail:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(check-true 1)
|
||||
(check-false 1)
|
||||
(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? ""))
|
||||
#t]{
|
||||
|
||||
Checks that @scheme[thunk] raises an exception for which
|
||||
@scheme[exn-predicate] returns @scheme[#t]. The optional
|
||||
@scheme[message] is included in the output if the check
|
||||
Checks that @racket[thunk] raises an exception for which
|
||||
@racket[exn-predicate] returns @racket[#t]. The optional
|
||||
@racket[message] is included in the output if the check
|
||||
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.}
|
||||
|
||||
Here are two example, one showing a test that succeeds, and one showing a common error:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(check-exn exn?
|
||||
(lambda ()
|
||||
(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]{
|
||||
|
||||
Checks that @scheme[thunk] does not raise any exceptions.
|
||||
The optional @scheme[message] is included in the output if
|
||||
Checks that @racket[thunk] does not raise any exceptions.
|
||||
The optional @racket[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 @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:
|
||||
|
||||
@schemeblock[(check-regexp-match "a+bba" "aaaaaabba")]
|
||||
@racketblock[(check-regexp-match "a+bba" "aaaaaabba")]
|
||||
|
||||
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
|
||||
expression the check is called with, and the parameters to
|
||||
the check. Additional information can be stored by using
|
||||
the @scheme[with-check-info*] function, and the
|
||||
@scheme[with-check-info] macro.
|
||||
the @racket[with-check-info*] function, and the
|
||||
@racket[with-check-info] macro.
|
||||
|
||||
@defstruct[check-info ([name symbol?] [value any])]{
|
||||
|
||||
|
|
@ -170,13 +170,13 @@ misspelling errors:
|
|||
|
||||
@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
|
||||
@scheme[thunk]}
|
||||
@racket[thunk]}
|
||||
|
||||
Example:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(with-check-info*
|
||||
(list (make-check-info 'time (current-seconds)))
|
||||
(lambda () (check = 1 2)))
|
||||
|
|
@ -191,14 +191,14 @@ check failure.
|
|||
|
||||
@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
|
||||
of the execution of the body expressions. @scheme[Name] is
|
||||
a quoted symbol and @scheme[val] is any value.}
|
||||
of the execution of the body expressions. @racket[Name] is
|
||||
a quoted symbol and @racket[val] is any value.}
|
||||
|
||||
Example:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(for-each
|
||||
(lambda (elt)
|
||||
(with-check-info
|
||||
|
|
@ -218,7 +218,7 @@ check failure.
|
|||
|
||||
@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
|
||||
to understand a few details about a check's evaluation
|
||||
model.
|
||||
|
|
@ -229,17 +229,17 @@ always evaluate their arguments exactly once before
|
|||
executing any expressions in the body of the checks. Hence
|
||||
if you wish to write checks that evalute user defined code
|
||||
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.
|
||||
|
||||
It is also useful to understand how the check information
|
||||
stack operates. The stack is stored in a parameter and the
|
||||
@scheme[with-check-info] forms evaluate to calls to
|
||||
@scheme[parameterize]. Hence check information has lexical
|
||||
@racket[with-check-info] forms evaluate to calls to
|
||||
@racket[parameterize]. Hence check information has lexical
|
||||
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
|
||||
@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
|
||||
values of the parameters. Additionally the macro forms of
|
||||
checks grab location information and the expressions passed
|
||||
|
|
@ -247,26 +247,26 @@ as parameters.
|
|||
|
||||
@defform[(define-simple-check (name param ...) expr ...)]{
|
||||
|
||||
The @scheme[define-simple-check] macro constructs a check
|
||||
called @scheme[name] that takes the params and an optional
|
||||
message as arguments and evaluates the @scheme[expr]s. The
|
||||
check fails if the result of the @scheme[expr]s is
|
||||
@scheme[#f]. Otherwise the check succeeds. Note that
|
||||
The @racket[define-simple-check] macro constructs a check
|
||||
called @racket[name] that takes the params and an optional
|
||||
message as arguments and evaluates the @racket[expr]s. The
|
||||
check fails if the result of the @racket[expr]s is
|
||||
@racket[#f]. Otherwise the check succeeds. Note that
|
||||
simple checks cannot report extra information using
|
||||
@scheme[with-check-info].}
|
||||
@racket[with-check-info].}
|
||||
|
||||
Example:
|
||||
|
||||
To define a check @scheme[check-odd?]
|
||||
To define a check @racket[check-odd?]
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(define-simple-check (check-odd? number)
|
||||
(odd? number))
|
||||
]
|
||||
|
||||
We can use these checks in the usual way:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(check-odd? 3) (code:comment "Success")
|
||||
(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))
|
||||
(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
|
||||
@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
|
||||
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:
|
||||
|
|
@ -287,13 +287,13 @@ Examples:
|
|||
Here's the first form, where we use a predefined predicate
|
||||
to construct a binary check:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(define-binary-check (check-char=? char=? actual expected))
|
||||
]
|
||||
|
||||
In use:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(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
|
||||
tests a number if within 0.01 of the expected value:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(define-binary-check (check-in-tolerance actual expected)
|
||||
(< (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 ...)]{
|
||||
|
||||
The @scheme[define-check] macro acts in exactly the same way
|
||||
as @scheme[define-simple-check], except the check only fails
|
||||
if the macro @scheme[fail-check] is called in the body of
|
||||
The @racket[define-check] macro acts in exactly the same way
|
||||
as @racket[define-simple-check], except the check only fails
|
||||
if the macro @racket[fail-check] is called in the body of
|
||||
the check. This allows more flexible checks, and in
|
||||
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.}
|
||||
|
||||
|
||||
@section{The Check Evaluation Context}
|
||||
|
||||
The semantics of checks are determined by the parameters
|
||||
@scheme[current-check-around] and
|
||||
@scheme[current-check-handler]. Other testing form such as
|
||||
@scheme[test-begin] and @scheme[test-suite] change the value
|
||||
@racket[current-check-around] and
|
||||
@racket[current-check-handler]. Other testing form such as
|
||||
@racket[test-begin] and @racket[test-suite] change the value
|
||||
of these parameters.
|
||||
|
||||
@defparam[current-check-handler handler (-> any/c any/c)]{
|
||||
|
|
@ -338,8 +338,8 @@ trace. }
|
|||
|
||||
Parameter containing the function that handles the execution
|
||||
of checks. The default value wraps the evaluation of
|
||||
@scheme[thunk] in a @scheme[with-handlers] call that calls
|
||||
@scheme[current-check-handler] if an exception is raised and then
|
||||
@racket[thunk] in a @racket[with-handlers] call that calls
|
||||
@racket[current-check-handler] if an exception is raised and then
|
||||
(when an exception is not raised) discards the result, returning
|
||||
@scheme[(void)].
|
||||
@racket[(void)].
|
||||
}
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scribble/doc
|
||||
@(require "base.ss")
|
||||
@(require "base.rkt")
|
||||
|
||||
@title{Compound Testing Forms}
|
||||
|
||||
|
|
@ -15,14 +15,14 @@ will not be evaluated.
|
|||
|
||||
@defform[(test-begin expr ...)]{
|
||||
|
||||
A @scheme[test-begin] form groups the @scheme[expr]s into a
|
||||
single unit. If any @scheme[expr] fails the following ones
|
||||
A @racket[test-begin] form groups the @racket[expr]s into a
|
||||
single unit. If any @racket[expr] fails the following ones
|
||||
are not evaluated. }
|
||||
|
||||
For example, in the following code the world is not
|
||||
destroyed as the preceding check fails:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(test-begin
|
||||
(check-eq? 'a 'b)
|
||||
(code:comment "This line won't be run")
|
||||
|
|
@ -31,14 +31,14 @@ destroyed as the preceding check fails:
|
|||
|
||||
@defform[(test-case name expr ...)]{
|
||||
|
||||
Like a @scheme[test-begin] except a name is associated with
|
||||
the group of @scheme[expr]s. The name will be reported if
|
||||
Like a @racket[test-begin] except a name is associated with
|
||||
the group of @racket[expr]s. The name will be reported if
|
||||
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.
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(test-case
|
||||
"Example test"
|
||||
(check-eq? 'a 'b)
|
||||
|
|
@ -48,7 +48,7 @@ so the test can be named.
|
|||
|
||||
|
||||
@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?])]{
|
||||
|
||||
Constructs a test suite with the given name and tests. The
|
||||
tests may be test cases, constructed using @scheme[test-begin] or
|
||||
@scheme[test-case], or other test suites.
|
||||
tests may be test cases, constructed using @racket[test-begin] or
|
||||
@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
|
||||
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
|
||||
finished.
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(test-suite
|
||||
"An example suite"
|
||||
#:before (lambda () (display "Before"))
|
||||
|
|
@ -103,13 +103,13 @@ finished.
|
|||
[#:after after-thunk (-> any) void])
|
||||
test-suite?]{
|
||||
|
||||
Constructs a test suite with the given @scheme[name] containing the
|
||||
given @scheme[tests]. Unlike the @scheme[test-suite] form, the tests
|
||||
Constructs a test suite with the given @racket[name] containing the
|
||||
given @racket[tests]. Unlike the @racket[test-suite] form, the tests
|
||||
are represented as a list of test values.
|
||||
}
|
||||
|
||||
@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:
|
||||
|
||||
@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
|
||||
it to the same name.}
|
||||
|
||||
For example, this code creates a binding for the name
|
||||
@scheme[example-suite] as well as creating a test suite with
|
||||
the name @scheme["example-suite"]:
|
||||
@racket[example-suite] as well as creating a test suite with
|
||||
the name @racket["example-suite"]:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(define-test-suite example-suite
|
||||
(check = 1 1))
|
||||
]
|
||||
|
||||
@defform[(define/provide-test-suite name test ...)]{ This
|
||||
for is just like @scheme[define-test-suite], and in addition
|
||||
it @scheme[provide]s the test suite.}
|
||||
for is just like @racket[define-test-suite], and in addition
|
||||
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
|
||||
syntax:
|
||||
|
||||
|
|
@ -147,7 +147,7 @@ creates test cases within the suite, with the given names and
|
|||
body expressions.
|
||||
|
||||
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)]{
|
||||
|
||||
This parameter stores the name of the current test case. A
|
||||
value of @scheme[#f] indicates a test case with no name,
|
||||
such as one constructed by @scheme[test-begin]. }
|
||||
value of @racket[#f] indicates a test case with no name,
|
||||
such as one constructed by @racket[test-begin]. }
|
||||
|
||||
@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
|
||||
function of no arguments). The function, when applied,
|
||||
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
|
||||
prints an appropriate message indicating test case failure.}
|
||||
|
||||
@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
|
||||
@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.}
|
||||
|
||||
@defproc[(test-suite-check-around [thunk (-> any/c)]) any/c]{
|
||||
|
||||
The @scheme[current-check-around] parameter is parameterized
|
||||
to this value within the scope of a @scheme[test-suite].
|
||||
The @racket[current-check-around] parameter is parameterized
|
||||
to this value within the scope of a @racket[test-suite].
|
||||
This function creates a test case structure instead of
|
||||
immediately evaluating a check.}
|
||||
|
|
@ -1,28 +1,28 @@
|
|||
#lang scribble/doc
|
||||
@(require "base.ss")
|
||||
@(require "base.rkt")
|
||||
|
||||
@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,
|
||||
after, or around expressions in a test case.
|
||||
|
||||
@defform[(before before-expr expr1 expr2 ...)]{
|
||||
|
||||
Whenever control enters the scope execute the @scheme[before-expr]
|
||||
before executing @scheme[expr-1], and @scheme[expr-2 ...]}
|
||||
Whenever control enters the scope execute the @racket[before-expr]
|
||||
before executing @racket[expr-1], and @racket[expr-2 ...]}
|
||||
|
||||
@defform[(after expr-1 expr-2 ... after-expr)]{
|
||||
|
||||
Whenever control exits the scope execute the @scheme[after-expr]
|
||||
after executing @scheme[expr-1], and @scheme[expr-2 ...] The @scheme[after-expr] is
|
||||
Whenever control exits the scope execute the @racket[after-expr]
|
||||
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.}
|
||||
|
||||
@defform[(around before-expr expr-1 expr-2 ... after-expr)]{
|
||||
|
||||
Whenever control enters the scope execute the
|
||||
@scheme[before-expr] before executing @scheme[expr-1 expr-2
|
||||
...], and execute @scheme[after-expr] whenever control
|
||||
@racket[before-expr] before executing @racket[expr-1 expr-2
|
||||
...], and execute @racket[after-expr] whenever control
|
||||
leaves the scope.}
|
||||
|
||||
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
|
||||
file. The after action deletes it.
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(around
|
||||
(with-output-to-file "test.dat"
|
||||
(lambda ()
|
||||
|
|
@ -46,7 +46,7 @@ file. The after action deletes it.
|
|||
@defform[(delay-test test1 test2 ...)]{
|
||||
|
||||
This somewhat curious macro evaluates the given tests in a
|
||||
context where @scheme[current-test-case-around] is
|
||||
parameterized to @scheme[test-suite-test-case-around]. This
|
||||
has been useful in testing SchemeUnit. It might be useful
|
||||
context where @racket[current-test-case-around] is
|
||||
parameterized to @racket[test-suite-test-case-around]. This
|
||||
has been useful in testing RktUnit. It might be useful
|
||||
for you if you create test cases that create test cases.}
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require schemeunit
|
||||
"file.scm")
|
||||
(require rktunit
|
||||
"file.rkt")
|
||||
|
||||
(check-equal? (my-+ 1 1) 2)
|
||||
(check-equal? (my-* 1 2) 2)
|
||||
21
collects/rktunit/scribblings/misc.scrbl
Normal file
21
collects/rktunit/scribblings/misc.scrbl
Normal 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))
|
||||
]
|
||||
|
|
@ -1,9 +1,9 @@
|
|||
#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[
|
||||
|
||||
|
|
@ -1,10 +1,10 @@
|
|||
#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
|
||||
the evolution of the program under testing. SchemeUnit
|
||||
RktUnit is designed to allow tests to evolve in step with
|
||||
the evolution of the program under testing. RktUnit
|
||||
scales from the unstructed checks suitable for simple
|
||||
programs to the complex structure necessary for large
|
||||
projects.
|
||||
|
|
@ -19,23 +19,23 @@ For example, a HtDP student may be writing simple list
|
|||
functions such as length, and the properties they are
|
||||
checking are of the form:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(equal? (length null) 0)
|
||||
(equal? (length '(a)) 1)
|
||||
(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
|
||||
written in SchemeUnit as:
|
||||
written in RktUnit as:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(check-equal? (length null) 0)
|
||||
(check-equal? (length '(a)) 1)
|
||||
(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.
|
||||
|
||||
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
|
||||
to group expressions so that a failure in one group causes
|
||||
evaluation of that group to stop and immediately proceed to
|
||||
the next group. In SchemeUnit all that is required is to
|
||||
wrap a @scheme[test-begin] expression around a group of
|
||||
the next group. In RktUnit all that is required is to
|
||||
wrap a @racket[test-begin] expression around a group of
|
||||
expressions:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(test-begin
|
||||
(setup-some-state!)
|
||||
(check-equal? (foo! 1) 'expected-value-1)
|
||||
(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
|
||||
be evaluated.
|
||||
|
||||
Notice that all the previous tests written in the simple
|
||||
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.
|
||||
|
||||
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:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(test-case
|
||||
"The name"
|
||||
... test expressions ...)
|
||||
|
|
@ -79,7 +79,7 @@ Most programs will stick with this style. However,
|
|||
programmers writing very complex programs may wish to
|
||||
maintain separate groups of tests for different parts of the
|
||||
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
|
||||
be displayed on a website to indicate service quality). For
|
||||
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
|
||||
around their tests:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(test-suite
|
||||
"Suite name"
|
||||
(check ...)
|
||||
|
|
@ -104,15 +104,15 @@ outside the suite continue to evaluate as before.
|
|||
@section{Historical Context}
|
||||
|
||||
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,
|
||||
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
|
||||
languages. That this is insufficient for all users is
|
||||
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
|
||||
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
|
||||
the testing style of all levels of programmer.
|
||||
|
|
@ -1,14 +1,14 @@
|
|||
#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
|
||||
implements buggy versions of @scheme[+] and @scheme[-]
|
||||
called @scheme[my-+] and @scheme[my--]:
|
||||
Suppose we have code contained in @tt{file.rkt}, which
|
||||
implements buggy versions of @racket[+] and @racket[-]
|
||||
called @racket[my-+] and @racket[my--]:
|
||||
|
||||
@schememod[
|
||||
scheme/base
|
||||
@racketmod[
|
||||
racket/base
|
||||
|
||||
(define (my-+ a b)
|
||||
(if (zero? a)
|
||||
|
|
@ -24,26 +24,26 @@ scheme/base
|
|||
my-*)
|
||||
]
|
||||
|
||||
We want to test this code with SchemeUnit. We start by
|
||||
creating a file called @tt{file-test.scm} to contain our
|
||||
tests. At the top of @tt{file-test.scm} we import
|
||||
SchemeUnit and @tt{file.scm}:
|
||||
We want to test this code with RktUnit. We start by
|
||||
creating a file called @tt{file-test.rkt} to contain our
|
||||
tests. At the top of @tt{file-test.rkt} we import
|
||||
RktUnit and @tt{file.rkt}:
|
||||
|
||||
@schememod[
|
||||
scheme/base
|
||||
@racketmod[
|
||||
racket/base
|
||||
|
||||
(require schemeunit
|
||||
"file.scm")
|
||||
(require rktunit
|
||||
"file.rkt")
|
||||
]
|
||||
|
||||
Now we add some tests to check our library:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(check-equal? (my-+ 1 1) 2 "Simple addition")
|
||||
(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.
|
||||
Here's the result I get:
|
||||
|
||||
|
|
@ -52,7 +52,7 @@ Here's the result I get:
|
|||
--------------------
|
||||
FAILURE
|
||||
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)
|
||||
params: (4 2)
|
||||
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.
|
||||
|
||||
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
|
||||
to look at some features beyond the essentials.
|
||||
|
||||
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
|
||||
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
|
||||
cases. Here's a simple test case written using the
|
||||
@scheme[test-begin] form:
|
||||
@racket[test-begin] form:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(test-begin
|
||||
(let ((lst (list 2 4 6 9)))
|
||||
(check = (length lst) 4)
|
||||
|
|
@ -91,24 +91,24 @@ Evalute this and you should see an error message like:
|
|||
A test
|
||||
... has a FAILURE
|
||||
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)
|
||||
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
|
||||
@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
|
||||
it fails, and no further checks are evaluated once this
|
||||
takes place.
|
||||
|
||||
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
|
||||
@scheme[test-case] form:
|
||||
@racket[test-case] form:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(test-case
|
||||
"List has length 4 and all elements even"
|
||||
(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
|
||||
group them into a test suite:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(define file-tests
|
||||
(test-suite
|
||||
"Tests for file.scm"
|
||||
"Tests for file.rkt"
|
||||
|
||||
(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
|
||||
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
|
||||
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:
|
||||
|
||||
@schemeblock[
|
||||
(require schemeunit/text-ui)
|
||||
@racketblock[
|
||||
(require rktunit/text-ui)
|
||||
|
||||
(run-tests file-tests)
|
||||
]
|
||||
|
|
@ -161,6 +161,6 @@ following lines:
|
|||
Now evaluate the file and you should see similar output
|
||||
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
|
||||
defining your own checks. Have fun!
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scribble/doc
|
||||
@(require "base.ss")
|
||||
@(require "base.rkt")
|
||||
|
||||
@title{Release Notes}
|
||||
|
||||
|
|
@ -12,7 +12,7 @@ There are also miscellaneous Scribble fixes.
|
|||
|
||||
@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
|
||||
underlying model, justifying incrementing the major version
|
||||
number. These changes are best explained in
|
||||
|
|
@ -24,9 +24,9 @@ hopefully be corrected in later minor version releases:
|
|||
@itemize[
|
||||
|
||||
@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
|
||||
have their evaluation delayed by a test suite; other
|
||||
expressions will be evaluated before the suite is
|
||||
|
|
@ -1,13 +1,13 @@
|
|||
#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+email "Ryan Culpepper" "ryan_sml@yahoo.com")]
|
||||
|
||||
SchemeUnit is a unit-testing framework for PLT Scheme. It
|
||||
is designed to handle the needs of all Scheme programmers,
|
||||
RktUnit is a unit-testing framework for Racket. It
|
||||
is designed to handle the needs of all Racket programmers,
|
||||
from novices to experts.
|
||||
|
||||
@table-of-contents[]
|
||||
|
|
@ -1,29 +1,29 @@
|
|||
#lang scribble/doc
|
||||
@(require "base.ss")
|
||||
@(require "base.rkt")
|
||||
|
||||
@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.
|
||||
|
||||
@section{Result Types}
|
||||
|
||||
@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
|
||||
documented below.}
|
||||
|
||||
@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
|
||||
time of failure.}
|
||||
|
||||
@defstruct[test-result ([test-case-name (or/c string #f)])]{
|
||||
|
||||
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])]{
|
||||
|
||||
|
|
@ -54,7 +54,7 @@ tree (list of lists) of results}
|
|||
|
||||
Example:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(run-test
|
||||
(test-suite
|
||||
"Dummy"
|
||||
|
|
@ -69,22 +69,22 @@ Example:
|
|||
[#:fup fup (string 'a . -> . 'a)])
|
||||
'a]{
|
||||
|
||||
Fold @scheme[result-fn] pre-order left-to-right depth-first
|
||||
over the results of @scheme[run]. By default @scheme[run]
|
||||
is @scheme[run-test-case] and @scheme[fdown] and
|
||||
@scheme[fup] just return the seed, so @scheme[result-fn] is
|
||||
Fold @racket[result-fn] pre-order left-to-right depth-first
|
||||
over the results of @racket[run]. By default @racket[run]
|
||||
is @racket[run-test-case] and @racket[fdown] and
|
||||
@racket[fup] just return the seed, so @racket[result-fn] is
|
||||
folded over the test results.
|
||||
|
||||
This function is useful for writing custom folds (and hence
|
||||
UIs) over test results without you having to take care of
|
||||
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,
|
||||
via its keyword arguments, to do almost anything that foldts
|
||||
can. Hence it should be used in preference to foldts.
|
||||
|
||||
@scheme[result-fn] is a function from the results of
|
||||
@scheme[run] (defaults to a @scheme[test-result]) and the
|
||||
@racket[result-fn] is a function from the results of
|
||||
@racket[run] (defaults to a @racket[test-result]) and the
|
||||
seed to a new seed
|
||||
|
||||
Seed is any value
|
||||
|
|
@ -104,7 +104,7 @@ Examples:
|
|||
|
||||
The following code counts the number of successes
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(define (count-successes test)
|
||||
(fold-test-results
|
||||
(lambda (result seed)
|
||||
|
|
@ -114,11 +114,11 @@ The following code counts the number of successes
|
|||
0
|
||||
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
|
||||
value of run.
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(define (burp test)
|
||||
(fold-test-results
|
||||
(lambda (result seed) (cons result seed))
|
||||
|
|
@ -159,7 +159,7 @@ Example:
|
|||
Here's the implementation of fold-test-results in terms of
|
||||
foldts:
|
||||
|
||||
@schemeblock[
|
||||
@racketblock[
|
||||
(define (fold-test-results suite-fn case-fn seed test)
|
||||
(foldts
|
||||
(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
|
||||
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
|
||||
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
|
||||
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.
|
||||
|
|
@ -1,47 +1,47 @@
|
|||
#lang scribble/doc
|
||||
@(require "base.ss")
|
||||
@(require "base.rkt")
|
||||
|
||||
@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}
|
||||
|
||||
@defmodule[schemeunit/text-ui]
|
||||
@defmodule[rktunit/text-ui]
|
||||
|
||||
The textual UI is in the @schememodname[schemeunit/text-ui] module.
|
||||
It is run via the @scheme[run-tests] function.
|
||||
The textual UI is in the @racketmodname[rktunit/text-ui] module.
|
||||
It is run via the @racket[run-tests] function.
|
||||
|
||||
@defproc[(run-tests (test (or/c test-case? test-suite?))
|
||||
(verbosity (symbols 'quiet 'normal 'verbose) 'normal))
|
||||
natural-number/c]{
|
||||
|
||||
The given @scheme[test] is run and the result of running it
|
||||
output to the @scheme[current-output-port]. The output is
|
||||
The given @racket[test] is run and the result of running it
|
||||
output to the @racket[current-output-port]. The output is
|
||||
compatable with the (X)Emacs next-error command (as used,
|
||||
for example, by (X)Emacs's compile function)
|
||||
|
||||
The optional @scheme[verbosity] is one of @scheme['quiet],
|
||||
@scheme['normal], or @scheme['verbose]. Quiet output
|
||||
The optional @racket[verbosity] is one of @racket['quiet],
|
||||
@racket['normal], or @racket['verbose]. Quiet output
|
||||
displays only the number of successes, failures, and errors.
|
||||
Normal reporting suppresses some extraneous check
|
||||
information (such as the expression). Verbose reports all
|
||||
information.
|
||||
|
||||
@scheme[run-tests] returns the number of unsuccessful tests.}
|
||||
@racket[run-tests] returns the number of unsuccessful tests.}
|
||||
|
||||
|
||||
@section{Graphical User Interface}
|
||||
|
||||
@defmodule[schemeunit/gui]
|
||||
@defmodule[rktunit/gui]
|
||||
|
||||
SchemeUnit also provides a GUI test runner, available from the
|
||||
@schememodname[schemeunit/gui] module.
|
||||
RktUnit also provides a GUI test runner, available from the
|
||||
@racketmodname[rktunit/gui] module.
|
||||
|
||||
@defproc[(test/gui [test (or/c test-case? test-suite?)] ...)
|
||||
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.
|
||||
|
||||
}
|
||||
|
|
@ -49,7 +49,7 @@ GUI is updated as tests complete.
|
|||
@defproc[(make-gui-runner)
|
||||
(-> (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.
|
||||
|
||||
}
|
||||
267
collects/rktunit/text-ui.rkt
Normal file
267
collects/rktunit/text-ui.rkt
Normal 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))))))
|
||||
|
||||
|
|
@ -1,19 +1,19 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
scheme/gui
|
||||
#lang racket/base
|
||||
(require racket/class
|
||||
racket/gui
|
||||
framework
|
||||
drscheme/tool
|
||||
scheme/unit
|
||||
(prefix-in drlink: "private/gui/drscheme-link.ss"))
|
||||
racket/unit
|
||||
(prefix-in drlink: "private/gui/drracket-link.rkt"))
|
||||
|
||||
(provide tool@)
|
||||
|
||||
;; CONSTANTS
|
||||
|
||||
(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-source))
|
||||
|
||||
(define drscheme-ns (namespace-anchor->namespace drscheme-ns-anchor))
|
||||
(define drracket-ns (namespace-anchor->namespace drracket-ns-anchor))
|
||||
|
||||
(define interactions-text-mixin
|
||||
(mixin ((class->interface drscheme:rep:text%)) ()
|
||||
|
|
@ -79,7 +79,7 @@
|
|||
(super-new)
|
||||
|
||||
(define/private (setup-helper-module)
|
||||
(namespace-attach-module drscheme-ns
|
||||
(namespace-attach-module drracket-ns
|
||||
LINK-MODULE-SPEC
|
||||
(get-user-namespace)))
|
||||
|
||||
|
|
@ -1,18 +1,3 @@
|
|||
#lang scheme/base
|
||||
(require scheme/contract
|
||||
(rename-in "private/base.ss")
|
||||
"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))])
|
||||
#lang racket
|
||||
(require rktunit/gui)
|
||||
(provide (all-from-out rktunit/gui))
|
||||
|
|
@ -1,13 +1,3 @@
|
|||
#lang setup/infotab
|
||||
|
||||
(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/")
|
||||
(define name "SchemeUnit")
|
||||
|
|
@ -1,31 +1,3 @@
|
|||
;;;
|
||||
;;; 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 scheme/base
|
||||
(require "private/test.ss")
|
||||
(provide (all-from-out "private/test.ss"))
|
||||
#lang racket
|
||||
(require rktunit)
|
||||
(provide (all-from-out rktunit))
|
||||
|
|
@ -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))
|
||||
]
|
||||
|
|
@ -1,267 +1,3 @@
|
|||
;;;
|
||||
;;; 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 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))))))
|
||||
|
||||
#lang racket
|
||||
(require rktunit/text-ui)
|
||||
(provide (all-from-out rktunit/text-ui))
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
#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 'rf "robby" "beverly hills park"))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme
|
||||
(require schemeunit schemeunit/text-ui "2.ss")
|
||||
(require rktunit rktunit/text-ui "2.ss")
|
||||
|
||||
(define s0 (initialize (flat-contract integer?) =))
|
||||
(define s2 (push (push s0 2) 1))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme
|
||||
(require schemeunit schemeunit/text-ui "3.ss")
|
||||
(require rktunit rktunit/text-ui "3.ss")
|
||||
|
||||
(define d0 (initialize (flat-contract integer?) =))
|
||||
(define d (put (put (put d0 'a 2) 'b 2) 'c 1))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#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))
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(provide all-contract-tests)
|
||||
|
||||
(require schemeunit
|
||||
(require rktunit
|
||||
deinprogramm/define-record-procedures
|
||||
deinprogramm/contract/contract
|
||||
deinprogramm/contract/contract-syntax)
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(provide all-image-tests)
|
||||
|
||||
(require schemeunit
|
||||
(require rktunit
|
||||
deinprogramm/image
|
||||
(only-in lang/private/imageeq image=?)
|
||||
mred
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require schemeunit/text-ui)
|
||||
(require rktunit/text-ui)
|
||||
(require tests/deinprogramm/contract)
|
||||
|
||||
(run-tests all-contract-tests)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require schemeunit/text-ui)
|
||||
(require rktunit/text-ui)
|
||||
(require tests/deinprogramm/image)
|
||||
|
||||
(run-tests all-image-tests)
|
||||
|
|
|
|||
|
|
@ -216,7 +216,7 @@
|
|||
=> '(#"1 test passed\n" #"2 tests passed\n")
|
||||
)
|
||||
|
||||
;; SchemeUnit stuff
|
||||
;; RktUnit stuff
|
||||
;; (examples that should fail modified to ones that shouldn't)
|
||||
#|
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require scheme/future
|
||||
schemeunit)
|
||||
rktunit)
|
||||
|
||||
#|Need to add expressions which raise exceptions inside a
|
||||
future thunk which can be caught at the touch site
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#lang racket
|
||||
(require schemeunit
|
||||
schemeunit/text-ui
|
||||
(require rktunit
|
||||
rktunit/text-ui
|
||||
net/url
|
||||
(prefix-in h: html)
|
||||
(prefix-in x: xml))
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@
|
|||
"plot"
|
||||
"profj"
|
||||
"r6rs"
|
||||
"schemeunit"
|
||||
"rktunit"
|
||||
"srfi"
|
||||
"srpersist"
|
||||
"stepper"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#lang scheme/base
|
||||
(require schemeunit
|
||||
schemeunit/gui)
|
||||
(require rktunit
|
||||
rktunit/gui)
|
||||
(require macro-debugger/model/debug
|
||||
"gentest-framework.ss"
|
||||
"gentests.ss"
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require schemeunit)
|
||||
(require rktunit)
|
||||
(require macro-debugger/model/debug
|
||||
macro-debugger/model/stx-util
|
||||
"gentest-framework.ss"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#lang scheme/base
|
||||
(require schemeunit
|
||||
schemeunit/gui)
|
||||
(require rktunit
|
||||
rktunit/gui)
|
||||
(require macro-debugger/model/debug
|
||||
scheme/path
|
||||
scheme/gui)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require schemeunit)
|
||||
(require rktunit)
|
||||
(require macro-debugger/model/debug
|
||||
"../test-setup.ss")
|
||||
(provide specialized-hiding-tests)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require schemeunit)
|
||||
(require rktunit)
|
||||
(require macro-debugger/model/debug
|
||||
"../test-setup.ss")
|
||||
(provide policy-tests)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require schemeunit)
|
||||
(require rktunit)
|
||||
(require macro-debugger/model/debug
|
||||
macro-debugger/model/steps
|
||||
"../test-setup.ss")
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
(for-syntax scheme/base)
|
||||
(prefix-in m: mzlib/match)
|
||||
(only-in srfi/13 string-contains)
|
||||
schemeunit)
|
||||
rktunit)
|
||||
|
||||
(define-syntax (comp stx)
|
||||
(syntax-case stx ()
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
(module match-tests mzscheme
|
||||
(require mzlib/match schemeunit)
|
||||
(require mzlib/match rktunit)
|
||||
|
||||
(provide match-tests)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
(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)
|
||||
|
||||
(define-struct shape (color))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
(module other-tests mzscheme
|
||||
(require mzlib/match schemeunit)
|
||||
(require mzlib/match rktunit)
|
||||
|
||||
(provide other-tests)
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(require (for-syntax scheme/base)
|
||||
"match-tests.ss" "other-plt-tests.ss" "other-tests.ss" "examples.ss"
|
||||
schemeunit schemeunit/text-ui)
|
||||
rktunit rktunit/text-ui)
|
||||
|
||||
(require mzlib/plt-match)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme
|
||||
(require schemeunit
|
||||
(require rktunit
|
||||
plai/random-mutator
|
||||
scheme/runtime-path
|
||||
;; test find-heap-values and save-random-mutator via the contract'd
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
(module contract-opt-tests mzscheme
|
||||
(require mzlib/contract
|
||||
schemeunit
|
||||
schemeunit/text-ui)
|
||||
rktunit
|
||||
rktunit/text-ui)
|
||||
|
||||
(define (exn:fail:contract-violation? exn)
|
||||
(if (regexp-match #rx"broke" (exn-message exn)) #t #f))
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#lang racket
|
||||
|
||||
(require raclog
|
||||
schemeunit)
|
||||
rktunit)
|
||||
|
||||
;The following is the "Biblical" database from "The Art of
|
||||
;Prolog", Sterling & Shapiro, ch. 1.
|
||||
|
|
@ -142,4 +142,4 @@
|
|||
dad-kids)))))
|
||||
|
||||
(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))))))
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#lang racket
|
||||
|
||||
(require raclog
|
||||
schemeunit)
|
||||
rktunit)
|
||||
|
||||
;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
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(require raclog
|
||||
"./puzzle.rkt"
|
||||
schemeunit)
|
||||
rktunit)
|
||||
|
||||
;;This example is from Sterling & Shapiro, p. 214.
|
||||
;;
|
||||
|
|
|
|||
|
|
@ -1,28 +1,28 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require schemeunit
|
||||
"check-test.ss"
|
||||
"check-info-test.ss"
|
||||
"format-test.ss"
|
||||
"test-case-test.ss"
|
||||
"test-suite-test.ss"
|
||||
"base-test.ss"
|
||||
"location-test.ss"
|
||||
"result-test.ss"
|
||||
"test-test.ss"
|
||||
"util-test.ss"
|
||||
"text-ui-test.ss"
|
||||
"monad-test.ss"
|
||||
"hash-monad-test.ss"
|
||||
"counter-test.ss"
|
||||
"text-ui-util-test.ss")
|
||||
(require rktunit
|
||||
"check-test.rkt"
|
||||
"check-info-test.rkt"
|
||||
"format-test.rkt"
|
||||
"test-case-test.rkt"
|
||||
"test-suite-test.rkt"
|
||||
"base-test.rkt"
|
||||
"location-test.rkt"
|
||||
"result-test.rkt"
|
||||
"test-test.rkt"
|
||||
"util-test.rkt"
|
||||
"text-ui-test.rkt"
|
||||
"monad-test.rkt"
|
||||
"hash-monad-test.rkt"
|
||||
"counter-test.rkt"
|
||||
"text-ui-util-test.rkt")
|
||||
|
||||
(provide all-schemeunit-tests
|
||||
(provide all-rktunit-tests
|
||||
failure-tests)
|
||||
|
||||
(define all-schemeunit-tests
|
||||
(define all-rktunit-tests
|
||||
(test-suite
|
||||
"All SchemeUnit Tests"
|
||||
"All RktUnit Tests"
|
||||
check-tests
|
||||
base-tests
|
||||
check-info-tests
|
||||
|
|
@ -26,10 +26,10 @@
|
|||
;;
|
||||
;; Commentary:
|
||||
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require schemeunit
|
||||
schemeunit/private/base)
|
||||
(require rktunit
|
||||
rktunit/private/base)
|
||||
|
||||
(provide base-tests)
|
||||
|
||||
|
|
@ -37,45 +37,45 @@
|
|||
(test-suite
|
||||
"All tests for base"
|
||||
(test-case
|
||||
"schemeunit-test-case structure has a contract on name"
|
||||
"rktunit-test-case structure has a contract on name"
|
||||
(check-exn exn:fail?
|
||||
(lambda ()
|
||||
(make-schemeunit-test-case
|
||||
(make-rktunit-test-case
|
||||
'foo
|
||||
(lambda () #t)))))
|
||||
(test-case
|
||||
"schemeunit-test-case structure has a contract on action"
|
||||
"rktunit-test-case structure has a contract on action"
|
||||
(check-exn exn:fail?
|
||||
(lambda ()
|
||||
(make-schemeunit-test-case
|
||||
(make-rktunit-test-case
|
||||
"Name"
|
||||
#f))))
|
||||
(test-case
|
||||
"schemeunit-test-suite has a contract on its fields"
|
||||
"rktunit-test-suite has a contract on its fields"
|
||||
(check-exn exn:fail?
|
||||
(lambda ()
|
||||
(make-schemeunit-test-suite
|
||||
(make-rktunit-test-suite
|
||||
#f
|
||||
(list)
|
||||
(lambda () 3)
|
||||
(lambda () 2))))
|
||||
(check-exn exn:fail?
|
||||
(lambda ()
|
||||
(make-schemeunit-test-suite
|
||||
(make-rktunit-test-suite
|
||||
"Name"
|
||||
#f
|
||||
(lambda () 3)
|
||||
(lambda () 2))))
|
||||
(check-exn exn:fail?
|
||||
(lambda ()
|
||||
(make-schemeunit-test-suite
|
||||
(make-rktunit-test-suite
|
||||
"Name"
|
||||
(list)
|
||||
#f
|
||||
(lambda () 2))))
|
||||
(check-exn exn:fail?
|
||||
(lambda ()
|
||||
(make-schemeunit-test-suite
|
||||
(make-rktunit-test-suite
|
||||
"Name"
|
||||
(list)
|
||||
(lambda () 3)
|
||||
|
|
@ -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>
|
||||
;;;
|
||||
;;; 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
|
||||
;;; License as published by the Free Software Foundation; either
|
||||
;;; 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
|
||||
;;; 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 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
|
||||
|
||||
;;; Author: Noel Welsh <noelwelsh@yahoo.com>
|
||||
|
|
@ -25,10 +25,10 @@
|
|||
;;
|
||||
;; Commentary:
|
||||
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require schemeunit
|
||||
schemeunit/private/check-info)
|
||||
(require rktunit
|
||||
rktunit/private/check-info)
|
||||
|
||||
(provide check-info-tests)
|
||||
|
||||
|
|
@ -26,14 +26,14 @@
|
|||
;;
|
||||
;; Commentary:
|
||||
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require scheme/runtime-path
|
||||
(require racket/runtime-path
|
||||
srfi/1
|
||||
schemeunit
|
||||
schemeunit/private/check
|
||||
schemeunit/private/result
|
||||
schemeunit/private/test-suite)
|
||||
rktunit
|
||||
rktunit/private/check
|
||||
rktunit/private/result
|
||||
rktunit/private/test-suite)
|
||||
|
||||
(provide check-tests)
|
||||
|
||||
|
|
@ -287,8 +287,8 @@
|
|||
(let ((destns (make-base-namespace))
|
||||
(cns (current-namespace)))
|
||||
(parameterize ((current-namespace destns))
|
||||
(namespace-require '(for-syntax scheme/base))
|
||||
(namespace-require 'schemeunit/private/check)
|
||||
(namespace-require '(for-syntax racket/base))
|
||||
(namespace-require 'rktunit/private/check)
|
||||
;; First check that the right check macro got
|
||||
;; used: ie that it didn't just compile the thing
|
||||
;; as an application.
|
||||
|
|
@ -25,13 +25,13 @@
|
|||
;;
|
||||
;;
|
||||
;; Commentary:
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require scheme/match
|
||||
schemeunit
|
||||
schemeunit/private/counter
|
||||
schemeunit/private/monad
|
||||
schemeunit/private/hash-monad)
|
||||
(require racket/match
|
||||
rktunit
|
||||
rktunit/private/counter
|
||||
rktunit/private/monad
|
||||
rktunit/private/hash-monad)
|
||||
|
||||
(provide counter-tests)
|
||||
|
||||
|
|
@ -1,8 +1,8 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require schemeunit
|
||||
schemeunit/private/check-info
|
||||
schemeunit/private/format)
|
||||
(require rktunit
|
||||
rktunit/private/check-info
|
||||
rktunit/private/format)
|
||||
|
||||
(provide format-tests)
|
||||
|
||||
|
|
@ -26,11 +26,11 @@
|
|||
;;
|
||||
;; Commentary:
|
||||
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require schemeunit
|
||||
schemeunit/private/monad
|
||||
schemeunit/private/hash-monad)
|
||||
(require rktunit
|
||||
rktunit/private/monad
|
||||
rktunit/private/hash-monad)
|
||||
|
||||
(provide hash-monad-tests)
|
||||
|
||||
|
|
@ -25,10 +25,10 @@
|
|||
;;
|
||||
;;
|
||||
;; Commentary:
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require schemeunit
|
||||
schemeunit/private/location)
|
||||
(require rktunit
|
||||
rktunit/private/location)
|
||||
|
||||
(provide location-tests)
|
||||
|
||||
|
|
@ -43,10 +43,10 @@
|
|||
(test-case
|
||||
"syntax->location ok"
|
||||
(around
|
||||
(with-output-to-file "test-file.ss"
|
||||
(lambda () (display "#lang scheme\n'foo\n")))
|
||||
(let* ([stx (read-syntax/lang (string->path "test-file.ss")
|
||||
(open-input-file "test-file.ss"))]
|
||||
(with-output-to-file "test-file.rkt"
|
||||
(lambda () (display "#lang racket\n'foo\n")))
|
||||
(let* ([stx (read-syntax/lang (string->path "test-file.rkt")
|
||||
(open-input-file "test-file.rkt"))]
|
||||
[rep (syntax->location stx)])
|
||||
(check-equal? (location-source rep)
|
||||
(syntax-source stx))
|
||||
|
|
@ -54,7 +54,7 @@
|
|||
(syntax-position stx))
|
||||
(check-equal? (location-span rep)
|
||||
(syntax-span stx)))
|
||||
(delete-file "test-file.ss")))
|
||||
(delete-file "test-file.rkt")))
|
||||
|
||||
(test-case
|
||||
"Emacs compatible location strings"
|
||||
|
|
@ -63,15 +63,15 @@
|
|||
(syntax->location
|
||||
(datum->syntax
|
||||
#f #f
|
||||
(list "file.ss" 42 38 1240 2))))
|
||||
"file.ss:42:38")
|
||||
(list "file.rkt" 42 38 1240 2))))
|
||||
"file.rkt:42:38")
|
||||
(check string=?
|
||||
(location->string
|
||||
(syntax->location
|
||||
(datum->syntax
|
||||
#f #f
|
||||
(list (string->path "file.ss") 42 38 1240 2))))
|
||||
"file.ss:42:38")
|
||||
(list (string->path "file.rkt") 42 38 1240 2))))
|
||||
"file.rkt:42:38")
|
||||
(check string=?
|
||||
(location->string
|
||||
(syntax->location
|
||||
|
|
@ -84,14 +84,14 @@
|
|||
(syntax->location
|
||||
(datum->syntax
|
||||
#f #f
|
||||
(list 'foo.ss 42 38 1240 2))))
|
||||
"foo.ss:42:38")
|
||||
(list 'foo.rkt 42 38 1240 2))))
|
||||
"foo.rkt:42:38")
|
||||
(check string=?
|
||||
(location->string
|
||||
(syntax->location
|
||||
(datum->syntax
|
||||
#f #f
|
||||
(list "foo.ss" #f #f #f #f))))
|
||||
"foo.ss:?:?"))
|
||||
(list "foo.rkt" #f #f #f #f))))
|
||||
"foo.rkt:?:?"))
|
||||
))
|
||||
|
||||
|
|
@ -27,10 +27,10 @@
|
|||
;; Commentary:
|
||||
|
||||
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require schemeunit
|
||||
schemeunit/private/monad)
|
||||
(require rktunit
|
||||
rktunit/private/monad)
|
||||
|
||||
(provide monad-tests)
|
||||
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require schemeunit
|
||||
schemeunit/private/result)
|
||||
(require rktunit
|
||||
rktunit/private/result)
|
||||
|
||||
(provide result-tests)
|
||||
|
||||
|
|
@ -1,10 +1,10 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require schemeunit
|
||||
schemeunit/text-ui
|
||||
"all-schemeunit-tests.ss")
|
||||
(require rktunit
|
||||
rktunit/text-ui
|
||||
"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
|
||||
(parameterize ([current-error-port (current-output-port)]
|
||||
|
|
@ -29,9 +29,9 @@
|
|||
;; part of the standard test suite and must be run
|
||||
;; separately.
|
||||
|
||||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require schemeunit/private/check)
|
||||
(require rktunit/private/check)
|
||||
|
||||
;; This check should succeed
|
||||
(check = 1 1 0.0)
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user