Renaming schemeunit to rktunit and adding compat layer
This commit is contained in:
parent
3b23f74fc7
commit
f70ffca756
|
@ -1,6 +1,6 @@
|
||||||
#lang scheme/load
|
#lang scheme/load
|
||||||
|
|
||||||
(require schemeunit)
|
(require rktunit)
|
||||||
(require 2htdp/batch-io)
|
(require 2htdp/batch-io)
|
||||||
|
|
||||||
(define file "batch-io.txt")
|
(define file "batch-io.txt")
|
||||||
|
|
|
@ -45,7 +45,7 @@
|
||||||
scheme/math
|
scheme/math
|
||||||
scheme/class
|
scheme/class
|
||||||
scheme/gui/base
|
scheme/gui/base
|
||||||
schemeunit
|
rktunit
|
||||||
(prefix-in 1: htdp/image)
|
(prefix-in 1: htdp/image)
|
||||||
(only-in lang/htdp-advanced equal~?))
|
(only-in lang/htdp-advanced equal~?))
|
||||||
|
|
||||||
|
|
|
@ -662,6 +662,7 @@ mz-extras :+= (- (package: "unstable")
|
||||||
;; -------------------- plai
|
;; -------------------- plai
|
||||||
plt-extras :+= (package: "plai/")
|
plt-extras :+= (package: "plai/")
|
||||||
|
|
||||||
|
plt-extras :+= (package: "rktunit/")
|
||||||
plt-extras :+= (package: "schemeunit/")
|
plt-extras :+= (package: "schemeunit/")
|
||||||
|
|
||||||
;; ============================================================================
|
;; ============================================================================
|
||||||
|
|
|
@ -615,26 +615,26 @@
|
||||||
("schematics" "port.plt" 1 0 #f)
|
("schematics" "port.plt" 1 0 #f)
|
||||||
("schematics" "random.plt" 1 0 #f)
|
("schematics" "random.plt" 1 0 #f)
|
||||||
("schematics" "sake.plt" 1 0 "4.0")
|
("schematics" "sake.plt" 1 0 "4.0")
|
||||||
("schematics" "schemeunit.plt" 3 4 "4.0")
|
("schematics" "rktunit.plt" 3 4 "4.0")
|
||||||
("schematics" "schemeunit.plt" 3 3 "4.0")
|
("schematics" "rktunit.plt" 3 3 "4.0")
|
||||||
("schematics" "schemeunit.plt" 3 2 "4.0")
|
("schematics" "rktunit.plt" 3 2 "4.0")
|
||||||
("schematics" "schemeunit.plt" 3 1 "4.0")
|
("schematics" "rktunit.plt" 3 1 "4.0")
|
||||||
("schematics" "schemeunit.plt" 3 0 "4.0")
|
("schematics" "rktunit.plt" 3 0 "4.0")
|
||||||
("schematics" "schemeunit.plt" 2 11 "4.1.0.3")
|
("schematics" "rktunit.plt" 2 11 "4.1.0.3")
|
||||||
("schematics" "schemeunit.plt" 2 10 "369.1")
|
("schematics" "rktunit.plt" 2 10 "369.1")
|
||||||
("schematics" "schemeunit.plt" 2 9 "369.1")
|
("schematics" "rktunit.plt" 2 9 "369.1")
|
||||||
("schematics" "schemeunit.plt" 2 8 "369.1")
|
("schematics" "rktunit.plt" 2 8 "369.1")
|
||||||
("schematics" "schemeunit.plt" 2 7 "369.1")
|
("schematics" "rktunit.plt" 2 7 "369.1")
|
||||||
("schematics" "schemeunit.plt" 2 6 "369.1")
|
("schematics" "rktunit.plt" 2 6 "369.1")
|
||||||
("schematics" "schemeunit.plt" 2 5 "369.1")
|
("schematics" "rktunit.plt" 2 5 "369.1")
|
||||||
("schematics" "schemeunit.plt" 2 4 "369.1")
|
("schematics" "rktunit.plt" 2 4 "369.1")
|
||||||
("schematics" "schemeunit.plt" 2 3 #f)
|
("schematics" "rktunit.plt" 2 3 #f)
|
||||||
("schematics" "schemeunit.plt" 2 2 #f)
|
("schematics" "rktunit.plt" 2 2 #f)
|
||||||
("schematics" "schemeunit.plt" 2 1 #f)
|
("schematics" "rktunit.plt" 2 1 #f)
|
||||||
("schematics" "schemeunit.plt" 2 0 #f)
|
("schematics" "rktunit.plt" 2 0 #f)
|
||||||
("schematics" "schemeunit.plt" 1 2 #f)
|
("schematics" "rktunit.plt" 1 2 #f)
|
||||||
("schematics" "schemeunit.plt" 1 1 #f)
|
("schematics" "rktunit.plt" 1 1 #f)
|
||||||
("schematics" "schemeunit.plt" 1 0 #f)
|
("schematics" "rktunit.plt" 1 0 #f)
|
||||||
("schematics" "si.plt" 1 0 #f)
|
("schematics" "si.plt" 1 0 #f)
|
||||||
("schematics" "spgsql.plt" 2 3 "371.3")
|
("schematics" "spgsql.plt" 2 3 "371.3")
|
||||||
("schematics" "spgsql.plt" 2 2 "371.3")
|
("schematics" "spgsql.plt" 2 2 "371.3")
|
||||||
|
|
|
@ -1126,16 +1126,17 @@ path/s is either such a string or a list of them.
|
||||||
"collects/scheme/gui.rkt" drdr:command-line "mred-text -t ~s"
|
"collects/scheme/gui.rkt" drdr:command-line "mred-text -t ~s"
|
||||||
"collects/scheme/match" responsible (samth)
|
"collects/scheme/match" responsible (samth)
|
||||||
"collects/scheme/match.rkt" responsible (samth)
|
"collects/scheme/match.rkt" responsible (samth)
|
||||||
"collects/schemeunit" responsible (noel ryanc)
|
"collects/rktunit" responsible (jay noel ryanc)
|
||||||
"collects/schemeunit/gui.rkt" responsible (ryanc) drdr:command-line "mred-text -t ~s"
|
"collects/schemeunit" responsible (jay)
|
||||||
"collects/schemeunit/private/gui" responsible (ryanc)
|
"collects/rktunit/gui.rkt" responsible (ryanc) drdr:command-line "mred-text -t ~s"
|
||||||
"collects/schemeunit/private/gui/config.rkt" drdr:command-line "mred-text -t ~s"
|
"collects/rktunit/private/gui" responsible (ryanc)
|
||||||
"collects/schemeunit/private/gui/controller.rkt" drdr:command-line "mred-text -t ~s"
|
"collects/rktunit/private/gui/config.rkt" drdr:command-line "mred-text -t ~s"
|
||||||
"collects/schemeunit/private/gui/gui.rkt" drdr:command-line "mred-text -t ~s"
|
"collects/rktunit/private/gui/controller.rkt" drdr:command-line "mred-text -t ~s"
|
||||||
"collects/schemeunit/private/gui/model2rml.rkt" drdr:command-line "mred-text -t ~s"
|
"collects/rktunit/private/gui/gui.rkt" drdr:command-line "mred-text -t ~s"
|
||||||
"collects/schemeunit/private/gui/rml.rkt" drdr:command-line "mred-text -t ~s"
|
"collects/rktunit/private/gui/model2rml.rkt" drdr:command-line "mred-text -t ~s"
|
||||||
"collects/schemeunit/private/gui/view.rkt" drdr:command-line "mred-text -t ~s"
|
"collects/rktunit/private/gui/rml.rkt" drdr:command-line "mred-text -t ~s"
|
||||||
"collects/schemeunit/tool.rkt" responsible (ryanc) drdr:command-line "mred-text -t ~s"
|
"collects/rktunit/private/gui/view.rkt" drdr:command-line "mred-text -t ~s"
|
||||||
|
"collects/rktunit/tool.rkt" responsible (ryanc) drdr:command-line "mred-text -t ~s"
|
||||||
"collects/scribble/run.rkt" drdr:command-line "mzc ~s"
|
"collects/scribble/run.rkt" drdr:command-line "mzc ~s"
|
||||||
"collects/scribble/tools/drscheme-buttons.rkt" drdr:command-line "mred-text ~s"
|
"collects/scribble/tools/drscheme-buttons.rkt" drdr:command-line "mred-text ~s"
|
||||||
"collects/scribble/tools/private/mk-drs-bitmaps.rkt" drdr:command-line "mred-text ~s" drdr:timeout 240
|
"collects/scribble/tools/private/mk-drs-bitmaps.rkt" drdr:command-line "mred-text ~s" drdr:timeout 240
|
||||||
|
@ -1582,7 +1583,7 @@ path/s is either such a string or a list of them.
|
||||||
"collects/tests/planet/examples/dummy-module.rkt" drdr:command-line ""
|
"collects/tests/planet/examples/dummy-module.rkt" drdr:command-line ""
|
||||||
"collects/tests/plot/run-tests.rkt" drdr:command-line "mred-text -t ~s"
|
"collects/tests/plot/run-tests.rkt" drdr:command-line "mred-text -t ~s"
|
||||||
"collects/tests/run-automated-tests.rkt" drdr:command-line "mzc -k ~s" drdr:timeout 600
|
"collects/tests/run-automated-tests.rkt" drdr:command-line "mzc -k ~s" drdr:timeout 600
|
||||||
"collects/tests/schemeunit" responsible (noel)
|
"collects/tests/rktunit" responsible (jay noel)
|
||||||
"collects/tests/srfi/1/run-tests.rkt" drdr:command-line "mzscheme -f ~s"
|
"collects/tests/srfi/1/run-tests.rkt" drdr:command-line "mzscheme -f ~s"
|
||||||
"collects/tests/srfi/40/run-tests.rkt" drdr:command-line "mzscheme -f ~s"
|
"collects/tests/srfi/40/run-tests.rkt" drdr:command-line "mzscheme -f ~s"
|
||||||
"collects/tests/srfi/43/run-tests.rkt" drdr:command-line "mzscheme -f ~s"
|
"collects/tests/srfi/43/run-tests.rkt" drdr:command-line "mzscheme -f ~s"
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(require (for-syntax scheme/base)
|
(require (for-syntax scheme/base)
|
||||||
"../lex.ss"
|
"../lex.ss"
|
||||||
schemeunit)
|
rktunit)
|
||||||
|
|
||||||
(define-syntax (catch-syn-error stx)
|
(define-syntax (catch-syn-error stx)
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
|
|
18
collects/rktunit/gui.rkt
Normal file
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 :
|
;; struct test :
|
||||||
(define-struct test ())
|
(define-struct test ())
|
||||||
;; struct (schemeunit-test-case test) : (U string #f) thunk
|
;; struct (rktunit-test-case test) : (U string #f) thunk
|
||||||
(define-struct (schemeunit-test-case test) (name action) #:transparent)
|
(define-struct (rktunit-test-case test) (name action) #:transparent)
|
||||||
;; struct (schemeunit-test-suite test) : string (fdown fup fhere seed -> (listof test-result)) thunk thunk
|
;; struct (rktunit-test-suite test) : string (fdown fup fhere seed -> (listof test-result)) thunk thunk
|
||||||
(define-struct (schemeunit-test-suite test) (name tests before after) #:transparent)
|
(define-struct (rktunit-test-suite test) (name tests before after) #:transparent)
|
||||||
|
|
||||||
;; struct exn:test exn : ()
|
;; struct exn:test exn : ()
|
||||||
;;
|
;;
|
||||||
|
@ -33,10 +33,10 @@
|
||||||
(define-struct (test-success test-result) (result))
|
(define-struct (test-success test-result) (result))
|
||||||
|
|
||||||
(provide/contract
|
(provide/contract
|
||||||
(struct (schemeunit-test-case test)
|
(struct (rktunit-test-case test)
|
||||||
((name (or/c string? false/c))
|
((name (or/c string? false/c))
|
||||||
(action (-> any))))
|
(action (-> any))))
|
||||||
(struct (schemeunit-test-suite test)
|
(struct (rktunit-test-suite test)
|
||||||
((name string?)
|
((name string?)
|
||||||
(tests procedure?)
|
(tests procedure?)
|
||||||
(before (-> any))
|
(before (-> any))
|
|
@ -1,4 +1,4 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(provide (all-defined-out))
|
(provide (all-defined-out))
|
||||||
|
|
||||||
|
@ -11,7 +11,7 @@
|
||||||
;; Infrastructure ----------------------------------------------
|
;; Infrastructure ----------------------------------------------
|
||||||
|
|
||||||
;; The continuation mark under which all check-info is keyed
|
;; The continuation mark under which all check-info is keyed
|
||||||
(define check-info-mark (gensym 'schemeunit))
|
(define check-info-mark (gensym 'rktunit))
|
||||||
|
|
||||||
;; (continuation-mark-set -> (listof check-info))
|
;; (continuation-mark-set -> (listof check-info))
|
||||||
(define (check-info-stack marks)
|
(define (check-info-stack marks)
|
|
@ -1,12 +1,12 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require (for-syntax scheme/base
|
(require (for-syntax racket/base
|
||||||
"location.ss")
|
"location.rkt")
|
||||||
srfi/1
|
srfi/1
|
||||||
"base.ss"
|
"base.rkt"
|
||||||
"check-info.ss"
|
"check-info.rkt"
|
||||||
"format.ss"
|
"format.rkt"
|
||||||
"location.ss")
|
"location.rkt")
|
||||||
|
|
||||||
(provide current-check-handler
|
(provide current-check-handler
|
||||||
check-around
|
check-around
|
|
@ -26,11 +26,11 @@
|
||||||
;;
|
;;
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
|
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require "base.ss"
|
(require "base.rkt"
|
||||||
"monad.ss"
|
"monad.rkt"
|
||||||
"hash-monad.ss")
|
"hash-monad.rkt")
|
||||||
|
|
||||||
(provide display-counter
|
(provide display-counter
|
||||||
update-counter!
|
update-counter!
|
|
@ -1,8 +1,8 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require scheme/match
|
(require racket/match
|
||||||
srfi/13
|
srfi/13
|
||||||
"check-info.ss")
|
"check-info.rkt")
|
||||||
|
|
||||||
(provide display-check-info-name-value
|
(provide display-check-info-name-value
|
||||||
display-check-info
|
display-check-info
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
(require scheme/contract)
|
(require racket/contract)
|
||||||
|
|
||||||
;; Add a new kind of promise instead?
|
;; Add a new kind of promise instead?
|
||||||
|
|
|
@ -1,24 +1,24 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
(require framework
|
(require framework
|
||||||
unstable/gui/prefs)
|
unstable/gui/prefs)
|
||||||
(provide (all-defined-out))
|
(provide (all-defined-out))
|
||||||
|
|
||||||
;; Frame size preferences
|
;; Frame size preferences
|
||||||
|
|
||||||
(preferences:set-default 'schemeunit:frame:width 400 exact-positive-integer?)
|
(preferences:set-default 'rktunit:frame:width 400 exact-positive-integer?)
|
||||||
(preferences:set-default 'schemeunit:frame:height 400 exact-positive-integer?)
|
(preferences:set-default 'rktunit:frame:height 400 exact-positive-integer?)
|
||||||
(define pref:width (pref:get/set 'schemeunit:frame:width))
|
(define pref:width (pref:get/set 'rktunit:frame:width))
|
||||||
(define pref:height (pref:get/set 'schemeunit:frame:height))
|
(define pref:height (pref:get/set 'rktunit:frame:height))
|
||||||
|
|
||||||
;; CONSTANTS
|
;; CONSTANTS
|
||||||
;; Some of these are obsolete, given the preferences above.
|
;; Some of these are obsolete, given the preferences above.
|
||||||
|
|
||||||
(define DETAILS-CANVAS-INIT-WIDTH 400)
|
(define DETAILS-CANVAS-INIT-WIDTH 400)
|
||||||
(define FRAME-LABEL "SchemeUnit")
|
(define FRAME-LABEL "RktUnit")
|
||||||
(define FRAME-INIT-HEIGHT 400)
|
(define FRAME-INIT-HEIGHT 400)
|
||||||
(define TREE-INIT-WIDTH 240)
|
(define TREE-INIT-WIDTH 240)
|
||||||
(define TREE-COLORIZE-CASES #t)
|
(define TREE-COLORIZE-CASES #t)
|
||||||
(define DIALOG-ERROR-TITLE "SchemeUnit: Error")
|
(define DIALOG-ERROR-TITLE "RktUnit: Error")
|
||||||
(define STATUS-SUCCESS 'success)
|
(define STATUS-SUCCESS 'success)
|
||||||
(define STATUS-FAILURE 'failure)
|
(define STATUS-FAILURE 'failure)
|
||||||
(define STATUS-ERROR 'error)
|
(define STATUS-ERROR 'error)
|
||||||
|
@ -28,7 +28,7 @@
|
||||||
(list (/ TREE-INIT-WIDTH total) (/ DETAILS-CANVAS-INIT-WIDTH total))))
|
(list (/ TREE-INIT-WIDTH total) (/ DETAILS-CANVAS-INIT-WIDTH total))))
|
||||||
|
|
||||||
;; Conventional assertion-info keys.
|
;; Conventional assertion-info keys.
|
||||||
;; These must be kept in sync with assert-base.ss.
|
;; These must be kept in sync with assert-base.rkt.
|
||||||
(define prop:failure-assertion 'name)
|
(define prop:failure-assertion 'name)
|
||||||
(define prop:failure-parameters 'params)
|
(define prop:failure-parameters 'params)
|
||||||
(define prop:failure-location 'location)
|
(define prop:failure-location 'location)
|
|
@ -1,11 +1,11 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
(require scheme/class
|
(require racket/class
|
||||||
unstable/class-iop
|
unstable/class-iop
|
||||||
unstable/gui/notify
|
unstable/gui/notify
|
||||||
"../base.ss"
|
"../base.rkt"
|
||||||
"interfaces.ss"
|
"interfaces.rkt"
|
||||||
"model.ss"
|
"model.rkt"
|
||||||
"view.ss")
|
"view.rkt")
|
||||||
(provide controller%)
|
(provide controller%)
|
||||||
|
|
||||||
(define controller%
|
(define controller%
|
||||||
|
@ -25,18 +25,18 @@
|
||||||
;; create-model : test suite<%>/#f -> result<%>
|
;; create-model : test suite<%>/#f -> result<%>
|
||||||
(define/public (create-model test parent)
|
(define/public (create-model test parent)
|
||||||
(define result
|
(define result
|
||||||
(cond [(schemeunit-test-case? test)
|
(cond [(rktunit-test-case? test)
|
||||||
(new case-result%
|
(new case-result%
|
||||||
(controller this)
|
(controller this)
|
||||||
(test test)
|
(test test)
|
||||||
(name (or (schemeunit-test-case-name test)
|
(name (or (rktunit-test-case-name test)
|
||||||
"<unnamed test-case>"))
|
"<unnamed test-case>"))
|
||||||
(parent parent))]
|
(parent parent))]
|
||||||
[(schemeunit-test-suite? test)
|
[(rktunit-test-suite? test)
|
||||||
(new suite-result%
|
(new suite-result%
|
||||||
(controller this)
|
(controller this)
|
||||||
(test test)
|
(test test)
|
||||||
(name (or (schemeunit-test-suite-name test)
|
(name (or (rktunit-test-suite-name test)
|
||||||
"<unnamed test-suite>"))
|
"<unnamed test-suite>"))
|
||||||
(parent parent))]))
|
(parent parent))]))
|
||||||
(send/i view view<%> create-view-link result parent)
|
(send/i view view<%> create-view-link result parent)
|
|
@ -1,7 +1,7 @@
|
||||||
;; Written in #%kernel to avoid adding any module-attachment
|
;; Written in #%kernel to avoid adding any module-attachment
|
||||||
;; dependencies. Initialized by the DrScheme integration tool.
|
;; dependencies. Initialized by the DrRacket integration tool.
|
||||||
|
|
||||||
(module drscheme-link '#%kernel
|
(module drracket-link '#%kernel
|
||||||
(#%provide link)
|
(#%provide link)
|
||||||
|
|
||||||
#|
|
#|
|
|
@ -1,10 +1,10 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
(require scheme/list
|
(require racket/list
|
||||||
scheme/string
|
racket/string
|
||||||
mzlib/etc
|
mzlib/etc
|
||||||
"drscheme-link.ss")
|
"drracket-link.rkt")
|
||||||
|
|
||||||
;; Procedures which *may* be overridden by DrScheme to do useful things.
|
;; Procedures which *may* be overridden by DrRacket to do useful things.
|
||||||
;; Or they may not be.
|
;; Or they may not be.
|
||||||
|
|
||||||
(provide has-backtrace?
|
(provide has-backtrace?
|
|
@ -1,13 +1,13 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
(require scheme/class
|
(require racket/class
|
||||||
unstable/class-iop
|
unstable/class-iop
|
||||||
scheme/gui
|
racket/gui
|
||||||
"../base.ss"
|
"../base.rkt"
|
||||||
"../result.ss"
|
"../result.rkt"
|
||||||
"../check-info.ss"
|
"../check-info.rkt"
|
||||||
"interfaces.ss"
|
"interfaces.rkt"
|
||||||
"controller.ss"
|
"controller.rkt"
|
||||||
"view.ss")
|
"view.rkt")
|
||||||
(provide make-gui-runner)
|
(provide make-gui-runner)
|
||||||
|
|
||||||
(define (make-gui-runner)
|
(define (make-gui-runner)
|
||||||
|
@ -48,8 +48,8 @@
|
||||||
#|
|
#|
|
||||||
(define/public (run)
|
(define/public (run)
|
||||||
(let ([custodian (make-custodian)]
|
(let ([custodian (make-custodian)]
|
||||||
[before (schemeunit-test-suite-before test)]
|
[before (rktunit-test-suite-before test)]
|
||||||
[after (schemeunit-test-suite-after test)])
|
[after (rktunit-test-suite-after test)])
|
||||||
(parameterize [(current-custodian custodian)]
|
(parameterize [(current-custodian custodian)]
|
||||||
(dynamic-wind
|
(dynamic-wind
|
||||||
before
|
before
|
||||||
|
@ -112,8 +112,8 @@
|
||||||
(call-with-continuation-prompt
|
(call-with-continuation-prompt
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(time-apply run-test-case
|
(time-apply run-test-case
|
||||||
(list (schemeunit-test-case-name test)
|
(list (rktunit-test-case-name test)
|
||||||
(schemeunit-test-case-action test)))))])
|
(rktunit-test-case-action test)))))])
|
||||||
(values (car results) (list cputime realtime gctime))))
|
(values (car results) (list cputime realtime gctime))))
|
||||||
|
|
||||||
(define (make-output-ports)
|
(define (make-output-ports)
|
|
@ -1,6 +1,6 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
(require scheme/contract
|
(require racket/contract
|
||||||
scheme/dict)
|
racket/dict)
|
||||||
|
|
||||||
(define (make-gvector* #:capacity [capacity 10])
|
(define (make-gvector* #:capacity [capacity 10])
|
||||||
(make-gvector (make-vector capacity #f) 0))
|
(make-gvector (make-vector capacity #f) 0))
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
(require scheme/class
|
(require racket/class
|
||||||
unstable/class-iop)
|
unstable/class-iop)
|
||||||
(provide (all-defined-out))
|
(provide (all-defined-out))
|
||||||
|
|
|
@ -1,11 +1,11 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
(require scheme/class
|
(require racket/class
|
||||||
unstable/class-iop
|
unstable/class-iop
|
||||||
scheme/list
|
racket/list
|
||||||
"gvector.ss"
|
"gvector.rkt"
|
||||||
"../base.ss"
|
"../base.rkt"
|
||||||
"interfaces.ss"
|
"interfaces.rkt"
|
||||||
"cache-box.ss")
|
"cache-box.rkt")
|
||||||
(provide case-result%
|
(provide case-result%
|
||||||
suite-result%)
|
suite-result%)
|
||||||
|
|
|
@ -1,14 +1,14 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
(require scheme/class
|
(require racket/class
|
||||||
unstable/class-iop
|
unstable/class-iop
|
||||||
scheme/list
|
racket/list
|
||||||
scheme/gui
|
racket/gui
|
||||||
scheme/match
|
racket/match
|
||||||
scheme/file
|
racket/file
|
||||||
mrlib/include-bitmap
|
mrlib/include-bitmap
|
||||||
(prefix-in drlink: "drscheme-ui.ss")
|
(prefix-in drlink: "drracket-ui.rkt")
|
||||||
"interfaces.ss"
|
"interfaces.rkt"
|
||||||
"config.ss")
|
"config.rkt")
|
||||||
(provide model-renderer%
|
(provide model-renderer%
|
||||||
output-icon)
|
output-icon)
|
||||||
|
|
||||||
|
@ -404,12 +404,12 @@
|
||||||
(put '() " ")
|
(put '() " ")
|
||||||
(put+click '(clickback)
|
(put+click '(clickback)
|
||||||
(lambda _ (drlink:show-errortrace-backtrace exn))
|
(lambda _ (drlink:show-errortrace-backtrace exn))
|
||||||
"[from DrScheme]"))
|
"[from DrRacket]"))
|
||||||
(when (drlink:has-primitive-backtrace? exn)
|
(when (drlink:has-primitive-backtrace? exn)
|
||||||
(put '() " ")
|
(put '() " ")
|
||||||
(put+click '(clickback)
|
(put+click '(clickback)
|
||||||
(lambda _ (drlink:show-primitive-backtrace exn))
|
(lambda _ (drlink:show-primitive-backtrace exn))
|
||||||
"[from mzscheme]")))
|
"[from racket]")))
|
||||||
|
|
||||||
(define/private (render-output model)
|
(define/private (render-output model)
|
||||||
(let [(output (send/i model case<%> get-output))]
|
(let [(output (send/i model case<%> get-output))]
|
Before Width: | Height: | Size: 513 B After Width: | Height: | Size: 513 B |
|
@ -1,13 +1,13 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
(require scheme/class
|
(require racket/class
|
||||||
unstable/class-iop
|
unstable/class-iop
|
||||||
scheme/gui
|
racket/gui
|
||||||
framework
|
framework
|
||||||
"interfaces.ss")
|
"interfaces.rkt")
|
||||||
|
|
||||||
(provide insert-text
|
(provide insert-text
|
||||||
ext:text%
|
ext:text%
|
||||||
schemeunit-style-map)
|
rktunit-style-map)
|
||||||
|
|
||||||
;; insert-text : text% string style-delta% -> void
|
;; insert-text : text% string style-delta% -> void
|
||||||
(define (insert-text e text style)
|
(define (insert-text e text style)
|
||||||
|
@ -20,7 +20,7 @@
|
||||||
|
|
||||||
(define ext:text-mixin
|
(define ext:text-mixin
|
||||||
(mixin (text<%>) ()
|
(mixin (text<%>) ()
|
||||||
(init-field (style-map schemeunit-style-map))
|
(init-field (style-map rktunit-style-map))
|
||||||
(inherit last-position
|
(inherit last-position
|
||||||
change-style
|
change-style
|
||||||
set-clickback
|
set-clickback
|
||||||
|
@ -139,7 +139,7 @@
|
||||||
[error . ,style:red]
|
[error . ,style:red]
|
||||||
[value . ,style:darkblue]))
|
[value . ,style:darkblue]))
|
||||||
|
|
||||||
(define schemeunit-styles
|
(define rktunit-styles
|
||||||
`([test-unexecuted . ,style:gray]
|
`([test-unexecuted . ,style:gray]
|
||||||
[test-success . ,style:green]
|
[test-success . ,style:green]
|
||||||
[test-failure . ,style:red]
|
[test-failure . ,style:red]
|
||||||
|
@ -181,7 +181,7 @@
|
||||||
(extend-style-map empty-style-map
|
(extend-style-map empty-style-map
|
||||||
basic-styles))
|
basic-styles))
|
||||||
|
|
||||||
;; schemeunit-style-map : style-map<%>
|
;; rktunit-style-map : style-map<%>
|
||||||
(define schemeunit-style-map
|
(define rktunit-style-map
|
||||||
(extend-style-map basic-style-map
|
(extend-style-map basic-style-map
|
||||||
schemeunit-styles))
|
rktunit-styles))
|
|
@ -1,19 +1,19 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
(require scheme/class
|
(require racket/class
|
||||||
unstable/class-iop
|
unstable/class-iop
|
||||||
scheme/list
|
racket/list
|
||||||
scheme/gui
|
racket/gui
|
||||||
framework
|
framework
|
||||||
mrlib/hierlist
|
mrlib/hierlist
|
||||||
"interfaces.ss"
|
"interfaces.rkt"
|
||||||
"config.ss"
|
"config.rkt"
|
||||||
"model2rml.ss"
|
"model2rml.rkt"
|
||||||
"rml.ss")
|
"rml.rkt")
|
||||||
|
|
||||||
(provide make-view-frame
|
(provide make-view-frame
|
||||||
view%)
|
view%)
|
||||||
|
|
||||||
(define style-map schemeunit-style-map)
|
(define style-map rktunit-style-map)
|
||||||
|
|
||||||
#|
|
#|
|
||||||
|
|
||||||
|
@ -50,7 +50,7 @@ still be there, just not visible?
|
||||||
controller)
|
controller)
|
||||||
(super-new)
|
(super-new)
|
||||||
|
|
||||||
(define editor (new ext:text% (style-map schemeunit-style-map)))
|
(define editor (new ext:text% (style-map rktunit-style-map)))
|
||||||
(define renderer
|
(define renderer
|
||||||
(new model-renderer%
|
(new model-renderer%
|
||||||
(controller controller)
|
(controller controller)
|
||||||
|
@ -146,7 +146,7 @@ still be there, just not visible?
|
||||||
;; If the view-link has not been created,
|
;; If the view-link has not been created,
|
||||||
;; yield until it is.
|
;; yield until it is.
|
||||||
(unless (yield)
|
(unless (yield)
|
||||||
(error 'schemeunit-gui
|
(error 'rktunit-gui
|
||||||
"internal error: no progress waiting for view-link"))
|
"internal error: no progress waiting for view-link"))
|
||||||
(do-model-update model)])))
|
(do-model-update model)])))
|
||||||
|
|
|
@ -26,9 +26,9 @@
|
||||||
;;
|
;;
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
|
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require "monad.ss")
|
(require "monad.rkt")
|
||||||
|
|
||||||
(provide (all-defined-out))
|
(provide (all-defined-out))
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require scheme/list)
|
(require racket/list)
|
||||||
|
|
||||||
(provide location-source
|
(provide location-source
|
||||||
location-line
|
location-line
|
|
@ -26,7 +26,7 @@
|
||||||
;;
|
;;
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
|
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(provide (all-defined-out))
|
(provide (all-defined-out))
|
||||||
|
|
|
@ -26,11 +26,11 @@
|
||||||
;;
|
;;
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
|
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require "base.ss"
|
(require "base.rkt"
|
||||||
"monad.ss"
|
"monad.rkt"
|
||||||
"hash-monad.ss"
|
"hash-monad.rkt"
|
||||||
srfi/1)
|
srfi/1)
|
||||||
|
|
||||||
(provide display-test-case-name
|
(provide display-test-case-name
|
|
@ -26,10 +26,10 @@
|
||||||
;;
|
;;
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
|
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require "base.ss"
|
(require "base.rkt"
|
||||||
"test-suite.ss")
|
"test-suite.rkt")
|
||||||
|
|
||||||
(provide (all-defined-out))
|
(provide (all-defined-out))
|
||||||
|
|
||||||
|
@ -51,12 +51,12 @@
|
||||||
;; data so FP is a bit ugly].
|
;; data so FP is a bit ugly].
|
||||||
(define (foldts fdown fup fhere seed test)
|
(define (foldts fdown fup fhere seed test)
|
||||||
(cond
|
(cond
|
||||||
((schemeunit-test-case? test)
|
((rktunit-test-case? test)
|
||||||
(fhere test
|
(fhere test
|
||||||
(schemeunit-test-case-name test)
|
(rktunit-test-case-name test)
|
||||||
(schemeunit-test-case-action test)
|
(rktunit-test-case-action test)
|
||||||
seed))
|
seed))
|
||||||
((schemeunit-test-suite? test)
|
((rktunit-test-suite? test)
|
||||||
(apply-test-suite test fdown fup fhere seed))
|
(apply-test-suite test fdown fup fhere seed))
|
||||||
(else
|
(else
|
||||||
(raise
|
(raise
|
|
@ -1,10 +1,10 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require (for-syntax scheme/base)
|
(require (for-syntax racket/base)
|
||||||
"base.ss"
|
"base.rkt"
|
||||||
"format.ss"
|
"format.rkt"
|
||||||
"check-info.ss"
|
"check-info.rkt"
|
||||||
"check.ss")
|
"check.rkt")
|
||||||
|
|
||||||
(provide current-test-name
|
(provide current-test-name
|
||||||
current-test-case-around
|
current-test-case-around
|
|
@ -1,9 +1,9 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require (for-syntax scheme/base)
|
(require (for-syntax racket/base)
|
||||||
"base.ss"
|
"base.rkt"
|
||||||
"test-case.ss"
|
"test-case.rkt"
|
||||||
"check.ss")
|
"check.rkt")
|
||||||
|
|
||||||
(provide test-suite
|
(provide test-suite
|
||||||
test-suite-test-case-around
|
test-suite-test-case-around
|
||||||
|
@ -27,14 +27,14 @@
|
||||||
(define (test-suite-test-case-around fhere)
|
(define (test-suite-test-case-around fhere)
|
||||||
(lambda (thunk)
|
(lambda (thunk)
|
||||||
(let* ([name (current-test-name)]
|
(let* ([name (current-test-name)]
|
||||||
[test (make-schemeunit-test-case name thunk)]
|
[test (make-rktunit-test-case name thunk)]
|
||||||
[seed (current-seed)])
|
[seed (current-seed)])
|
||||||
(current-seed (fhere test name thunk seed)))))
|
(current-seed (fhere test name thunk seed)))))
|
||||||
|
|
||||||
(define (test-suite-check-around fhere)
|
(define (test-suite-check-around fhere)
|
||||||
(lambda (thunk)
|
(lambda (thunk)
|
||||||
(let* ([name #f]
|
(let* ([name #f]
|
||||||
[test (make-schemeunit-test-case name thunk)]
|
[test (make-rktunit-test-case name thunk)]
|
||||||
[seed (current-seed)])
|
[seed (current-seed)])
|
||||||
(current-seed (fhere test name thunk seed)))))
|
(current-seed (fhere test name thunk seed)))))
|
||||||
|
|
||||||
|
@ -42,12 +42,12 @@
|
||||||
(define delayed-test-case-around
|
(define delayed-test-case-around
|
||||||
(lambda (thunk)
|
(lambda (thunk)
|
||||||
(let ([name (current-test-name)])
|
(let ([name (current-test-name)])
|
||||||
(make-schemeunit-test-case name thunk))))
|
(make-rktunit-test-case name thunk))))
|
||||||
|
|
||||||
(define delayed-check-around
|
(define delayed-check-around
|
||||||
(lambda (thunk)
|
(lambda (thunk)
|
||||||
(let ([name #f])
|
(let ([name #f])
|
||||||
(make-schemeunit-test-case name thunk))))
|
(make-rktunit-test-case name thunk))))
|
||||||
|
|
||||||
(define-syntax delay-test
|
(define-syntax delay-test
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
|
@ -58,12 +58,12 @@
|
||||||
test test1 ...)]))
|
test test1 ...)]))
|
||||||
|
|
||||||
(define (apply-test-suite suite fdown fup fhere seed)
|
(define (apply-test-suite suite fdown fup fhere seed)
|
||||||
(let* ([name (schemeunit-test-suite-name suite)]
|
(let* ([name (rktunit-test-suite-name suite)]
|
||||||
[tests (schemeunit-test-suite-tests suite)]
|
[tests (rktunit-test-suite-tests suite)]
|
||||||
[before (schemeunit-test-suite-before suite)]
|
[before (rktunit-test-suite-before suite)]
|
||||||
[after (schemeunit-test-suite-after suite)]
|
[after (rktunit-test-suite-after suite)]
|
||||||
[kid-seed (fdown suite name before after seed)]
|
[kid-seed (fdown suite name before after seed)]
|
||||||
[kid-seed ((schemeunit-test-suite-tests suite) fdown fup fhere kid-seed)])
|
[kid-seed ((rktunit-test-suite-tests suite) fdown fup fhere kid-seed)])
|
||||||
(fup suite name before after seed kid-seed)))
|
(fup suite name before after seed kid-seed)))
|
||||||
|
|
||||||
;; test-suite : name [#:before thunk] [#:after thunk] test ...
|
;; test-suite : name [#:before thunk] [#:after thunk] test ...
|
||||||
|
@ -84,7 +84,7 @@
|
||||||
[the-tests
|
[the-tests
|
||||||
(lambda (fdown fup fhere seed)
|
(lambda (fdown fup fhere seed)
|
||||||
(define (run/inner x)
|
(define (run/inner x)
|
||||||
(cond [(schemeunit-test-suite? x)
|
(cond [(rktunit-test-suite? x)
|
||||||
(current-seed
|
(current-seed
|
||||||
(apply-test-suite x fdown fup fhere (current-seed)))]
|
(apply-test-suite x fdown fup fhere (current-seed)))]
|
||||||
[(list? x)
|
[(list? x)
|
||||||
|
@ -103,7 +103,7 @@
|
||||||
[(not (string? the-name))
|
[(not (string? the-name))
|
||||||
(raise-type-error 'test-suite "test-suite name as string" the-name)]
|
(raise-type-error 'test-suite "test-suite name as string" the-name)]
|
||||||
[else
|
[else
|
||||||
(make-schemeunit-test-suite
|
(make-rktunit-test-suite
|
||||||
the-name
|
the-name
|
||||||
the-tests
|
the-tests
|
||||||
before-thunk
|
before-thunk
|
||||||
|
@ -138,13 +138,13 @@
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (t)
|
(lambda (t)
|
||||||
(cond
|
(cond
|
||||||
[(schemeunit-test-suite? t)
|
[(rktunit-test-suite? t)
|
||||||
(current-seed (apply-test-suite t fdown fup fhere (current-seed)))]
|
(current-seed (apply-test-suite t fdown fup fhere (current-seed)))]
|
||||||
[(schemeunit-test-case? t)
|
[(rktunit-test-case? t)
|
||||||
(current-seed
|
(current-seed
|
||||||
(fhere t
|
(fhere t
|
||||||
(schemeunit-test-case-name t)
|
(rktunit-test-case-name t)
|
||||||
(schemeunit-test-case-action t)
|
(rktunit-test-case-action t)
|
||||||
(current-seed)))]
|
(current-seed)))]
|
||||||
[else
|
[else
|
||||||
(raise
|
(raise
|
||||||
|
@ -158,7 +158,7 @@
|
||||||
;;
|
;;
|
||||||
;; Construct a test suite from a list of tests
|
;; Construct a test suite from a list of tests
|
||||||
(define (make-test-suite name #:before [before void-thunk] #:after [after void-thunk] tests)
|
(define (make-test-suite name #:before [before void-thunk] #:after [after void-thunk] tests)
|
||||||
(make-schemeunit-test-suite name
|
(make-rktunit-test-suite name
|
||||||
(tests->test-suite-action tests)
|
(tests->test-suite-action tests)
|
||||||
before
|
before
|
||||||
after))
|
after))
|
|
@ -1,13 +1,13 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require (for-syntax scheme/base)
|
(require (for-syntax racket/base)
|
||||||
"base.ss"
|
"base.rkt"
|
||||||
"check.ss"
|
"check.rkt"
|
||||||
"check-info.ss"
|
"check-info.rkt"
|
||||||
"result.ss"
|
"result.rkt"
|
||||||
"test-case.ss"
|
"test-case.rkt"
|
||||||
"test-suite.ss"
|
"test-suite.rkt"
|
||||||
"util.ss")
|
"util.rkt")
|
||||||
|
|
||||||
(provide (struct-out exn:test:check)
|
(provide (struct-out exn:test:check)
|
||||||
(struct-out check-info)
|
(struct-out check-info)
|
||||||
|
@ -15,8 +15,8 @@
|
||||||
(struct-out test-failure)
|
(struct-out test-failure)
|
||||||
(struct-out test-error)
|
(struct-out test-error)
|
||||||
(struct-out test-success)
|
(struct-out test-success)
|
||||||
(struct-out schemeunit-test-case)
|
(struct-out rktunit-test-case)
|
||||||
(struct-out schemeunit-test-suite)
|
(struct-out rktunit-test-suite)
|
||||||
|
|
||||||
with-check-info
|
with-check-info
|
||||||
with-check-info*
|
with-check-info*
|
||||||
|
@ -42,9 +42,9 @@
|
||||||
test-suite
|
test-suite
|
||||||
make-test-suite
|
make-test-suite
|
||||||
delay-test
|
delay-test
|
||||||
(rename-out [make-schemeunit-test-case make-test-case]
|
(rename-out [make-rktunit-test-case make-test-case]
|
||||||
[schemeunit-test-case? test-case?]
|
[rktunit-test-case? test-case?]
|
||||||
[schemeunit-test-suite? test-suite?])
|
[rktunit-test-suite? test-suite?])
|
||||||
|
|
||||||
define-test-suite
|
define-test-suite
|
||||||
define/provide-test-suite
|
define/provide-test-suite
|
|
@ -26,7 +26,7 @@
|
||||||
;;
|
;;
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
|
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require (only-in srfi/13 string-contains string-drop))
|
(require (only-in srfi/13 string-contains string-drop))
|
||||||
|
|
|
@ -26,13 +26,13 @@
|
||||||
;;
|
;;
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
|
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require (for-syntax scheme/base)
|
(require (for-syntax racket/base)
|
||||||
mzlib/etc
|
mzlib/etc
|
||||||
"check.ss"
|
"check.rkt"
|
||||||
"test-suite.ss"
|
"test-suite.rkt"
|
||||||
"test-case.ss")
|
"test-case.rkt")
|
||||||
|
|
||||||
(provide require/expose
|
(provide require/expose
|
||||||
test-suite*
|
test-suite*
|
||||||
|
@ -41,7 +41,7 @@
|
||||||
;; Requires a module and exposes some of its unprovided
|
;; Requires a module and exposes some of its unprovided
|
||||||
;; (non-syntax!) identifiers.
|
;; (non-syntax!) identifiers.
|
||||||
;; USAGE: (require/expose MODULE-NAME (IDS ...))
|
;; USAGE: (require/expose MODULE-NAME (IDS ...))
|
||||||
;; where MODULE-NAME is as in the MzScheme manual (i.e.,
|
;; where MODULE-NAME is as in the MzRacket manual (i.e.,
|
||||||
;; a standard module spec) and IDS are the un-provided
|
;; a standard module spec) and IDS are the un-provided
|
||||||
;; identifiers that you wish to expose in the current
|
;; identifiers that you wish to expose in the current
|
||||||
;; module.
|
;; module.
|
|
@ -1,18 +1,18 @@
|
||||||
#lang scribble/doc
|
#lang scribble/doc
|
||||||
@(require "base.ss")
|
@(require "base.rkt")
|
||||||
|
|
||||||
@title{Acknowlegements}
|
@title{Acknowlegements}
|
||||||
|
|
||||||
The following people have contributed to SchemeUnit:
|
The following people have contributed to RktUnit:
|
||||||
|
|
||||||
@itemize[
|
@itemize[
|
||||||
@item{Robby Findler pushed me to release version 3}
|
@item{Robby Findler pushed me to release version 3}
|
||||||
|
|
||||||
@item{Matt Jadud and his students at Olin College
|
@item{Matt Jadud and his students at Olin College
|
||||||
suggested renaming @scheme[test/text-ui]}
|
suggested renaming @racket[test/text-ui]}
|
||||||
|
|
||||||
@item{Dave Gurnell reported a bug in check-not-exn and
|
@item{Dave Gurnell reported a bug in check-not-exn and
|
||||||
suggested improvements to SchemeUnit}
|
suggested improvements to RktUnit}
|
||||||
|
|
||||||
@item{Danny Yoo reported a bug in and provided a fix for
|
@item{Danny Yoo reported a bug in and provided a fix for
|
||||||
trim-current-directory}
|
trim-current-directory}
|
||||||
|
@ -30,15 +30,15 @@ The following people have contributed to SchemeUnit:
|
||||||
@item{Jose A. Ortega Ruiz alerted me a problem in the
|
@item{Jose A. Ortega Ruiz alerted me a problem in the
|
||||||
packaging system and helped fix it.}
|
packaging system and helped fix it.}
|
||||||
|
|
||||||
@item{Sebastian H. Seidel provided help packaging SchemeUnit
|
@item{Sebastian H. Seidel provided help packaging RktUnit
|
||||||
into a .plt}
|
into a .plt}
|
||||||
|
|
||||||
@item{Don Blaheta provided the method for grabbing line number
|
@item{Don Blaheta provided the method for grabbing line number
|
||||||
and file name in checks}
|
and file name in checks}
|
||||||
|
|
||||||
@item{Patrick Logan ported example.ss to version 1.3}
|
@item{Patrick Logan ported example.rkt to version 1.3}
|
||||||
|
|
||||||
@item{The PLT team made PLT Scheme}
|
@item{The PLT team made Racket}
|
||||||
|
|
||||||
@item{The Extreme Programming community started the whole
|
@item{The Extreme Programming community started the whole
|
||||||
testing framework thing}
|
testing framework thing}
|
|
@ -1,10 +1,10 @@
|
||||||
#lang scribble/doc
|
#lang scribble/doc
|
||||||
@(require "base.ss")
|
@(require "base.rkt")
|
||||||
|
|
||||||
@title[#:tag "api"]{SchemeUnit API}
|
@title[#:tag "api"]{RktUnit API}
|
||||||
|
|
||||||
@defmodule[schemeunit
|
@defmodule[rktunit
|
||||||
#:use-sources (schemeunit)]
|
#:use-sources (rktunit)]
|
||||||
|
|
||||||
@include-section["overview.scrbl"]
|
@include-section["overview.scrbl"]
|
||||||
@include-section["check.scrbl"]
|
@include-section["check.scrbl"]
|
|
@ -6,15 +6,15 @@
|
||||||
|
|
||||||
(for-label scheme/base
|
(for-label scheme/base
|
||||||
scheme/contract
|
scheme/contract
|
||||||
schemeunit
|
rktunit
|
||||||
schemeunit/text-ui
|
rktunit/text-ui
|
||||||
schemeunit/gui))
|
rktunit/gui))
|
||||||
|
|
||||||
(provide
|
(provide
|
||||||
(all-from-out scribble/eval
|
(all-from-out scribble/eval
|
||||||
scribble/manual)
|
scribble/manual)
|
||||||
(for-label (all-from-out scheme/base
|
(for-label (all-from-out scheme/base
|
||||||
scheme/contract
|
scheme/contract
|
||||||
schemeunit
|
rktunit
|
||||||
schemeunit/text-ui
|
rktunit/text-ui
|
||||||
schemeunit/gui)))
|
rktunit/gui)))
|
|
@ -1,12 +1,12 @@
|
||||||
#lang scribble/doc
|
#lang scribble/doc
|
||||||
@(require "base.ss")
|
@(require "base.rkt")
|
||||||
|
|
||||||
@title{Checks}
|
@title{Checks}
|
||||||
|
|
||||||
Checks are the basic building block of SchemeUnit. A check
|
Checks are the basic building block of RktUnit. A check
|
||||||
checks some condition. If the condition holds the check
|
checks some condition. If the condition holds the check
|
||||||
evaluates to @scheme[#t]. If the condition doesn't hold the
|
evaluates to @racket[#t]. If the condition doesn't hold the
|
||||||
check raises an instance of @scheme[exn:test:check] with
|
check raises an instance of @racket[exn:test:check] with
|
||||||
information detailing the failure.
|
information detailing the failure.
|
||||||
|
|
||||||
Although checks are implemented as macros, which is
|
Although checks are implemented as macros, which is
|
||||||
|
@ -16,8 +16,8 @@ their arguments. You can use check as first class
|
||||||
functions, though you will lose precision in the reported
|
functions, though you will lose precision in the reported
|
||||||
source locations if you do so.
|
source locations if you do so.
|
||||||
|
|
||||||
The following are the basic checks SchemeUnit provides. You
|
The following are the basic checks RktUnit provides. You
|
||||||
can create your own checks using @scheme[define-check].
|
can create your own checks using @racket[define-check].
|
||||||
|
|
||||||
@defproc[(check (op (-> any any any))
|
@defproc[(check (op (-> any any any))
|
||||||
(v1 any)
|
(v1 any)
|
||||||
|
@ -25,11 +25,11 @@ can create your own checks using @scheme[define-check].
|
||||||
(message string? ""))
|
(message string? ""))
|
||||||
any]{
|
any]{
|
||||||
|
|
||||||
The simplest check. Succeeds if @scheme[op] applied to @scheme[v1] and @scheme[v2] is not @scheme[#f], otherwise raises an exception of type @scheme[exn:test:check]. The optional @scheme[message] is included in the output if the check fails. If the check succeeds, the value returned by @scheme[op] is the value returned by the check.}
|
The simplest check. Succeeds if @racket[op] applied to @racket[v1] and @racket[v2] is not @racket[#f], otherwise raises an exception of type @racket[exn:test:check]. The optional @racket[message] is included in the output if the check fails. If the check succeeds, the value returned by @racket[op] is the value returned by the check.}
|
||||||
|
|
||||||
For example, the following check succeeds:
|
For example, the following check succeeds:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(check < 2 3)
|
(check < 2 3)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
@ -39,14 +39,14 @@ For example, the following check succeeds:
|
||||||
[(check-equal? (v1 any) (v2 any) (message string? "")) #t]
|
[(check-equal? (v1 any) (v2 any) (message string? "")) #t]
|
||||||
[(check-not-equal? (v1 any) (v2 any) (message string? "")) #t])]{
|
[(check-not-equal? (v1 any) (v2 any) (message string? "")) #t])]{
|
||||||
|
|
||||||
Checks that @scheme[v1] is (not) @scheme[eq?],
|
Checks that @racket[v1] is (not) @racket[eq?],
|
||||||
@scheme[eqv?], or @scheme[equal?] to @scheme[v2]. The
|
@racket[eqv?], or @racket[equal?] to @racket[v2]. The
|
||||||
optional @scheme[message] is included in the output if the
|
optional @racket[message] is included in the output if the
|
||||||
check fails.}
|
check fails.}
|
||||||
|
|
||||||
For example, the following checks all fail:
|
For example, the following checks all fail:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(check-eq? (list 1) (list 1) "allocated data not eq?")
|
(check-eq? (list 1) (list 1) "allocated data not eq?")
|
||||||
(check-not-eq? 1 1 "integers are eq?")
|
(check-not-eq? 1 1 "integers are eq?")
|
||||||
(check-eqv? 1 1.0 "not eqv?")
|
(check-eqv? 1 1.0 "not eqv?")
|
||||||
|
@ -55,11 +55,11 @@ For example, the following checks all fail:
|
||||||
]
|
]
|
||||||
|
|
||||||
@defproc[(check-pred (pred (-> any any)) (v any) (message string? ""))
|
@defproc[(check-pred (pred (-> any any)) (v any) (message string? ""))
|
||||||
#t]{Checks that @scheme[pred] returns a value that is not @scheme[#f] when applied to @scheme[v]. The optional @scheme[message] is included in the output if the check fails. The value returned by a successful check is the value returned by @scheme[pred].}
|
#t]{Checks that @racket[pred] returns a value that is not @racket[#f] when applied to @racket[v]. The optional @racket[message] is included in the output if the check fails. The value returned by a successful check is the value returned by @racket[pred].}
|
||||||
|
|
||||||
Here's an example that passes and an example that fails:
|
Here's an example that passes and an example that fails:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(check-pred string? "I work")
|
(check-pred string? "I work")
|
||||||
(check-pred number? "I fail")
|
(check-pred number? "I fail")
|
||||||
]
|
]
|
||||||
|
@ -67,14 +67,14 @@ Here's an example that passes and an example that fails:
|
||||||
|
|
||||||
@defproc[(check-= (v1 any) (v2 any) (epsilon number?) (message string? "")) #t]{
|
@defproc[(check-= (v1 any) (v2 any) (epsilon number?) (message string? "")) #t]{
|
||||||
|
|
||||||
Checks that @scheme[v1] and @scheme[v2] are within
|
Checks that @racket[v1] and @racket[v2] are within
|
||||||
@scheme[epsilon] of one another. The optional
|
@racket[epsilon] of one another. The optional
|
||||||
@scheme[message] is included in the output if the check
|
@racket[message] is included in the output if the check
|
||||||
fails.}
|
fails.}
|
||||||
|
|
||||||
Here's an example that passes and an example that fails:
|
Here's an example that passes and an example that fails:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(check-= 1.0 1.01 0.01 "I work")
|
(check-= 1.0 1.01 0.01 "I work")
|
||||||
(check-= 1.0 1.01 0.005 "I fail")
|
(check-= 1.0 1.01 0.005 "I fail")
|
||||||
]
|
]
|
||||||
|
@ -83,13 +83,13 @@ Here's an example that passes and an example that fails:
|
||||||
[(check-false (v any) (message string? "")) #t]
|
[(check-false (v any) (message string? "")) #t]
|
||||||
[(check-not-false (v any) (message string? "")) #t])]{
|
[(check-not-false (v any) (message string? "")) #t])]{
|
||||||
|
|
||||||
Checks that @scheme[v] is @scheme[#t], @scheme[#f], or not
|
Checks that @racket[v] is @racket[#t], @racket[#f], or not
|
||||||
@scheme[#f] as appropriate. The optional @scheme[message]
|
@racket[#f] as appropriate. The optional @racket[message]
|
||||||
is included in the output if the check fails.}
|
is included in the output if the check fails.}
|
||||||
|
|
||||||
For example, the following checks all fail:
|
For example, the following checks all fail:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(check-true 1)
|
(check-true 1)
|
||||||
(check-false 1)
|
(check-false 1)
|
||||||
(check-not-false #f)
|
(check-not-false #f)
|
||||||
|
@ -99,16 +99,16 @@ For example, the following checks all fail:
|
||||||
@defproc[(check-exn (exn-predicate (-> any (or/c #t #f))) (thunk (-> any)) (message string? ""))
|
@defproc[(check-exn (exn-predicate (-> any (or/c #t #f))) (thunk (-> any)) (message string? ""))
|
||||||
#t]{
|
#t]{
|
||||||
|
|
||||||
Checks that @scheme[thunk] raises an exception for which
|
Checks that @racket[thunk] raises an exception for which
|
||||||
@scheme[exn-predicate] returns @scheme[#t]. The optional
|
@racket[exn-predicate] returns @racket[#t]. The optional
|
||||||
@scheme[message] is included in the output if the check
|
@racket[message] is included in the output if the check
|
||||||
fails. A common error is to use an expression instead of a
|
fails. A common error is to use an expression instead of a
|
||||||
function of no arguments for @scheme[thunk]. Remember that
|
function of no arguments for @racket[thunk]. Remember that
|
||||||
checks are conceptually functions.}
|
checks are conceptually functions.}
|
||||||
|
|
||||||
Here are two example, one showing a test that succeeds, and one showing a common error:
|
Here are two example, one showing a test that succeeds, and one showing a common error:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(check-exn exn?
|
(check-exn exn?
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(raise (make-exn "Hi there"
|
(raise (make-exn "Hi there"
|
||||||
|
@ -121,22 +121,22 @@ Here are two example, one showing a test that succeeds, and one showing a common
|
||||||
|
|
||||||
@defproc[(check-not-exn (thunk (-> any)) (message string? "")) #t]{
|
@defproc[(check-not-exn (thunk (-> any)) (message string? "")) #t]{
|
||||||
|
|
||||||
Checks that @scheme[thunk] does not raise any exceptions.
|
Checks that @racket[thunk] does not raise any exceptions.
|
||||||
The optional @scheme[message] is included in the output if
|
The optional @racket[message] is included in the output if
|
||||||
the check fails.}
|
the check fails.}
|
||||||
|
|
||||||
@defproc[(fail (message string? "")) #t]{This checks fails unconditionally. Good for creating test stubs that youintend to fill out later. The optional @scheme[message] is included in the output if the check fails.}
|
@defproc[(fail (message string? "")) #t]{This checks fails unconditionally. Good for creating test stubs that youintend to fill out later. The optional @racket[message] is included in the output if the check fails.}
|
||||||
|
|
||||||
|
|
||||||
@defproc[(check-regexp-match (regexp regexp?) (string string?)) #t]{Checks that @scheme[regexp] matches the @scheme[string].}
|
@defproc[(check-regexp-match (regexp regexp?) (string string?)) #t]{Checks that @racket[regexp] matches the @racket[string].}
|
||||||
|
|
||||||
The following check will succeed:
|
The following check will succeed:
|
||||||
|
|
||||||
@schemeblock[(check-regexp-match "a+bba" "aaaaaabba")]
|
@racketblock[(check-regexp-match "a+bba" "aaaaaabba")]
|
||||||
|
|
||||||
This check will fail:
|
This check will fail:
|
||||||
|
|
||||||
@schemeblock[(check-regexp-match "a+bba" "aaaabbba")]
|
@racketblock[(check-regexp-match "a+bba" "aaaabbba")]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -146,8 +146,8 @@ When an check fails it stores information including the name
|
||||||
of the check, the location and message (if available), the
|
of the check, the location and message (if available), the
|
||||||
expression the check is called with, and the parameters to
|
expression the check is called with, and the parameters to
|
||||||
the check. Additional information can be stored by using
|
the check. Additional information can be stored by using
|
||||||
the @scheme[with-check-info*] function, and the
|
the @racket[with-check-info*] function, and the
|
||||||
@scheme[with-check-info] macro.
|
@racket[with-check-info] macro.
|
||||||
|
|
||||||
@defstruct[check-info ([name symbol?] [value any])]{
|
@defstruct[check-info ([name symbol?] [value any])]{
|
||||||
|
|
||||||
|
@ -170,13 +170,13 @@ misspelling errors:
|
||||||
|
|
||||||
@defproc[(with-check-info* (info (listof check-info?)) (thunk (-> any))) any]{
|
@defproc[(with-check-info* (info (listof check-info?)) (thunk (-> any))) any]{
|
||||||
|
|
||||||
Stores the given @scheme[info] on the check-info stack for
|
Stores the given @racket[info] on the check-info stack for
|
||||||
the duration (the dynamic extent) of the execution of
|
the duration (the dynamic extent) of the execution of
|
||||||
@scheme[thunk]}
|
@racket[thunk]}
|
||||||
|
|
||||||
Example:
|
Example:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(with-check-info*
|
(with-check-info*
|
||||||
(list (make-check-info 'time (current-seconds)))
|
(list (make-check-info 'time (current-seconds)))
|
||||||
(lambda () (check = 1 2)))
|
(lambda () (check = 1 2)))
|
||||||
|
@ -191,14 +191,14 @@ check failure.
|
||||||
|
|
||||||
@defform[(with-check-info ((name val) ...) body ...)]{
|
@defform[(with-check-info ((name val) ...) body ...)]{
|
||||||
|
|
||||||
The @scheme[with-check-info] macro stores the given
|
The @racket[with-check-info] macro stores the given
|
||||||
information in the check information stack for the duration
|
information in the check information stack for the duration
|
||||||
of the execution of the body expressions. @scheme[Name] is
|
of the execution of the body expressions. @racket[Name] is
|
||||||
a quoted symbol and @scheme[val] is any value.}
|
a quoted symbol and @racket[val] is any value.}
|
||||||
|
|
||||||
Example:
|
Example:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (elt)
|
(lambda (elt)
|
||||||
(with-check-info
|
(with-check-info
|
||||||
|
@ -218,7 +218,7 @@ check failure.
|
||||||
|
|
||||||
@section{Custom Checks}
|
@section{Custom Checks}
|
||||||
|
|
||||||
Custom checks can be defined using @scheme[define-check] and
|
Custom checks can be defined using @racket[define-check] and
|
||||||
its variants. To effectively use these macros it is useful
|
its variants. To effectively use these macros it is useful
|
||||||
to understand a few details about a check's evaluation
|
to understand a few details about a check's evaluation
|
||||||
model.
|
model.
|
||||||
|
@ -229,17 +229,17 @@ always evaluate their arguments exactly once before
|
||||||
executing any expressions in the body of the checks. Hence
|
executing any expressions in the body of the checks. Hence
|
||||||
if you wish to write checks that evalute user defined code
|
if you wish to write checks that evalute user defined code
|
||||||
that code must be wrapped in a thunk (a function of no
|
that code must be wrapped in a thunk (a function of no
|
||||||
arguments) by the user. The predefined @scheme[check-exn]
|
arguments) by the user. The predefined @racket[check-exn]
|
||||||
is an example of this type of check.
|
is an example of this type of check.
|
||||||
|
|
||||||
It is also useful to understand how the check information
|
It is also useful to understand how the check information
|
||||||
stack operates. The stack is stored in a parameter and the
|
stack operates. The stack is stored in a parameter and the
|
||||||
@scheme[with-check-info] forms evaluate to calls to
|
@racket[with-check-info] forms evaluate to calls to
|
||||||
@scheme[parameterize]. Hence check information has lexical
|
@racket[parameterize]. Hence check information has lexical
|
||||||
scope. For this reason simple checks (see below) cannot
|
scope. For this reason simple checks (see below) cannot
|
||||||
usefully contain calls to @scheme[with-check-info] to report
|
usefully contain calls to @racket[with-check-info] to report
|
||||||
additional information. All checks created using
|
additional information. All checks created using
|
||||||
@scheme[define-simple-check] or @scheme[define-check] grab
|
@racket[define-simple-check] or @racket[define-check] grab
|
||||||
some information by default: the name of the checks and the
|
some information by default: the name of the checks and the
|
||||||
values of the parameters. Additionally the macro forms of
|
values of the parameters. Additionally the macro forms of
|
||||||
checks grab location information and the expressions passed
|
checks grab location information and the expressions passed
|
||||||
|
@ -247,26 +247,26 @@ as parameters.
|
||||||
|
|
||||||
@defform[(define-simple-check (name param ...) expr ...)]{
|
@defform[(define-simple-check (name param ...) expr ...)]{
|
||||||
|
|
||||||
The @scheme[define-simple-check] macro constructs a check
|
The @racket[define-simple-check] macro constructs a check
|
||||||
called @scheme[name] that takes the params and an optional
|
called @racket[name] that takes the params and an optional
|
||||||
message as arguments and evaluates the @scheme[expr]s. The
|
message as arguments and evaluates the @racket[expr]s. The
|
||||||
check fails if the result of the @scheme[expr]s is
|
check fails if the result of the @racket[expr]s is
|
||||||
@scheme[#f]. Otherwise the check succeeds. Note that
|
@racket[#f]. Otherwise the check succeeds. Note that
|
||||||
simple checks cannot report extra information using
|
simple checks cannot report extra information using
|
||||||
@scheme[with-check-info].}
|
@racket[with-check-info].}
|
||||||
|
|
||||||
Example:
|
Example:
|
||||||
|
|
||||||
To define a check @scheme[check-odd?]
|
To define a check @racket[check-odd?]
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(define-simple-check (check-odd? number)
|
(define-simple-check (check-odd? number)
|
||||||
(odd? number))
|
(odd? number))
|
||||||
]
|
]
|
||||||
|
|
||||||
We can use these checks in the usual way:
|
We can use these checks in the usual way:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(check-odd? 3) (code:comment "Success")
|
(check-odd? 3) (code:comment "Success")
|
||||||
(check-odd? 2) (code:comment "Failure")
|
(check-odd? 2) (code:comment "Failure")
|
||||||
]
|
]
|
||||||
|
@ -274,12 +274,12 @@ We can use these checks in the usual way:
|
||||||
@defform*[[(define-binary-check (name pred actual expected))
|
@defform*[[(define-binary-check (name pred actual expected))
|
||||||
(define-binary-check (name actual expected) expr ...)]]{
|
(define-binary-check (name actual expected) expr ...)]]{
|
||||||
|
|
||||||
The @scheme[define-binary-check] macro constructs a check
|
The @racket[define-binary-check] macro constructs a check
|
||||||
that tests a binary predicate. It's benefit over
|
that tests a binary predicate. It's benefit over
|
||||||
@scheme[define-simple-check] is in better reporting on check
|
@racket[define-simple-check] is in better reporting on check
|
||||||
failure. The first form of the macro accepts a binary
|
failure. The first form of the macro accepts a binary
|
||||||
predicate and tests if the predicate holds for the given
|
predicate and tests if the predicate holds for the given
|
||||||
values. The second form tests if @scheme[expr] non-false.
|
values. The second form tests if @racket[expr] non-false.
|
||||||
}
|
}
|
||||||
|
|
||||||
Examples:
|
Examples:
|
||||||
|
@ -287,13 +287,13 @@ Examples:
|
||||||
Here's the first form, where we use a predefined predicate
|
Here's the first form, where we use a predefined predicate
|
||||||
to construct a binary check:
|
to construct a binary check:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(define-binary-check (check-char=? char=? actual expected))
|
(define-binary-check (check-char=? char=? actual expected))
|
||||||
]
|
]
|
||||||
|
|
||||||
In use:
|
In use:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(check-char=? (read-char a-port) #\a)
|
(check-char=? (read-char a-port) #\a)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
@ -301,7 +301,7 @@ If the expression is more complicated the second form should
|
||||||
be used. For example, below we define a binary check that
|
be used. For example, below we define a binary check that
|
||||||
tests a number if within 0.01 of the expected value:
|
tests a number if within 0.01 of the expected value:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(define-binary-check (check-in-tolerance actual expected)
|
(define-binary-check (check-in-tolerance actual expected)
|
||||||
(< (abs (- actual expected)) 0.01))
|
(< (abs (- actual expected)) 0.01))
|
||||||
]
|
]
|
||||||
|
@ -309,22 +309,22 @@ tests a number if within 0.01 of the expected value:
|
||||||
|
|
||||||
@defform[(define-check (name param ...) expr ...)]{
|
@defform[(define-check (name param ...) expr ...)]{
|
||||||
|
|
||||||
The @scheme[define-check] macro acts in exactly the same way
|
The @racket[define-check] macro acts in exactly the same way
|
||||||
as @scheme[define-simple-check], except the check only fails
|
as @racket[define-simple-check], except the check only fails
|
||||||
if the macro @scheme[fail-check] is called in the body of
|
if the macro @racket[fail-check] is called in the body of
|
||||||
the check. This allows more flexible checks, and in
|
the check. This allows more flexible checks, and in
|
||||||
particular more flexible reporting options.}
|
particular more flexible reporting options.}
|
||||||
|
|
||||||
@defform[(fail-check)]{The @scheme[fail-check] macro raises an @scheme[exn:test:check] with
|
@defform[(fail-check)]{The @racket[fail-check] macro raises an @racket[exn:test:check] with
|
||||||
the contents of the check information stack.}
|
the contents of the check information stack.}
|
||||||
|
|
||||||
|
|
||||||
@section{The Check Evaluation Context}
|
@section{The Check Evaluation Context}
|
||||||
|
|
||||||
The semantics of checks are determined by the parameters
|
The semantics of checks are determined by the parameters
|
||||||
@scheme[current-check-around] and
|
@racket[current-check-around] and
|
||||||
@scheme[current-check-handler]. Other testing form such as
|
@racket[current-check-handler]. Other testing form such as
|
||||||
@scheme[test-begin] and @scheme[test-suite] change the value
|
@racket[test-begin] and @racket[test-suite] change the value
|
||||||
of these parameters.
|
of these parameters.
|
||||||
|
|
||||||
@defparam[current-check-handler handler (-> any/c any/c)]{
|
@defparam[current-check-handler handler (-> any/c any/c)]{
|
||||||
|
@ -338,8 +338,8 @@ trace. }
|
||||||
|
|
||||||
Parameter containing the function that handles the execution
|
Parameter containing the function that handles the execution
|
||||||
of checks. The default value wraps the evaluation of
|
of checks. The default value wraps the evaluation of
|
||||||
@scheme[thunk] in a @scheme[with-handlers] call that calls
|
@racket[thunk] in a @racket[with-handlers] call that calls
|
||||||
@scheme[current-check-handler] if an exception is raised and then
|
@racket[current-check-handler] if an exception is raised and then
|
||||||
(when an exception is not raised) discards the result, returning
|
(when an exception is not raised) discards the result, returning
|
||||||
@scheme[(void)].
|
@racket[(void)].
|
||||||
}
|
}
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scribble/doc
|
#lang scribble/doc
|
||||||
@(require "base.ss")
|
@(require "base.rkt")
|
||||||
|
|
||||||
@title{Compound Testing Forms}
|
@title{Compound Testing Forms}
|
||||||
|
|
||||||
|
@ -15,14 +15,14 @@ will not be evaluated.
|
||||||
|
|
||||||
@defform[(test-begin expr ...)]{
|
@defform[(test-begin expr ...)]{
|
||||||
|
|
||||||
A @scheme[test-begin] form groups the @scheme[expr]s into a
|
A @racket[test-begin] form groups the @racket[expr]s into a
|
||||||
single unit. If any @scheme[expr] fails the following ones
|
single unit. If any @racket[expr] fails the following ones
|
||||||
are not evaluated. }
|
are not evaluated. }
|
||||||
|
|
||||||
For example, in the following code the world is not
|
For example, in the following code the world is not
|
||||||
destroyed as the preceding check fails:
|
destroyed as the preceding check fails:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(test-begin
|
(test-begin
|
||||||
(check-eq? 'a 'b)
|
(check-eq? 'a 'b)
|
||||||
(code:comment "This line won't be run")
|
(code:comment "This line won't be run")
|
||||||
|
@ -31,14 +31,14 @@ destroyed as the preceding check fails:
|
||||||
|
|
||||||
@defform[(test-case name expr ...)]{
|
@defform[(test-case name expr ...)]{
|
||||||
|
|
||||||
Like a @scheme[test-begin] except a name is associated with
|
Like a @racket[test-begin] except a name is associated with
|
||||||
the group of @scheme[expr]s. The name will be reported if
|
the group of @racket[expr]s. The name will be reported if
|
||||||
the test fails. }
|
the test fails. }
|
||||||
|
|
||||||
Here's the above example rewritten to use @scheme[test-case]
|
Here's the above example rewritten to use @racket[test-case]
|
||||||
so the test can be named.
|
so the test can be named.
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(test-case
|
(test-case
|
||||||
"Example test"
|
"Example test"
|
||||||
(check-eq? 'a 'b)
|
(check-eq? 'a 'b)
|
||||||
|
@ -48,7 +48,7 @@ so the test can be named.
|
||||||
|
|
||||||
|
|
||||||
@defproc[(test-case? (obj any)) boolean?]{
|
@defproc[(test-case? (obj any)) boolean?]{
|
||||||
True if @scheme[obj] is a test case, and false otherwise
|
True if @racket[obj] is a test case, and false otherwise
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -69,10 +69,10 @@ run. Instead use one of the functions described in
|
||||||
#:contracts ([name-expr string?])]{
|
#:contracts ([name-expr string?])]{
|
||||||
|
|
||||||
Constructs a test suite with the given name and tests. The
|
Constructs a test suite with the given name and tests. The
|
||||||
tests may be test cases, constructed using @scheme[test-begin] or
|
tests may be test cases, constructed using @racket[test-begin] or
|
||||||
@scheme[test-case], or other test suites.
|
@racket[test-case], or other test suites.
|
||||||
|
|
||||||
The @scheme[before-thunk] and @scheme[after-thunk] are
|
The @racket[before-thunk] and @racket[after-thunk] are
|
||||||
optional thunks (functions with no argument). They are run
|
optional thunks (functions with no argument). They are run
|
||||||
before and after the tests are run, respectively.
|
before and after the tests are run, respectively.
|
||||||
|
|
||||||
|
@ -84,7 +84,7 @@ For example, here is a test suite that displays @tt{Before}
|
||||||
before any tests are run, and @tt{After} when the tests have
|
before any tests are run, and @tt{After} when the tests have
|
||||||
finished.
|
finished.
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(test-suite
|
(test-suite
|
||||||
"An example suite"
|
"An example suite"
|
||||||
#:before (lambda () (display "Before"))
|
#:before (lambda () (display "Before"))
|
||||||
|
@ -103,13 +103,13 @@ finished.
|
||||||
[#:after after-thunk (-> any) void])
|
[#:after after-thunk (-> any) void])
|
||||||
test-suite?]{
|
test-suite?]{
|
||||||
|
|
||||||
Constructs a test suite with the given @scheme[name] containing the
|
Constructs a test suite with the given @racket[name] containing the
|
||||||
given @scheme[tests]. Unlike the @scheme[test-suite] form, the tests
|
given @racket[tests]. Unlike the @racket[test-suite] form, the tests
|
||||||
are represented as a list of test values.
|
are represented as a list of test values.
|
||||||
}
|
}
|
||||||
|
|
||||||
@defproc[(test-suite? (obj any)) boolean?]{ True if
|
@defproc[(test-suite? (obj any)) boolean?]{ True if
|
||||||
@scheme[obj] is a test suite, and false otherwise}
|
@racket[obj] is a test suite, and false otherwise}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -119,25 +119,25 @@ There are some macros that simplify the common cases of
|
||||||
defining test suites:
|
defining test suites:
|
||||||
|
|
||||||
@defform[(define-test-suite name test ...)]{ The
|
@defform[(define-test-suite name test ...)]{ The
|
||||||
@scheme[define-test-suite] form creates a test suite with
|
@racket[define-test-suite] form creates a test suite with
|
||||||
the given name (converted to a string) and tests, and binds
|
the given name (converted to a string) and tests, and binds
|
||||||
it to the same name.}
|
it to the same name.}
|
||||||
|
|
||||||
For example, this code creates a binding for the name
|
For example, this code creates a binding for the name
|
||||||
@scheme[example-suite] as well as creating a test suite with
|
@racket[example-suite] as well as creating a test suite with
|
||||||
the name @scheme["example-suite"]:
|
the name @racket["example-suite"]:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(define-test-suite example-suite
|
(define-test-suite example-suite
|
||||||
(check = 1 1))
|
(check = 1 1))
|
||||||
]
|
]
|
||||||
|
|
||||||
@defform[(define/provide-test-suite name test ...)]{ This
|
@defform[(define/provide-test-suite name test ...)]{ This
|
||||||
for is just like @scheme[define-test-suite], and in addition
|
for is just like @racket[define-test-suite], and in addition
|
||||||
it @scheme[provide]s the test suite.}
|
it @racket[provide]s the test suite.}
|
||||||
|
|
||||||
@;{
|
@;{
|
||||||
Finally, there is the @scheme[test-suite*] macro, which
|
Finally, there is the @racket[test-suite*] macro, which
|
||||||
defines a test suite and test cases using a shorthand
|
defines a test suite and test cases using a shorthand
|
||||||
syntax:
|
syntax:
|
||||||
|
|
||||||
|
@ -147,7 +147,7 @@ creates test cases within the suite, with the given names and
|
||||||
body expressions.
|
body expressions.
|
||||||
|
|
||||||
As far I know no-one uses this macro, so it might disappear
|
As far I know no-one uses this macro, so it might disappear
|
||||||
in future versions of SchemeUnit.}
|
in future versions of RktUnit.}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -159,8 +159,8 @@ control the semantics of compound testing forms.
|
||||||
@defparam[current-test-name name (or/c string? false/c)]{
|
@defparam[current-test-name name (or/c string? false/c)]{
|
||||||
|
|
||||||
This parameter stores the name of the current test case. A
|
This parameter stores the name of the current test case. A
|
||||||
value of @scheme[#f] indicates a test case with no name,
|
value of @racket[#f] indicates a test case with no name,
|
||||||
such as one constructed by @scheme[test-begin]. }
|
such as one constructed by @racket[test-begin]. }
|
||||||
|
|
||||||
@defparam[current-test-case-around handler (-> (-> any/c) any/c)]{
|
@defparam[current-test-case-around handler (-> (-> any/c) any/c)]{
|
||||||
|
|
||||||
|
@ -168,20 +168,20 @@ This parameter handles evaluation of test cases. The value
|
||||||
of the parameter is a function that is passed a thunk (a
|
of the parameter is a function that is passed a thunk (a
|
||||||
function of no arguments). The function, when applied,
|
function of no arguments). The function, when applied,
|
||||||
evaluates the expressions within a test case. The default
|
evaluates the expressions within a test case. The default
|
||||||
value of the @scheme[current-test-case-around] parameters
|
value of the @racket[current-test-case-around] parameters
|
||||||
evaluates the thunk in a context that catches exceptions and
|
evaluates the thunk in a context that catches exceptions and
|
||||||
prints an appropriate message indicating test case failure.}
|
prints an appropriate message indicating test case failure.}
|
||||||
|
|
||||||
@defproc[(test-suite-test-case-around [thunk (-> any/c)]) any/c]{
|
@defproc[(test-suite-test-case-around [thunk (-> any/c)]) any/c]{
|
||||||
|
|
||||||
The @scheme[current-test-case-around] parameter is
|
The @racket[current-test-case-around] parameter is
|
||||||
parameterized to this value within the scope of a
|
parameterized to this value within the scope of a
|
||||||
@scheme[test-suite]. This function creates a test case
|
@racket[test-suite]. This function creates a test case
|
||||||
structure instead of immediately evaluating the thunk.}
|
structure instead of immediately evaluating the thunk.}
|
||||||
|
|
||||||
@defproc[(test-suite-check-around [thunk (-> any/c)]) any/c]{
|
@defproc[(test-suite-check-around [thunk (-> any/c)]) any/c]{
|
||||||
|
|
||||||
The @scheme[current-check-around] parameter is parameterized
|
The @racket[current-check-around] parameter is parameterized
|
||||||
to this value within the scope of a @scheme[test-suite].
|
to this value within the scope of a @racket[test-suite].
|
||||||
This function creates a test case structure instead of
|
This function creates a test case structure instead of
|
||||||
immediately evaluating a check.}
|
immediately evaluating a check.}
|
|
@ -1,28 +1,28 @@
|
||||||
#lang scribble/doc
|
#lang scribble/doc
|
||||||
@(require "base.ss")
|
@(require "base.rkt")
|
||||||
|
|
||||||
@title{Test Control Flow}
|
@title{Test Control Flow}
|
||||||
|
|
||||||
The @scheme[before], @scheme[after], and @scheme[around]
|
The @racket[before], @racket[after], and @racket[around]
|
||||||
macros allow you to specify code that is always run before,
|
macros allow you to specify code that is always run before,
|
||||||
after, or around expressions in a test case.
|
after, or around expressions in a test case.
|
||||||
|
|
||||||
@defform[(before before-expr expr1 expr2 ...)]{
|
@defform[(before before-expr expr1 expr2 ...)]{
|
||||||
|
|
||||||
Whenever control enters the scope execute the @scheme[before-expr]
|
Whenever control enters the scope execute the @racket[before-expr]
|
||||||
before executing @scheme[expr-1], and @scheme[expr-2 ...]}
|
before executing @racket[expr-1], and @racket[expr-2 ...]}
|
||||||
|
|
||||||
@defform[(after expr-1 expr-2 ... after-expr)]{
|
@defform[(after expr-1 expr-2 ... after-expr)]{
|
||||||
|
|
||||||
Whenever control exits the scope execute the @scheme[after-expr]
|
Whenever control exits the scope execute the @racket[after-expr]
|
||||||
after executing @scheme[expr-1], and @scheme[expr-2 ...] The @scheme[after-expr] is
|
after executing @racket[expr-1], and @racket[expr-2 ...] The @racket[after-expr] is
|
||||||
executed even if control exits via an exception or other means.}
|
executed even if control exits via an exception or other means.}
|
||||||
|
|
||||||
@defform[(around before-expr expr-1 expr-2 ... after-expr)]{
|
@defform[(around before-expr expr-1 expr-2 ... after-expr)]{
|
||||||
|
|
||||||
Whenever control enters the scope execute the
|
Whenever control enters the scope execute the
|
||||||
@scheme[before-expr] before executing @scheme[expr-1 expr-2
|
@racket[before-expr] before executing @racket[expr-1 expr-2
|
||||||
...], and execute @scheme[after-expr] whenever control
|
...], and execute @racket[after-expr] whenever control
|
||||||
leaves the scope.}
|
leaves the scope.}
|
||||||
|
|
||||||
Example:
|
Example:
|
||||||
|
@ -31,7 +31,7 @@ The test below checks that the file @tt{test.dat} contains
|
||||||
the string @tt{"foo"}. The before action writes to this
|
the string @tt{"foo"}. The before action writes to this
|
||||||
file. The after action deletes it.
|
file. The after action deletes it.
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(around
|
(around
|
||||||
(with-output-to-file "test.dat"
|
(with-output-to-file "test.dat"
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
@ -46,7 +46,7 @@ file. The after action deletes it.
|
||||||
@defform[(delay-test test1 test2 ...)]{
|
@defform[(delay-test test1 test2 ...)]{
|
||||||
|
|
||||||
This somewhat curious macro evaluates the given tests in a
|
This somewhat curious macro evaluates the given tests in a
|
||||||
context where @scheme[current-test-case-around] is
|
context where @racket[current-test-case-around] is
|
||||||
parameterized to @scheme[test-suite-test-case-around]. This
|
parameterized to @racket[test-suite-test-case-around]. This
|
||||||
has been useful in testing SchemeUnit. It might be useful
|
has been useful in testing RktUnit. It might be useful
|
||||||
for you if you create test cases that create test cases.}
|
for you if you create test cases that create test cases.}
|
|
@ -1,7 +1,7 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
|
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
"file.scm")
|
"file.rkt")
|
||||||
|
|
||||||
(check-equal? (my-+ 1 1) 2)
|
(check-equal? (my-+ 1 1) 2)
|
||||||
(check-equal? (my-* 1 2) 2)
|
(check-equal? (my-* 1 2) 2)
|
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
|
#lang scribble/doc
|
||||||
@(require "base.ss")
|
@(require "base.rkt")
|
||||||
|
|
||||||
@title{Overview of SchemeUnit}
|
@title{Overview of RktUnit}
|
||||||
|
|
||||||
There are three basic data types in SchemeUnit:
|
There are three basic data types in RktUnit:
|
||||||
|
|
||||||
@itemize[
|
@itemize[
|
||||||
|
|
|
@ -1,10 +1,10 @@
|
||||||
#lang scribble/doc
|
#lang scribble/doc
|
||||||
@(require "base.ss")
|
@(require "base.rkt")
|
||||||
|
|
||||||
@title[#:tag "philosophy"]{The Philosophy of SchemeUnit}
|
@title[#:tag "philosophy"]{The Philosophy of RktUnit}
|
||||||
|
|
||||||
SchemeUnit is designed to allow tests to evolve in step with
|
RktUnit is designed to allow tests to evolve in step with
|
||||||
the evolution of the program under testing. SchemeUnit
|
the evolution of the program under testing. RktUnit
|
||||||
scales from the unstructed checks suitable for simple
|
scales from the unstructed checks suitable for simple
|
||||||
programs to the complex structure necessary for large
|
programs to the complex structure necessary for large
|
||||||
projects.
|
projects.
|
||||||
|
@ -19,23 +19,23 @@ For example, a HtDP student may be writing simple list
|
||||||
functions such as length, and the properties they are
|
functions such as length, and the properties they are
|
||||||
checking are of the form:
|
checking are of the form:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(equal? (length null) 0)
|
(equal? (length null) 0)
|
||||||
(equal? (length '(a)) 1)
|
(equal? (length '(a)) 1)
|
||||||
(equal? (length '(a b)) 2)
|
(equal? (length '(a b)) 2)
|
||||||
]
|
]
|
||||||
|
|
||||||
SchemeUnit directly supports this style of testing. A check
|
RktUnit directly supports this style of testing. A check
|
||||||
on its own is a valid test. So the above examples may be
|
on its own is a valid test. So the above examples may be
|
||||||
written in SchemeUnit as:
|
written in RktUnit as:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(check-equal? (length null) 0)
|
(check-equal? (length null) 0)
|
||||||
(check-equal? (length '(a)) 1)
|
(check-equal? (length '(a)) 1)
|
||||||
(check-equal? (length '(a b)) 2)
|
(check-equal? (length '(a b)) 2)
|
||||||
]
|
]
|
||||||
|
|
||||||
Simple programs now get all the benefits of SchemeUnit with
|
Simple programs now get all the benefits of RktUnit with
|
||||||
very little overhead.
|
very little overhead.
|
||||||
|
|
||||||
There are limitations to this style of testing that more
|
There are limitations to this style of testing that more
|
||||||
|
@ -45,31 +45,31 @@ it does not make sense to evaluate some expressions if
|
||||||
earlier ones have failed. This type of program needs a way
|
earlier ones have failed. This type of program needs a way
|
||||||
to group expressions so that a failure in one group causes
|
to group expressions so that a failure in one group causes
|
||||||
evaluation of that group to stop and immediately proceed to
|
evaluation of that group to stop and immediately proceed to
|
||||||
the next group. In SchemeUnit all that is required is to
|
the next group. In RktUnit all that is required is to
|
||||||
wrap a @scheme[test-begin] expression around a group of
|
wrap a @racket[test-begin] expression around a group of
|
||||||
expressions:
|
expressions:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(test-begin
|
(test-begin
|
||||||
(setup-some-state!)
|
(setup-some-state!)
|
||||||
(check-equal? (foo! 1) 'expected-value-1)
|
(check-equal? (foo! 1) 'expected-value-1)
|
||||||
(check-equal? (foo! 2) 'expected-value-2))
|
(check-equal? (foo! 2) 'expected-value-2))
|
||||||
]
|
]
|
||||||
|
|
||||||
Now if any expression within the @scheme[test-begin]
|
Now if any expression within the @racket[test-begin]
|
||||||
expression fails no further expressions in that group will
|
expression fails no further expressions in that group will
|
||||||
be evaluated.
|
be evaluated.
|
||||||
|
|
||||||
Notice that all the previous tests written in the simple
|
Notice that all the previous tests written in the simple
|
||||||
style are still valid. Introducing grouping is a local
|
style are still valid. Introducing grouping is a local
|
||||||
change only. This is a key feature of SchemeUnit's support
|
change only. This is a key feature of RktUnit's support
|
||||||
for the evolution of the program.
|
for the evolution of the program.
|
||||||
|
|
||||||
The programmer may wish to name a group of tests. This is
|
The programmer may wish to name a group of tests. This is
|
||||||
done using the @scheme[test-case] expression, a simple
|
done using the @racket[test-case] expression, a simple
|
||||||
variant on test-begin:
|
variant on test-begin:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(test-case
|
(test-case
|
||||||
"The name"
|
"The name"
|
||||||
... test expressions ...)
|
... test expressions ...)
|
||||||
|
@ -79,7 +79,7 @@ Most programs will stick with this style. However,
|
||||||
programmers writing very complex programs may wish to
|
programmers writing very complex programs may wish to
|
||||||
maintain separate groups of tests for different parts of the
|
maintain separate groups of tests for different parts of the
|
||||||
program, or run their tests in different ways to the normal
|
program, or run their tests in different ways to the normal
|
||||||
SchemeUnit manner (for example, test results may be logged
|
RktUnit manner (for example, test results may be logged
|
||||||
for the purpose of improving software quality, or they may
|
for the purpose of improving software quality, or they may
|
||||||
be displayed on a website to indicate service quality). For
|
be displayed on a website to indicate service quality). For
|
||||||
these programmers it is necessary to delay the execution of
|
these programmers it is necessary to delay the execution of
|
||||||
|
@ -87,7 +87,7 @@ tests so they can processed in the programmer's chosen
|
||||||
manner. To do this, the programmer simply wraps a test-suite
|
manner. To do this, the programmer simply wraps a test-suite
|
||||||
around their tests:
|
around their tests:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(test-suite
|
(test-suite
|
||||||
"Suite name"
|
"Suite name"
|
||||||
(check ...)
|
(check ...)
|
||||||
|
@ -104,15 +104,15 @@ outside the suite continue to evaluate as before.
|
||||||
@section{Historical Context}
|
@section{Historical Context}
|
||||||
|
|
||||||
Most testing frameworks, including earlier versions of
|
Most testing frameworks, including earlier versions of
|
||||||
SchemeUnit, support only the final form of testing. This is
|
RktUnit, support only the final form of testing. This is
|
||||||
likely due to the influence of the SUnit testing framework,
|
likely due to the influence of the SUnit testing framework,
|
||||||
which is the ancestor of SchemeUnit and the most widely used
|
which is the ancestor of RktUnit and the most widely used
|
||||||
frameworks in Java, .Net, Python, and Ruby, and many other
|
frameworks in Java, .Net, Python, and Ruby, and many other
|
||||||
languages. That this is insufficient for all users is
|
languages. That this is insufficient for all users is
|
||||||
apparent if one considers the proliferation of ``simpler''
|
apparent if one considers the proliferation of ``simpler''
|
||||||
testing frameworks in Scheme such as SRFI-78, or the
|
testing frameworks in Racket such as SRFI-78, or the
|
||||||
practice of beginner programmers. Unfortunately these
|
practice of beginner programmers. Unfortunately these
|
||||||
simpler methods are inadequate for testing larger
|
simpler methods are inadequate for testing larger
|
||||||
systems. To the best of my knowledge SchemeUnit is the only
|
systems. To the best of my knowledge RktUnit is the only
|
||||||
testing framework that makes a conscious effort to support
|
testing framework that makes a conscious effort to support
|
||||||
the testing style of all levels of programmer.
|
the testing style of all levels of programmer.
|
|
@ -1,14 +1,14 @@
|
||||||
#lang scribble/doc
|
#lang scribble/doc
|
||||||
@(require "base.ss")
|
@(require "base.rkt")
|
||||||
|
|
||||||
@title[#:tag "quick-start"]{Quick Start Guide for SchemeUnit}
|
@title[#:tag "quick-start"]{Quick Start Guide for RktUnit}
|
||||||
|
|
||||||
Suppose we have code contained in @tt{file.scm}, which
|
Suppose we have code contained in @tt{file.rkt}, which
|
||||||
implements buggy versions of @scheme[+] and @scheme[-]
|
implements buggy versions of @racket[+] and @racket[-]
|
||||||
called @scheme[my-+] and @scheme[my--]:
|
called @racket[my-+] and @racket[my--]:
|
||||||
|
|
||||||
@schememod[
|
@racketmod[
|
||||||
scheme/base
|
racket/base
|
||||||
|
|
||||||
(define (my-+ a b)
|
(define (my-+ a b)
|
||||||
(if (zero? a)
|
(if (zero? a)
|
||||||
|
@ -24,26 +24,26 @@ scheme/base
|
||||||
my-*)
|
my-*)
|
||||||
]
|
]
|
||||||
|
|
||||||
We want to test this code with SchemeUnit. We start by
|
We want to test this code with RktUnit. We start by
|
||||||
creating a file called @tt{file-test.scm} to contain our
|
creating a file called @tt{file-test.rkt} to contain our
|
||||||
tests. At the top of @tt{file-test.scm} we import
|
tests. At the top of @tt{file-test.rkt} we import
|
||||||
SchemeUnit and @tt{file.scm}:
|
RktUnit and @tt{file.rkt}:
|
||||||
|
|
||||||
@schememod[
|
@racketmod[
|
||||||
scheme/base
|
racket/base
|
||||||
|
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
"file.scm")
|
"file.rkt")
|
||||||
]
|
]
|
||||||
|
|
||||||
Now we add some tests to check our library:
|
Now we add some tests to check our library:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(check-equal? (my-+ 1 1) 2 "Simple addition")
|
(check-equal? (my-+ 1 1) 2 "Simple addition")
|
||||||
(check-equal? (my-* 1 2) 2 "Simple multiplication")
|
(check-equal? (my-* 1 2) 2 "Simple multiplication")
|
||||||
]
|
]
|
||||||
|
|
||||||
This is all it takes to define tests in SchemeUnit. Now
|
This is all it takes to define tests in RktUnit. Now
|
||||||
evaluate this file and see if the library is correct.
|
evaluate this file and see if the library is correct.
|
||||||
Here's the result I get:
|
Here's the result I get:
|
||||||
|
|
||||||
|
@ -52,7 +52,7 @@ Here's the result I get:
|
||||||
--------------------
|
--------------------
|
||||||
FAILURE
|
FAILURE
|
||||||
name: check-equal?
|
name: check-equal?
|
||||||
location: (file-test.scm 7 0 117 27)
|
location: (file-test.rkt 7 0 117 27)
|
||||||
expression: (check-equal? (my-* 1 2) 2)
|
expression: (check-equal? (my-* 1 2) 2)
|
||||||
params: (4 2)
|
params: (4 2)
|
||||||
actual: 4
|
actual: 4
|
||||||
|
@ -60,21 +60,21 @@ expected: 2
|
||||||
|
|
||||||
--------------------}
|
--------------------}
|
||||||
|
|
||||||
The first @scheme[#t] indicates the first test passed. The
|
The first @racket[#t] indicates the first test passed. The
|
||||||
second test failed, as shown by the message.
|
second test failed, as shown by the message.
|
||||||
|
|
||||||
Requiring SchemeUnit and writing checks is all you need to
|
Requiring RktUnit and writing checks is all you need to
|
||||||
get started testing, but let's take a little bit more time
|
get started testing, but let's take a little bit more time
|
||||||
to look at some features beyond the essentials.
|
to look at some features beyond the essentials.
|
||||||
|
|
||||||
Let's say we want to check that a number of properties hold.
|
Let's say we want to check that a number of properties hold.
|
||||||
How do we do this? So far we've only seen checks of a
|
How do we do this? So far we've only seen checks of a
|
||||||
single expression. In SchemeUnit a check is always a single
|
single expression. In RktUnit a check is always a single
|
||||||
expression, but we can group checks into units called test
|
expression, but we can group checks into units called test
|
||||||
cases. Here's a simple test case written using the
|
cases. Here's a simple test case written using the
|
||||||
@scheme[test-begin] form:
|
@racket[test-begin] form:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(test-begin
|
(test-begin
|
||||||
(let ((lst (list 2 4 6 9)))
|
(let ((lst (list 2 4 6 9)))
|
||||||
(check = (length lst) 4)
|
(check = (length lst) 4)
|
||||||
|
@ -91,24 +91,24 @@ Evalute this and you should see an error message like:
|
||||||
A test
|
A test
|
||||||
... has a FAILURE
|
... has a FAILURE
|
||||||
name: check-pred
|
name: check-pred
|
||||||
location: (#<path:/Users/noel/programming/schematics/schemeunit/branches/v3/doc/file-test.scm> 14 6 252 22)
|
location: (#<path:/Users/noel/programming/schematics/rktunit/branches/v3/doc/file-test.rkt> 14 6 252 22)
|
||||||
expression: (check-pred even? elt)
|
expression: (check-pred even? elt)
|
||||||
params: (#<procedure:even?> 9)
|
params: (#<procedure:even?> 9)
|
||||||
--------------------
|
--------------------
|
||||||
}
|
}
|
||||||
|
|
||||||
This tells us that the expression @scheme[(check-pred even?
|
This tells us that the expression @racket[(check-pred even?
|
||||||
elt)] failed. The arguments of this check were
|
elt)] failed. The arguments of this check were
|
||||||
@scheme[even?] and @scheme[9], and as 9 is not even the
|
@racket[even?] and @racket[9], and as 9 is not even the
|
||||||
check failed. A test case fails as soon as any check within
|
check failed. A test case fails as soon as any check within
|
||||||
it fails, and no further checks are evaluated once this
|
it fails, and no further checks are evaluated once this
|
||||||
takes place.
|
takes place.
|
||||||
|
|
||||||
Naming our test cases if useful as it helps remind us what
|
Naming our test cases if useful as it helps remind us what
|
||||||
we're testing. We can give a test case a name with the
|
we're testing. We can give a test case a name with the
|
||||||
@scheme[test-case] form:
|
@racket[test-case] form:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(test-case
|
(test-case
|
||||||
"List has length 4 and all elements even"
|
"List has length 4 and all elements even"
|
||||||
(let ((lst (list 2 4 6 9)))
|
(let ((lst (list 2 4 6 9)))
|
||||||
|
@ -122,10 +122,10 @@ we're testing. We can give a test case a name with the
|
||||||
Now if we want to structure our tests are bit more we can
|
Now if we want to structure our tests are bit more we can
|
||||||
group them into a test suite:
|
group them into a test suite:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(define file-tests
|
(define file-tests
|
||||||
(test-suite
|
(test-suite
|
||||||
"Tests for file.scm"
|
"Tests for file.rkt"
|
||||||
|
|
||||||
(check-equal? (my-+ 1 1) 2 "Simple addition")
|
(check-equal? (my-+ 1 1) 2 "Simple addition")
|
||||||
|
|
||||||
|
@ -147,13 +147,13 @@ tests, allowing you to choose how you run your tests. You
|
||||||
might, for example, print the results to the screen or log
|
might, for example, print the results to the screen or log
|
||||||
them to a file.
|
them to a file.
|
||||||
|
|
||||||
Let's run our tests, using SchemeUnit's simple textual user
|
Let's run our tests, using RktUnit's simple textual user
|
||||||
interface (there are fancier interfaces available but this
|
interface (there are fancier interfaces available but this
|
||||||
will do for our example). In @tt{file-test.scm} add the
|
will do for our example). In @tt{file-test.rkt} add the
|
||||||
following lines:
|
following lines:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(require schemeunit/text-ui)
|
(require rktunit/text-ui)
|
||||||
|
|
||||||
(run-tests file-tests)
|
(run-tests file-tests)
|
||||||
]
|
]
|
||||||
|
@ -161,6 +161,6 @@ following lines:
|
||||||
Now evaluate the file and you should see similar output
|
Now evaluate the file and you should see similar output
|
||||||
again.
|
again.
|
||||||
|
|
||||||
These are the basics of SchemeUnit. Refer to the
|
These are the basics of RktUnit. Refer to the
|
||||||
documentation below for more advanced topics, such as
|
documentation below for more advanced topics, such as
|
||||||
defining your own checks. Have fun!
|
defining your own checks. Have fun!
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scribble/doc
|
#lang scribble/doc
|
||||||
@(require "base.ss")
|
@(require "base.rkt")
|
||||||
|
|
||||||
@title{Release Notes}
|
@title{Release Notes}
|
||||||
|
|
||||||
|
@ -12,7 +12,7 @@ There are also miscellaneous Scribble fixes.
|
||||||
|
|
||||||
@section{Version 3}
|
@section{Version 3}
|
||||||
|
|
||||||
This version of SchemeUnit is largely backwards compatible
|
This version of RktUnit is largely backwards compatible
|
||||||
with version 2 but there are significant changes to the
|
with version 2 but there are significant changes to the
|
||||||
underlying model, justifying incrementing the major version
|
underlying model, justifying incrementing the major version
|
||||||
number. These changes are best explained in
|
number. These changes are best explained in
|
||||||
|
@ -24,9 +24,9 @@ hopefully be corrected in later minor version releases:
|
||||||
@itemize[
|
@itemize[
|
||||||
|
|
||||||
@item{There is no graphical UI, and in particular no
|
@item{There is no graphical UI, and in particular no
|
||||||
integration with DrScheme.}
|
integration with DrRacket.}
|
||||||
|
|
||||||
@item{The semantics of @scheme[test-suite] are not the
|
@item{The semantics of @racket[test-suite] are not the
|
||||||
desired ones. In particular, only checks and test cases
|
desired ones. In particular, only checks and test cases
|
||||||
have their evaluation delayed by a test suite; other
|
have their evaluation delayed by a test suite; other
|
||||||
expressions will be evaluated before the suite is
|
expressions will be evaluated before the suite is
|
|
@ -1,13 +1,13 @@
|
||||||
#lang scribble/doc
|
#lang scribble/doc
|
||||||
@(require "base.ss")
|
@(require "base.rkt")
|
||||||
|
|
||||||
@title{@bold{SchemeUnit}: Unit Testing for Scheme}
|
@title{@bold{RktUnit}: Unit Testing for Racket}
|
||||||
|
|
||||||
@author[(author+email "Noel Welsh" "noelwelsh@gmail.com")
|
@author[(author+email "Noel Welsh" "noelwelsh@gmail.com")
|
||||||
(author+email "Ryan Culpepper" "ryan_sml@yahoo.com")]
|
(author+email "Ryan Culpepper" "ryan_sml@yahoo.com")]
|
||||||
|
|
||||||
SchemeUnit is a unit-testing framework for PLT Scheme. It
|
RktUnit is a unit-testing framework for Racket. It
|
||||||
is designed to handle the needs of all Scheme programmers,
|
is designed to handle the needs of all Racket programmers,
|
||||||
from novices to experts.
|
from novices to experts.
|
||||||
|
|
||||||
@table-of-contents[]
|
@table-of-contents[]
|
|
@ -1,29 +1,29 @@
|
||||||
#lang scribble/doc
|
#lang scribble/doc
|
||||||
@(require "base.ss")
|
@(require "base.rkt")
|
||||||
|
|
||||||
@title[#:tag "running"]{Programmatically Running Tests and Inspecting Results}
|
@title[#:tag "running"]{Programmatically Running Tests and Inspecting Results}
|
||||||
|
|
||||||
SchemeUnit provides an API for running tests, from which
|
RktUnit provides an API for running tests, from which
|
||||||
custom UIs can be created.
|
custom UIs can be created.
|
||||||
|
|
||||||
@section{Result Types}
|
@section{Result Types}
|
||||||
|
|
||||||
@defstruct[(exn:test exn) ()]{
|
@defstruct[(exn:test exn) ()]{
|
||||||
|
|
||||||
The base structure for SchemeUnit exceptions. You should
|
The base structure for RktUnit exceptions. You should
|
||||||
never catch instances of this type, only the subtypes
|
never catch instances of this type, only the subtypes
|
||||||
documented below.}
|
documented below.}
|
||||||
|
|
||||||
@defstruct[(exn:test:check exn:test) ([stack (listof check-info)])]{
|
@defstruct[(exn:test:check exn:test) ([stack (listof check-info)])]{
|
||||||
|
|
||||||
A @scheme[exn:test:check] is raised when an check fails, and
|
A @racket[exn:test:check] is raised when an check fails, and
|
||||||
contains the contents of the check-info stack at the
|
contains the contents of the check-info stack at the
|
||||||
time of failure.}
|
time of failure.}
|
||||||
|
|
||||||
@defstruct[test-result ([test-case-name (or/c string #f)])]{
|
@defstruct[test-result ([test-case-name (or/c string #f)])]{
|
||||||
|
|
||||||
A test-result is the result of running the test with
|
A test-result is the result of running the test with
|
||||||
the given name (with @scheme[#f] indicating no name is available).}
|
the given name (with @racket[#f] indicating no name is available).}
|
||||||
|
|
||||||
@defstruct[(test-failure test-result) ([result any])]{
|
@defstruct[(test-failure test-result) ([result any])]{
|
||||||
|
|
||||||
|
@ -54,7 +54,7 @@ tree (list of lists) of results}
|
||||||
|
|
||||||
Example:
|
Example:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(run-test
|
(run-test
|
||||||
(test-suite
|
(test-suite
|
||||||
"Dummy"
|
"Dummy"
|
||||||
|
@ -69,22 +69,22 @@ Example:
|
||||||
[#:fup fup (string 'a . -> . 'a)])
|
[#:fup fup (string 'a . -> . 'a)])
|
||||||
'a]{
|
'a]{
|
||||||
|
|
||||||
Fold @scheme[result-fn] pre-order left-to-right depth-first
|
Fold @racket[result-fn] pre-order left-to-right depth-first
|
||||||
over the results of @scheme[run]. By default @scheme[run]
|
over the results of @racket[run]. By default @racket[run]
|
||||||
is @scheme[run-test-case] and @scheme[fdown] and
|
is @racket[run-test-case] and @racket[fdown] and
|
||||||
@scheme[fup] just return the seed, so @scheme[result-fn] is
|
@racket[fup] just return the seed, so @racket[result-fn] is
|
||||||
folded over the test results.
|
folded over the test results.
|
||||||
|
|
||||||
This function is useful for writing custom folds (and hence
|
This function is useful for writing custom folds (and hence
|
||||||
UIs) over test results without you having to take care of
|
UIs) over test results without you having to take care of
|
||||||
all the expected setup and teardown. For example,
|
all the expected setup and teardown. For example,
|
||||||
@scheme[fold-test-results] will run test suite before and
|
@racket[fold-test-results] will run test suite before and
|
||||||
after actions for you. However it is still flexible enough,
|
after actions for you. However it is still flexible enough,
|
||||||
via its keyword arguments, to do almost anything that foldts
|
via its keyword arguments, to do almost anything that foldts
|
||||||
can. Hence it should be used in preference to foldts.
|
can. Hence it should be used in preference to foldts.
|
||||||
|
|
||||||
@scheme[result-fn] is a function from the results of
|
@racket[result-fn] is a function from the results of
|
||||||
@scheme[run] (defaults to a @scheme[test-result]) and the
|
@racket[run] (defaults to a @racket[test-result]) and the
|
||||||
seed to a new seed
|
seed to a new seed
|
||||||
|
|
||||||
Seed is any value
|
Seed is any value
|
||||||
|
@ -104,7 +104,7 @@ Examples:
|
||||||
|
|
||||||
The following code counts the number of successes
|
The following code counts the number of successes
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(define (count-successes test)
|
(define (count-successes test)
|
||||||
(fold-test-results
|
(fold-test-results
|
||||||
(lambda (result seed)
|
(lambda (result seed)
|
||||||
|
@ -114,11 +114,11 @@ The following code counts the number of successes
|
||||||
0
|
0
|
||||||
test))]
|
test))]
|
||||||
|
|
||||||
The following code returns the symbol @scheme['burp] instead
|
The following code returns the symbol @racket['burp] instead
|
||||||
of running test cases. Note how the result-fn receives the
|
of running test cases. Note how the result-fn receives the
|
||||||
value of run.
|
value of run.
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(define (burp test)
|
(define (burp test)
|
||||||
(fold-test-results
|
(fold-test-results
|
||||||
(lambda (result seed) (cons result seed))
|
(lambda (result seed) (cons result seed))
|
||||||
|
@ -159,7 +159,7 @@ Example:
|
||||||
Here's the implementation of fold-test-results in terms of
|
Here's the implementation of fold-test-results in terms of
|
||||||
foldts:
|
foldts:
|
||||||
|
|
||||||
@schemeblock[
|
@racketblock[
|
||||||
(define (fold-test-results suite-fn case-fn seed test)
|
(define (fold-test-results suite-fn case-fn seed test)
|
||||||
(foldts
|
(foldts
|
||||||
(lambda (suite name before after seed)
|
(lambda (suite name before after seed)
|
||||||
|
@ -187,9 +187,9 @@ recorded, and so on. To do so the functions that run the
|
||||||
test cases need to know what type the test case has, and
|
test cases need to know what type the test case has, and
|
||||||
hence is is necessary to provide this information.
|
hence is is necessary to provide this information.
|
||||||
|
|
||||||
If you've made it this far you truly are a master SchemeUnit
|
If you've made it this far you truly are a master RktUnit
|
||||||
hacker. As a bonus prize we'll just mention that the code
|
hacker. As a bonus prize we'll just mention that the code
|
||||||
in hash-monad.ss and monad.ss might be of interest for
|
in hash-monad.rkt and monad.rkt might be of interest for
|
||||||
constructing user interfaces. The API is still in flux, so
|
constructing user interfaces. The API is still in flux, so
|
||||||
isn't documented here. However, do look at the
|
isn't documented here. However, do look at the
|
||||||
implementation of @scheme[run-tests] for examples of use.
|
implementation of @racket[run-tests] for examples of use.
|
|
@ -1,47 +1,47 @@
|
||||||
#lang scribble/doc
|
#lang scribble/doc
|
||||||
@(require "base.ss")
|
@(require "base.rkt")
|
||||||
|
|
||||||
@title[#:tag "ui"]{User Interfaces}
|
@title[#:tag "ui"]{User Interfaces}
|
||||||
|
|
||||||
SchemeUnit provides a textual and a graphical user interface
|
RktUnit provides a textual and a graphical user interface
|
||||||
|
|
||||||
@section{Textual User Interface}
|
@section{Textual User Interface}
|
||||||
|
|
||||||
@defmodule[schemeunit/text-ui]
|
@defmodule[rktunit/text-ui]
|
||||||
|
|
||||||
The textual UI is in the @schememodname[schemeunit/text-ui] module.
|
The textual UI is in the @racketmodname[rktunit/text-ui] module.
|
||||||
It is run via the @scheme[run-tests] function.
|
It is run via the @racket[run-tests] function.
|
||||||
|
|
||||||
@defproc[(run-tests (test (or/c test-case? test-suite?))
|
@defproc[(run-tests (test (or/c test-case? test-suite?))
|
||||||
(verbosity (symbols 'quiet 'normal 'verbose) 'normal))
|
(verbosity (symbols 'quiet 'normal 'verbose) 'normal))
|
||||||
natural-number/c]{
|
natural-number/c]{
|
||||||
|
|
||||||
The given @scheme[test] is run and the result of running it
|
The given @racket[test] is run and the result of running it
|
||||||
output to the @scheme[current-output-port]. The output is
|
output to the @racket[current-output-port]. The output is
|
||||||
compatable with the (X)Emacs next-error command (as used,
|
compatable with the (X)Emacs next-error command (as used,
|
||||||
for example, by (X)Emacs's compile function)
|
for example, by (X)Emacs's compile function)
|
||||||
|
|
||||||
The optional @scheme[verbosity] is one of @scheme['quiet],
|
The optional @racket[verbosity] is one of @racket['quiet],
|
||||||
@scheme['normal], or @scheme['verbose]. Quiet output
|
@racket['normal], or @racket['verbose]. Quiet output
|
||||||
displays only the number of successes, failures, and errors.
|
displays only the number of successes, failures, and errors.
|
||||||
Normal reporting suppresses some extraneous check
|
Normal reporting suppresses some extraneous check
|
||||||
information (such as the expression). Verbose reports all
|
information (such as the expression). Verbose reports all
|
||||||
information.
|
information.
|
||||||
|
|
||||||
@scheme[run-tests] returns the number of unsuccessful tests.}
|
@racket[run-tests] returns the number of unsuccessful tests.}
|
||||||
|
|
||||||
|
|
||||||
@section{Graphical User Interface}
|
@section{Graphical User Interface}
|
||||||
|
|
||||||
@defmodule[schemeunit/gui]
|
@defmodule[rktunit/gui]
|
||||||
|
|
||||||
SchemeUnit also provides a GUI test runner, available from the
|
RktUnit also provides a GUI test runner, available from the
|
||||||
@schememodname[schemeunit/gui] module.
|
@racketmodname[rktunit/gui] module.
|
||||||
|
|
||||||
@defproc[(test/gui [test (or/c test-case? test-suite?)] ...)
|
@defproc[(test/gui [test (or/c test-case? test-suite?)] ...)
|
||||||
any]{
|
any]{
|
||||||
|
|
||||||
Creates a new SchemeUnit GUI window and runs each @scheme[test]. The
|
Creates a new RktUnit GUI window and runs each @racket[test]. The
|
||||||
GUI is updated as tests complete.
|
GUI is updated as tests complete.
|
||||||
|
|
||||||
}
|
}
|
||||||
|
@ -49,7 +49,7 @@ GUI is updated as tests complete.
|
||||||
@defproc[(make-gui-runner)
|
@defproc[(make-gui-runner)
|
||||||
(-> (or/c test-case? test-suite?) ... any)]{
|
(-> (or/c test-case? test-suite?) ... any)]{
|
||||||
|
|
||||||
Creates a new SchemeUnit GUI window and returns a procedure that, when
|
Creates a new RktUnit GUI window and returns a procedure that, when
|
||||||
applied, runs the given tests and displays the results in the GUI.
|
applied, runs the given tests and displays the results in the GUI.
|
||||||
|
|
||||||
}
|
}
|
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
|
#lang racket/base
|
||||||
(require scheme/class
|
(require racket/class
|
||||||
scheme/gui
|
racket/gui
|
||||||
framework
|
framework
|
||||||
drscheme/tool
|
drscheme/tool
|
||||||
scheme/unit
|
racket/unit
|
||||||
(prefix-in drlink: "private/gui/drscheme-link.ss"))
|
(prefix-in drlink: "private/gui/drracket-link.rkt"))
|
||||||
|
|
||||||
(provide tool@)
|
(provide tool@)
|
||||||
|
|
||||||
;; CONSTANTS
|
;; CONSTANTS
|
||||||
|
|
||||||
(define BACKTRACE-NO-MESSAGE "No message.")
|
(define BACKTRACE-NO-MESSAGE "No message.")
|
||||||
(define LINK-MODULE-SPEC 'schemeunit/private/gui/drscheme-link)
|
(define LINK-MODULE-SPEC 'rktunit/private/gui/drracket-link)
|
||||||
|
|
||||||
(define-namespace-anchor drscheme-ns-anchor)
|
(define-namespace-anchor drracket-ns-anchor)
|
||||||
|
|
||||||
;; ----
|
;; ----
|
||||||
|
|
||||||
|
@ -71,7 +71,7 @@
|
||||||
show-backtrace
|
show-backtrace
|
||||||
show-source))
|
show-source))
|
||||||
|
|
||||||
(define drscheme-ns (namespace-anchor->namespace drscheme-ns-anchor))
|
(define drracket-ns (namespace-anchor->namespace drracket-ns-anchor))
|
||||||
|
|
||||||
(define interactions-text-mixin
|
(define interactions-text-mixin
|
||||||
(mixin ((class->interface drscheme:rep:text%)) ()
|
(mixin ((class->interface drscheme:rep:text%)) ()
|
||||||
|
@ -79,7 +79,7 @@
|
||||||
(super-new)
|
(super-new)
|
||||||
|
|
||||||
(define/private (setup-helper-module)
|
(define/private (setup-helper-module)
|
||||||
(namespace-attach-module drscheme-ns
|
(namespace-attach-module drracket-ns
|
||||||
LINK-MODULE-SPEC
|
LINK-MODULE-SPEC
|
||||||
(get-user-namespace)))
|
(get-user-namespace)))
|
||||||
|
|
|
@ -1,18 +1,3 @@
|
||||||
#lang scheme/base
|
#lang racket
|
||||||
(require scheme/contract
|
(require rktunit/gui)
|
||||||
(rename-in "private/base.ss")
|
(provide (all-from-out rktunit/gui))
|
||||||
"private/gui/gui.ss")
|
|
||||||
|
|
||||||
(define (test/gui . tests)
|
|
||||||
(apply (make-gui-runner) tests))
|
|
||||||
|
|
||||||
(define test/c (or/c schemeunit-test-case? schemeunit-test-suite?))
|
|
||||||
|
|
||||||
(provide/contract
|
|
||||||
[test/gui
|
|
||||||
(->* () () #:rest (listof test/c)
|
|
||||||
any)]
|
|
||||||
[make-gui-runner
|
|
||||||
(->
|
|
||||||
(->* () () #:rest (listof test/c)
|
|
||||||
any))])
|
|
|
@ -1,13 +1,3 @@
|
||||||
#lang setup/infotab
|
#lang setup/infotab
|
||||||
|
|
||||||
(define name "SchemeUnit")
|
(define name "SchemeUnit")
|
||||||
|
|
||||||
(define blurb '((p "SchemeUnit is a unit testing framework based on the "
|
|
||||||
" Extreme Programming unit test frameworks")))
|
|
||||||
|
|
||||||
(define scribblings '(("scribblings/schemeunit.scrbl" (multi-page) (tool))))
|
|
||||||
(define tools '[("tool.ss")])
|
|
||||||
(define tool-names '["SchemeUnit DrScheme integration"])
|
|
||||||
|
|
||||||
(define homepage "http://schematics.sourceforge.net/")
|
|
||||||
(define url "http://schematics.sourceforge.net/")
|
|
|
@ -1,31 +1,3 @@
|
||||||
;;;
|
#lang racket
|
||||||
;;; Time-stamp: <2008-07-30 10:46:00 nhw>
|
(require rktunit)
|
||||||
;;;
|
(provide (all-from-out rktunit))
|
||||||
;;; Copyright (C) by Noel Welsh.
|
|
||||||
;;;
|
|
||||||
|
|
||||||
;;; This library is free software; you can redistribute it
|
|
||||||
;;; and/or modify it under the terms of the GNU Lesser
|
|
||||||
;;; General Public License as published by the Free Software
|
|
||||||
;;; Foundation; either version 2.1 of the License, or (at
|
|
||||||
;;; your option) any later version.
|
|
||||||
|
|
||||||
;;; This library is distributed in the hope that it will be
|
|
||||||
;;; useful, but WITHOUT ANY WARRANTY; without even the
|
|
||||||
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
|
|
||||||
;;; PARTICULAR PURPOSE. See the GNU Lesser General Public
|
|
||||||
;;; License for more details.
|
|
||||||
|
|
||||||
;;; You should have received a copy of the GNU Lesser
|
|
||||||
;;; General Public License along with this library; if not,
|
|
||||||
;;; write to the Free Software Foundation, Inc., 59 Temple
|
|
||||||
;;; Place, Suite 330, Boston, MA 02111-1307 USA
|
|
||||||
|
|
||||||
;;; Author: Noel Welsh <noelwelsh@yahoo.com>
|
|
||||||
;;
|
|
||||||
;;
|
|
||||||
;; Commentary:
|
|
||||||
|
|
||||||
#lang scheme/base
|
|
||||||
(require "private/test.ss")
|
|
||||||
(provide (all-from-out "private/test.ss"))
|
|
|
@ -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 @@
|
||||||
;;;
|
#lang racket
|
||||||
;;; Time-stamp: <2009-06-11 17:11:22 noel>
|
(require rktunit/text-ui)
|
||||||
;;;
|
(provide (all-from-out rktunit/text-ui))
|
||||||
;;; Copyright (C) 2005 by Noel Welsh.
|
|
||||||
;;;
|
|
||||||
|
|
||||||
;;; This library is free software; you can redistribute it
|
|
||||||
;;; and/or modify it under the terms of the GNU Lesser
|
|
||||||
;;; General Public License as published by the Free Software
|
|
||||||
;;; Foundation; either version 2.1 of the License, or (at
|
|
||||||
;;; your option) any later version.
|
|
||||||
|
|
||||||
;;; This library is distributed in the hope that it will be
|
|
||||||
;;; useful, but WITHOUT ANY WARRANTY; without even the
|
|
||||||
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
|
|
||||||
;;; PARTICULAR PURPOSE. See the GNU Lesser General Public
|
|
||||||
;;; License for more details.
|
|
||||||
|
|
||||||
;;; You should have received a copy of the GNU Lesser
|
|
||||||
;;; General Public License along with this library; if not,
|
|
||||||
;;; write to the Free Software Foundation, Inc., 59 Temple
|
|
||||||
;;; Place, Suite 330, Boston, MA 02111-1307 USA
|
|
||||||
|
|
||||||
;;; Author: Noel Welsh <noelwelsh@yahoo.com>
|
|
||||||
;;
|
|
||||||
;;
|
|
||||||
;; Commentary:
|
|
||||||
|
|
||||||
#lang scheme/base
|
|
||||||
|
|
||||||
(require scheme/match
|
|
||||||
scheme/pretty
|
|
||||||
srfi/13
|
|
||||||
srfi/26
|
|
||||||
"main.ss"
|
|
||||||
"private/base.ss"
|
|
||||||
"private/counter.ss"
|
|
||||||
"private/format.ss"
|
|
||||||
"private/location.ss"
|
|
||||||
"private/result.ss"
|
|
||||||
"private/check-info.ss"
|
|
||||||
"private/monad.ss"
|
|
||||||
"private/hash-monad.ss"
|
|
||||||
"private/name-collector.ss"
|
|
||||||
"private/text-ui-util.ss")
|
|
||||||
|
|
||||||
(provide run-tests
|
|
||||||
display-context
|
|
||||||
display-exn
|
|
||||||
display-summary+return
|
|
||||||
display-ticker
|
|
||||||
display-result)
|
|
||||||
|
|
||||||
|
|
||||||
;; display-ticker : test-result -> void
|
|
||||||
;;
|
|
||||||
;; Prints a summary of the test result
|
|
||||||
(define (display-ticker result)
|
|
||||||
(cond
|
|
||||||
((test-error? result)
|
|
||||||
(display "!"))
|
|
||||||
((test-failure? result)
|
|
||||||
(display "-"))
|
|
||||||
(else
|
|
||||||
(display "."))))
|
|
||||||
|
|
||||||
;; display-test-preamble : test-result -> (hash-monad-of void)
|
|
||||||
(define (display-test-preamble result)
|
|
||||||
(lambda (hash)
|
|
||||||
(if (test-success? result)
|
|
||||||
hash
|
|
||||||
(begin
|
|
||||||
(display-delimiter)
|
|
||||||
hash))))
|
|
||||||
|
|
||||||
;; display-test-postamble : test-result -> (hash-monad-of void)
|
|
||||||
(define (display-test-postamble result)
|
|
||||||
(lambda (hash)
|
|
||||||
(if (test-success? result)
|
|
||||||
hash
|
|
||||||
(begin
|
|
||||||
(display-delimiter)
|
|
||||||
hash))))
|
|
||||||
|
|
||||||
|
|
||||||
;; display-result : test-result -> void
|
|
||||||
(define (display-result result)
|
|
||||||
(cond
|
|
||||||
((test-error? result)
|
|
||||||
(display-test-name (test-result-test-case-name result))
|
|
||||||
(display-error)
|
|
||||||
(newline))
|
|
||||||
((test-failure? result)
|
|
||||||
(display-test-name (test-result-test-case-name result))
|
|
||||||
(display-failure)
|
|
||||||
(newline))
|
|
||||||
(else
|
|
||||||
(void))))
|
|
||||||
|
|
||||||
|
|
||||||
;; strip-redundant-parms : (list-of check-info) -> (list-of check-info)
|
|
||||||
;;
|
|
||||||
;; Strip any check-params? is there is an
|
|
||||||
;; actual/expected check-info in the same stack frame. A
|
|
||||||
;; stack frame is delimited by occurrence of a check-name?
|
|
||||||
(define (strip-redundant-params stack)
|
|
||||||
(define (binary-check-this-frame? stack)
|
|
||||||
(let loop ([stack stack])
|
|
||||||
(cond
|
|
||||||
[(null? stack) #f]
|
|
||||||
[(check-name? (car stack)) #f]
|
|
||||||
[(check-actual? (car stack)) #t]
|
|
||||||
[else (loop (cdr stack))])))
|
|
||||||
(let loop ([stack stack])
|
|
||||||
(cond
|
|
||||||
[(null? stack) null]
|
|
||||||
[(check-params? (car stack))
|
|
||||||
(if (binary-check-this-frame? stack)
|
|
||||||
(loop (cdr stack))
|
|
||||||
(cons (car stack) (loop (cdr stack))))]
|
|
||||||
[else (cons (car stack) (loop (cdr stack)))])))
|
|
||||||
|
|
||||||
|
|
||||||
;; display-context : test-result [(U #t #f)] -> void
|
|
||||||
(define (display-context result [verbose? #f])
|
|
||||||
(cond
|
|
||||||
[(test-failure? result)
|
|
||||||
(let* ([exn (test-failure-result result)]
|
|
||||||
[stack (exn:test:check-stack exn)])
|
|
||||||
(textui-display-check-info-stack stack verbose?))]
|
|
||||||
[(test-error? result)
|
|
||||||
(let ([exn (test-error-result result)])
|
|
||||||
(textui-display-check-info-stack (check-info-stack (exn-continuation-marks exn)))
|
|
||||||
(display-exn exn))]
|
|
||||||
[else (void)]))
|
|
||||||
|
|
||||||
(define (textui-display-check-info-stack stack [verbose? #f])
|
|
||||||
(for-each
|
|
||||||
(lambda (info)
|
|
||||||
(cond
|
|
||||||
[(check-name? info)
|
|
||||||
(display-check-info info)]
|
|
||||||
[(check-location? info)
|
|
||||||
(display-check-info-name-value
|
|
||||||
'location
|
|
||||||
(trim-current-directory
|
|
||||||
(location->string
|
|
||||||
(check-info-value info)))
|
|
||||||
display)]
|
|
||||||
[(check-params? info)
|
|
||||||
(display-check-info-name-value
|
|
||||||
'params
|
|
||||||
(check-info-value info)
|
|
||||||
(lambda (v) (map pretty-print v)))]
|
|
||||||
[(check-actual? info)
|
|
||||||
(display-check-info-name-value
|
|
||||||
'actual
|
|
||||||
(check-info-value info)
|
|
||||||
pretty-print)]
|
|
||||||
[(check-expected? info)
|
|
||||||
(display-check-info-name-value
|
|
||||||
'expected
|
|
||||||
(check-info-value info)
|
|
||||||
pretty-print)]
|
|
||||||
[(and (check-expression? info)
|
|
||||||
(not verbose?))
|
|
||||||
(void)]
|
|
||||||
[else
|
|
||||||
(display-check-info info)]))
|
|
||||||
(if verbose?
|
|
||||||
stack
|
|
||||||
(strip-redundant-params stack))))
|
|
||||||
|
|
||||||
;; display-verbose-check-info : test-result -> void
|
|
||||||
(define (display-verbose-check-info result)
|
|
||||||
(cond
|
|
||||||
((test-failure? result)
|
|
||||||
(let* ((exn (test-failure-result result))
|
|
||||||
(stack (exn:test:check-stack exn)))
|
|
||||||
(for-each
|
|
||||||
(lambda (info)
|
|
||||||
(cond
|
|
||||||
((check-location? info)
|
|
||||||
(display "location: ")
|
|
||||||
(display (trim-current-directory
|
|
||||||
(location->string
|
|
||||||
(check-info-value info)))))
|
|
||||||
(else
|
|
||||||
(display (check-info-name info))
|
|
||||||
(display ": ")
|
|
||||||
(write (check-info-value info))))
|
|
||||||
(newline))
|
|
||||||
stack)))
|
|
||||||
((test-error? result)
|
|
||||||
(display-exn (test-error-result result)))
|
|
||||||
(else
|
|
||||||
(void))))
|
|
||||||
|
|
||||||
(define (std-test/text-ui display-context test)
|
|
||||||
(parameterize ([current-output-port (current-error-port)])
|
|
||||||
(fold-test-results
|
|
||||||
(lambda (result seed)
|
|
||||||
((sequence* (update-counter! result)
|
|
||||||
(display-test-preamble result)
|
|
||||||
(display-test-case-name result)
|
|
||||||
(lambda (hash)
|
|
||||||
(display-result result)
|
|
||||||
(display-context result)
|
|
||||||
hash)
|
|
||||||
(display-test-postamble result))
|
|
||||||
seed))
|
|
||||||
((sequence
|
|
||||||
(put-initial-counter)
|
|
||||||
(put-initial-name))
|
|
||||||
(make-empty-hash))
|
|
||||||
test
|
|
||||||
#:fdown (lambda (name seed) ((push-suite-name! name) seed))
|
|
||||||
#:fup (lambda (name kid-seed) ((pop-suite-name!) kid-seed)))))
|
|
||||||
|
|
||||||
(define (display-summary+return monad)
|
|
||||||
(monad-value
|
|
||||||
((compose
|
|
||||||
(sequence*
|
|
||||||
(display-counter*)
|
|
||||||
(counter->vector))
|
|
||||||
(match-lambda
|
|
||||||
((vector s f e)
|
|
||||||
(return-hash (+ f e)))))
|
|
||||||
monad)))
|
|
||||||
|
|
||||||
(define (display-counter*)
|
|
||||||
(compose (counter->vector)
|
|
||||||
(match-lambda
|
|
||||||
[(vector s f e)
|
|
||||||
(if (and (zero? f) (zero? e))
|
|
||||||
(display-counter)
|
|
||||||
(lambda args
|
|
||||||
(parameterize ([current-output-port (current-error-port)])
|
|
||||||
(apply (display-counter) args))))])))
|
|
||||||
|
|
||||||
;; run-tests : test [(U 'quiet 'normal 'verbose)] -> integer
|
|
||||||
(define (run-tests test [mode 'normal])
|
|
||||||
(monad-value
|
|
||||||
((compose
|
|
||||||
(sequence*
|
|
||||||
(case mode
|
|
||||||
[(normal verbose)
|
|
||||||
(display-counter*)]
|
|
||||||
[(quiet)
|
|
||||||
(lambda (a) a)])
|
|
||||||
(counter->vector))
|
|
||||||
(match-lambda
|
|
||||||
((vector s f e)
|
|
||||||
(return-hash (+ f e)))))
|
|
||||||
(case mode
|
|
||||||
((quiet)
|
|
||||||
(fold-test-results
|
|
||||||
(lambda (result seed)
|
|
||||||
((update-counter! result) seed))
|
|
||||||
((put-initial-counter)
|
|
||||||
(make-empty-hash))
|
|
||||||
test))
|
|
||||||
((normal) (std-test/text-ui display-context test))
|
|
||||||
((verbose) (std-test/text-ui
|
|
||||||
(cut display-context <> #t)
|
|
||||||
test))))))
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scheme
|
#lang scheme
|
||||||
(require schemeunit schemeunit/text-ui "1.ss" "1b.ss")
|
(require rktunit rktunit/text-ui "1.ss" "1b.ss")
|
||||||
|
|
||||||
(add (make-basic-customer 'mf "matthias" "brookstone"))
|
(add (make-basic-customer 'mf "matthias" "brookstone"))
|
||||||
(add (make-basic-customer 'rf "robby" "beverly hills park"))
|
(add (make-basic-customer 'rf "robby" "beverly hills park"))
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scheme
|
#lang scheme
|
||||||
(require schemeunit schemeunit/text-ui "2.ss")
|
(require rktunit rktunit/text-ui "2.ss")
|
||||||
|
|
||||||
(define s0 (initialize (flat-contract integer?) =))
|
(define s0 (initialize (flat-contract integer?) =))
|
||||||
(define s2 (push (push s0 2) 1))
|
(define s2 (push (push s0 2) 1))
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scheme
|
#lang scheme
|
||||||
(require schemeunit schemeunit/text-ui "3.ss")
|
(require rktunit rktunit/text-ui "3.ss")
|
||||||
|
|
||||||
(define d0 (initialize (flat-contract integer?) =))
|
(define d0 (initialize (flat-contract integer?) =))
|
||||||
(define d (put (put (put d0 'a 2) 'b 2) 'c 1))
|
(define d (put (put (put d0 'a 2) 'b 2) 'c 1))
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scheme
|
#lang scheme
|
||||||
(require schemeunit schemeunit/text-ui "5.ss")
|
(require rktunit rktunit/text-ui "5.ss")
|
||||||
|
|
||||||
(define s (put (put (initialize (flat-contract integer?) =) 2) 1))
|
(define s (put (put (initialize (flat-contract integer?) =) 2) 1))
|
||||||
|
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
|
|
||||||
(provide all-contract-tests)
|
(provide all-contract-tests)
|
||||||
|
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
deinprogramm/define-record-procedures
|
deinprogramm/define-record-procedures
|
||||||
deinprogramm/contract/contract
|
deinprogramm/contract/contract
|
||||||
deinprogramm/contract/contract-syntax)
|
deinprogramm/contract/contract-syntax)
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
|
|
||||||
(provide all-image-tests)
|
(provide all-image-tests)
|
||||||
|
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
deinprogramm/image
|
deinprogramm/image
|
||||||
(only-in lang/private/imageeq image=?)
|
(only-in lang/private/imageeq image=?)
|
||||||
mred
|
mred
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
|
|
||||||
(require schemeunit/text-ui)
|
(require rktunit/text-ui)
|
||||||
(require tests/deinprogramm/contract)
|
(require tests/deinprogramm/contract)
|
||||||
|
|
||||||
(run-tests all-contract-tests)
|
(run-tests all-contract-tests)
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
|
|
||||||
(require schemeunit/text-ui)
|
(require rktunit/text-ui)
|
||||||
(require tests/deinprogramm/image)
|
(require tests/deinprogramm/image)
|
||||||
|
|
||||||
(run-tests all-image-tests)
|
(run-tests all-image-tests)
|
||||||
|
|
|
@ -216,7 +216,7 @@
|
||||||
=> '(#"1 test passed\n" #"2 tests passed\n")
|
=> '(#"1 test passed\n" #"2 tests passed\n")
|
||||||
)
|
)
|
||||||
|
|
||||||
;; SchemeUnit stuff
|
;; RktUnit stuff
|
||||||
;; (examples that should fail modified to ones that shouldn't)
|
;; (examples that should fail modified to ones that shouldn't)
|
||||||
#|
|
#|
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
|
|
||||||
(require scheme/future
|
(require scheme/future
|
||||||
schemeunit)
|
rktunit)
|
||||||
|
|
||||||
#|Need to add expressions which raise exceptions inside a
|
#|Need to add expressions which raise exceptions inside a
|
||||||
future thunk which can be caught at the touch site
|
future thunk which can be caught at the touch site
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
#lang racket
|
#lang racket
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
schemeunit/text-ui
|
rktunit/text-ui
|
||||||
net/url
|
net/url
|
||||||
(prefix-in h: html)
|
(prefix-in h: html)
|
||||||
(prefix-in x: xml))
|
(prefix-in x: xml))
|
||||||
|
|
|
@ -21,7 +21,7 @@
|
||||||
"plot"
|
"plot"
|
||||||
"profj"
|
"profj"
|
||||||
"r6rs"
|
"r6rs"
|
||||||
"schemeunit"
|
"rktunit"
|
||||||
"srfi"
|
"srfi"
|
||||||
"srpersist"
|
"srpersist"
|
||||||
"stepper"
|
"stepper"
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
schemeunit/gui)
|
rktunit/gui)
|
||||||
(require macro-debugger/model/debug
|
(require macro-debugger/model/debug
|
||||||
"gentest-framework.ss"
|
"gentest-framework.ss"
|
||||||
"gentests.ss"
|
"gentests.ss"
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(require schemeunit)
|
(require rktunit)
|
||||||
(require macro-debugger/model/debug
|
(require macro-debugger/model/debug
|
||||||
macro-debugger/model/stx-util
|
macro-debugger/model/stx-util
|
||||||
"gentest-framework.ss"
|
"gentest-framework.ss"
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
schemeunit/gui)
|
rktunit/gui)
|
||||||
(require macro-debugger/model/debug
|
(require macro-debugger/model/debug
|
||||||
scheme/path
|
scheme/path
|
||||||
scheme/gui)
|
scheme/gui)
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(require schemeunit)
|
(require rktunit)
|
||||||
(require macro-debugger/model/debug
|
(require macro-debugger/model/debug
|
||||||
"../test-setup.ss")
|
"../test-setup.ss")
|
||||||
(provide specialized-hiding-tests)
|
(provide specialized-hiding-tests)
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(require schemeunit)
|
(require rktunit)
|
||||||
(require macro-debugger/model/debug
|
(require macro-debugger/model/debug
|
||||||
"../test-setup.ss")
|
"../test-setup.ss")
|
||||||
(provide policy-tests)
|
(provide policy-tests)
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
(require schemeunit)
|
(require rktunit)
|
||||||
(require macro-debugger/model/debug
|
(require macro-debugger/model/debug
|
||||||
macro-debugger/model/steps
|
macro-debugger/model/steps
|
||||||
"../test-setup.ss")
|
"../test-setup.ss")
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
(for-syntax scheme/base)
|
(for-syntax scheme/base)
|
||||||
(prefix-in m: mzlib/match)
|
(prefix-in m: mzlib/match)
|
||||||
(only-in srfi/13 string-contains)
|
(only-in srfi/13 string-contains)
|
||||||
schemeunit)
|
rktunit)
|
||||||
|
|
||||||
(define-syntax (comp stx)
|
(define-syntax (comp stx)
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
(module match-tests mzscheme
|
(module match-tests mzscheme
|
||||||
(require mzlib/match schemeunit)
|
(require mzlib/match rktunit)
|
||||||
|
|
||||||
(provide match-tests)
|
(provide match-tests)
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
(module other-plt-tests mzscheme
|
(module other-plt-tests mzscheme
|
||||||
|
|
||||||
(require schemeunit net/uri-codec mzlib/pregexp mzlib/plt-match
|
(require rktunit net/uri-codec mzlib/pregexp mzlib/plt-match
|
||||||
mzlib/list mzlib/etc)
|
mzlib/list mzlib/etc)
|
||||||
|
|
||||||
(define-struct shape (color))
|
(define-struct shape (color))
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
(module other-tests mzscheme
|
(module other-tests mzscheme
|
||||||
(require mzlib/match schemeunit)
|
(require mzlib/match rktunit)
|
||||||
|
|
||||||
(provide other-tests)
|
(provide other-tests)
|
||||||
|
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
|
|
||||||
(require (for-syntax scheme/base)
|
(require (for-syntax scheme/base)
|
||||||
"match-tests.ss" "other-plt-tests.ss" "other-tests.ss" "examples.ss"
|
"match-tests.ss" "other-plt-tests.ss" "other-tests.ss" "examples.ss"
|
||||||
schemeunit schemeunit/text-ui)
|
rktunit rktunit/text-ui)
|
||||||
|
|
||||||
(require mzlib/plt-match)
|
(require mzlib/plt-match)
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scheme
|
#lang scheme
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
plai/random-mutator
|
plai/random-mutator
|
||||||
scheme/runtime-path
|
scheme/runtime-path
|
||||||
;; test find-heap-values and save-random-mutator via the contract'd
|
;; test find-heap-values and save-random-mutator via the contract'd
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
(module contract-opt-tests mzscheme
|
(module contract-opt-tests mzscheme
|
||||||
(require mzlib/contract
|
(require mzlib/contract
|
||||||
schemeunit
|
rktunit
|
||||||
schemeunit/text-ui)
|
rktunit/text-ui)
|
||||||
|
|
||||||
(define (exn:fail:contract-violation? exn)
|
(define (exn:fail:contract-violation? exn)
|
||||||
(if (regexp-match #rx"broke" (exn-message exn)) #t #f))
|
(if (regexp-match #rx"broke" (exn-message exn)) #t #f))
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
#lang racket
|
#lang racket
|
||||||
|
|
||||||
(require raclog
|
(require raclog
|
||||||
schemeunit)
|
rktunit)
|
||||||
|
|
||||||
;The following is the "Biblical" database from "The Art of
|
;The following is the "Biblical" database from "The Art of
|
||||||
;Prolog", Sterling & Shapiro, ch. 1.
|
;Prolog", Sterling & Shapiro, ch. 1.
|
||||||
|
@ -142,4 +142,4 @@
|
||||||
dad-kids)))))
|
dad-kids)))))
|
||||||
|
|
||||||
(check-equal? (dad-kids-test-5)
|
(check-equal? (dad-kids-test-5)
|
||||||
`((dad-kids . ((terach (abraham nachor haran)) (abraham (isaac)) (haran (lot milcah yiscah))))))
|
`((dad-kids . ((terach (abraham nachor haran)) (abraham (isaac)) (haran (lot milcah yiscah))))))
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
#lang racket
|
#lang racket
|
||||||
|
|
||||||
(require raclog
|
(require raclog
|
||||||
schemeunit)
|
rktunit)
|
||||||
|
|
||||||
;The following is a simple database about a certain family in England.
|
;The following is a simple database about a certain family in England.
|
||||||
;Should be a piece of cake, but given here so that you can hone
|
;Should be a piece of cake, but given here so that you can hone
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
|
|
||||||
(require raclog
|
(require raclog
|
||||||
"./puzzle.rkt"
|
"./puzzle.rkt"
|
||||||
schemeunit)
|
rktunit)
|
||||||
|
|
||||||
;;This example is from Sterling & Shapiro, p. 214.
|
;;This example is from Sterling & Shapiro, p. 214.
|
||||||
;;
|
;;
|
||||||
|
|
|
@ -1,28 +1,28 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
"check-test.ss"
|
"check-test.rkt"
|
||||||
"check-info-test.ss"
|
"check-info-test.rkt"
|
||||||
"format-test.ss"
|
"format-test.rkt"
|
||||||
"test-case-test.ss"
|
"test-case-test.rkt"
|
||||||
"test-suite-test.ss"
|
"test-suite-test.rkt"
|
||||||
"base-test.ss"
|
"base-test.rkt"
|
||||||
"location-test.ss"
|
"location-test.rkt"
|
||||||
"result-test.ss"
|
"result-test.rkt"
|
||||||
"test-test.ss"
|
"test-test.rkt"
|
||||||
"util-test.ss"
|
"util-test.rkt"
|
||||||
"text-ui-test.ss"
|
"text-ui-test.rkt"
|
||||||
"monad-test.ss"
|
"monad-test.rkt"
|
||||||
"hash-monad-test.ss"
|
"hash-monad-test.rkt"
|
||||||
"counter-test.ss"
|
"counter-test.rkt"
|
||||||
"text-ui-util-test.ss")
|
"text-ui-util-test.rkt")
|
||||||
|
|
||||||
(provide all-schemeunit-tests
|
(provide all-rktunit-tests
|
||||||
failure-tests)
|
failure-tests)
|
||||||
|
|
||||||
(define all-schemeunit-tests
|
(define all-rktunit-tests
|
||||||
(test-suite
|
(test-suite
|
||||||
"All SchemeUnit Tests"
|
"All RktUnit Tests"
|
||||||
check-tests
|
check-tests
|
||||||
base-tests
|
base-tests
|
||||||
check-info-tests
|
check-info-tests
|
|
@ -26,10 +26,10 @@
|
||||||
;;
|
;;
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
|
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
schemeunit/private/base)
|
rktunit/private/base)
|
||||||
|
|
||||||
(provide base-tests)
|
(provide base-tests)
|
||||||
|
|
||||||
|
@ -37,45 +37,45 @@
|
||||||
(test-suite
|
(test-suite
|
||||||
"All tests for base"
|
"All tests for base"
|
||||||
(test-case
|
(test-case
|
||||||
"schemeunit-test-case structure has a contract on name"
|
"rktunit-test-case structure has a contract on name"
|
||||||
(check-exn exn:fail?
|
(check-exn exn:fail?
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(make-schemeunit-test-case
|
(make-rktunit-test-case
|
||||||
'foo
|
'foo
|
||||||
(lambda () #t)))))
|
(lambda () #t)))))
|
||||||
(test-case
|
(test-case
|
||||||
"schemeunit-test-case structure has a contract on action"
|
"rktunit-test-case structure has a contract on action"
|
||||||
(check-exn exn:fail?
|
(check-exn exn:fail?
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(make-schemeunit-test-case
|
(make-rktunit-test-case
|
||||||
"Name"
|
"Name"
|
||||||
#f))))
|
#f))))
|
||||||
(test-case
|
(test-case
|
||||||
"schemeunit-test-suite has a contract on its fields"
|
"rktunit-test-suite has a contract on its fields"
|
||||||
(check-exn exn:fail?
|
(check-exn exn:fail?
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(make-schemeunit-test-suite
|
(make-rktunit-test-suite
|
||||||
#f
|
#f
|
||||||
(list)
|
(list)
|
||||||
(lambda () 3)
|
(lambda () 3)
|
||||||
(lambda () 2))))
|
(lambda () 2))))
|
||||||
(check-exn exn:fail?
|
(check-exn exn:fail?
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(make-schemeunit-test-suite
|
(make-rktunit-test-suite
|
||||||
"Name"
|
"Name"
|
||||||
#f
|
#f
|
||||||
(lambda () 3)
|
(lambda () 3)
|
||||||
(lambda () 2))))
|
(lambda () 2))))
|
||||||
(check-exn exn:fail?
|
(check-exn exn:fail?
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(make-schemeunit-test-suite
|
(make-rktunit-test-suite
|
||||||
"Name"
|
"Name"
|
||||||
(list)
|
(list)
|
||||||
#f
|
#f
|
||||||
(lambda () 2))))
|
(lambda () 2))))
|
||||||
(check-exn exn:fail?
|
(check-exn exn:fail?
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(make-schemeunit-test-suite
|
(make-rktunit-test-suite
|
||||||
"Name"
|
"Name"
|
||||||
(list)
|
(list)
|
||||||
(lambda () 3)
|
(lambda () 3)
|
|
@ -1,23 +1,23 @@
|
||||||
;;;
|
;;;
|
||||||
;;; <check-util-test.ss> ---- Tests for check-util
|
;;; <check-util-test.rkt> ---- Tests for check-util
|
||||||
;;; Time-stamp: <2009-06-11 17:03:21 noel>
|
;;; Time-stamp: <2009-06-11 17:03:21 noel>
|
||||||
;;;
|
;;;
|
||||||
;;; Copyright (C) 2003 by Noel Welsh.
|
;;; Copyright (C) 2003 by Noel Welsh.
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of SchemeUnit.
|
;;; This file is part of RktUnit.
|
||||||
|
|
||||||
;;; SchemeUnit is free software; you can redistribute it and/or
|
;;; RktUnit is free software; you can redistribute it and/or
|
||||||
;;; modify it under the terms of the GNU Lesser General Public
|
;;; modify it under the terms of the GNU Lesser General Public
|
||||||
;;; License as published by the Free Software Foundation; either
|
;;; License as published by the Free Software Foundation; either
|
||||||
;;; version 2.1 of the License, or (at your option) any later version.
|
;;; version 2.1 of the License, or (at your option) any later version.
|
||||||
|
|
||||||
;;; SchemeUnitis distributed in the hope that it will be useful,
|
;;; RktUnitis distributed in the hope that it will be useful,
|
||||||
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
;;; Lesser General Public License for more details.
|
;;; Lesser General Public License for more details.
|
||||||
|
|
||||||
;;; You should have received a copy of the GNU Lesser General Public
|
;;; You should have received a copy of the GNU Lesser General Public
|
||||||
;;; License along with SchemeUnit; if not, write to the Free Software
|
;;; License along with RktUnit; if not, write to the Free Software
|
||||||
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||||
|
|
||||||
;;; Author: Noel Welsh <noelwelsh@yahoo.com>
|
;;; Author: Noel Welsh <noelwelsh@yahoo.com>
|
||||||
|
@ -25,10 +25,10 @@
|
||||||
;;
|
;;
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
|
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
schemeunit/private/check-info)
|
rktunit/private/check-info)
|
||||||
|
|
||||||
(provide check-info-tests)
|
(provide check-info-tests)
|
||||||
|
|
|
@ -26,14 +26,14 @@
|
||||||
;;
|
;;
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
|
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require scheme/runtime-path
|
(require racket/runtime-path
|
||||||
srfi/1
|
srfi/1
|
||||||
schemeunit
|
rktunit
|
||||||
schemeunit/private/check
|
rktunit/private/check
|
||||||
schemeunit/private/result
|
rktunit/private/result
|
||||||
schemeunit/private/test-suite)
|
rktunit/private/test-suite)
|
||||||
|
|
||||||
(provide check-tests)
|
(provide check-tests)
|
||||||
|
|
||||||
|
@ -287,8 +287,8 @@
|
||||||
(let ((destns (make-base-namespace))
|
(let ((destns (make-base-namespace))
|
||||||
(cns (current-namespace)))
|
(cns (current-namespace)))
|
||||||
(parameterize ((current-namespace destns))
|
(parameterize ((current-namespace destns))
|
||||||
(namespace-require '(for-syntax scheme/base))
|
(namespace-require '(for-syntax racket/base))
|
||||||
(namespace-require 'schemeunit/private/check)
|
(namespace-require 'rktunit/private/check)
|
||||||
;; First check that the right check macro got
|
;; First check that the right check macro got
|
||||||
;; used: ie that it didn't just compile the thing
|
;; used: ie that it didn't just compile the thing
|
||||||
;; as an application.
|
;; as an application.
|
|
@ -25,13 +25,13 @@
|
||||||
;;
|
;;
|
||||||
;;
|
;;
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require scheme/match
|
(require racket/match
|
||||||
schemeunit
|
rktunit
|
||||||
schemeunit/private/counter
|
rktunit/private/counter
|
||||||
schemeunit/private/monad
|
rktunit/private/monad
|
||||||
schemeunit/private/hash-monad)
|
rktunit/private/hash-monad)
|
||||||
|
|
||||||
(provide counter-tests)
|
(provide counter-tests)
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
schemeunit/private/check-info
|
rktunit/private/check-info
|
||||||
schemeunit/private/format)
|
rktunit/private/format)
|
||||||
|
|
||||||
(provide format-tests)
|
(provide format-tests)
|
||||||
|
|
|
@ -26,11 +26,11 @@
|
||||||
;;
|
;;
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
|
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
schemeunit/private/monad
|
rktunit/private/monad
|
||||||
schemeunit/private/hash-monad)
|
rktunit/private/hash-monad)
|
||||||
|
|
||||||
(provide hash-monad-tests)
|
(provide hash-monad-tests)
|
||||||
|
|
|
@ -25,10 +25,10 @@
|
||||||
;;
|
;;
|
||||||
;;
|
;;
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
schemeunit/private/location)
|
rktunit/private/location)
|
||||||
|
|
||||||
(provide location-tests)
|
(provide location-tests)
|
||||||
|
|
||||||
|
@ -43,10 +43,10 @@
|
||||||
(test-case
|
(test-case
|
||||||
"syntax->location ok"
|
"syntax->location ok"
|
||||||
(around
|
(around
|
||||||
(with-output-to-file "test-file.ss"
|
(with-output-to-file "test-file.rkt"
|
||||||
(lambda () (display "#lang scheme\n'foo\n")))
|
(lambda () (display "#lang racket\n'foo\n")))
|
||||||
(let* ([stx (read-syntax/lang (string->path "test-file.ss")
|
(let* ([stx (read-syntax/lang (string->path "test-file.rkt")
|
||||||
(open-input-file "test-file.ss"))]
|
(open-input-file "test-file.rkt"))]
|
||||||
[rep (syntax->location stx)])
|
[rep (syntax->location stx)])
|
||||||
(check-equal? (location-source rep)
|
(check-equal? (location-source rep)
|
||||||
(syntax-source stx))
|
(syntax-source stx))
|
||||||
|
@ -54,7 +54,7 @@
|
||||||
(syntax-position stx))
|
(syntax-position stx))
|
||||||
(check-equal? (location-span rep)
|
(check-equal? (location-span rep)
|
||||||
(syntax-span stx)))
|
(syntax-span stx)))
|
||||||
(delete-file "test-file.ss")))
|
(delete-file "test-file.rkt")))
|
||||||
|
|
||||||
(test-case
|
(test-case
|
||||||
"Emacs compatible location strings"
|
"Emacs compatible location strings"
|
||||||
|
@ -63,15 +63,15 @@
|
||||||
(syntax->location
|
(syntax->location
|
||||||
(datum->syntax
|
(datum->syntax
|
||||||
#f #f
|
#f #f
|
||||||
(list "file.ss" 42 38 1240 2))))
|
(list "file.rkt" 42 38 1240 2))))
|
||||||
"file.ss:42:38")
|
"file.rkt:42:38")
|
||||||
(check string=?
|
(check string=?
|
||||||
(location->string
|
(location->string
|
||||||
(syntax->location
|
(syntax->location
|
||||||
(datum->syntax
|
(datum->syntax
|
||||||
#f #f
|
#f #f
|
||||||
(list (string->path "file.ss") 42 38 1240 2))))
|
(list (string->path "file.rkt") 42 38 1240 2))))
|
||||||
"file.ss:42:38")
|
"file.rkt:42:38")
|
||||||
(check string=?
|
(check string=?
|
||||||
(location->string
|
(location->string
|
||||||
(syntax->location
|
(syntax->location
|
||||||
|
@ -84,14 +84,14 @@
|
||||||
(syntax->location
|
(syntax->location
|
||||||
(datum->syntax
|
(datum->syntax
|
||||||
#f #f
|
#f #f
|
||||||
(list 'foo.ss 42 38 1240 2))))
|
(list 'foo.rkt 42 38 1240 2))))
|
||||||
"foo.ss:42:38")
|
"foo.rkt:42:38")
|
||||||
(check string=?
|
(check string=?
|
||||||
(location->string
|
(location->string
|
||||||
(syntax->location
|
(syntax->location
|
||||||
(datum->syntax
|
(datum->syntax
|
||||||
#f #f
|
#f #f
|
||||||
(list "foo.ss" #f #f #f #f))))
|
(list "foo.rkt" #f #f #f #f))))
|
||||||
"foo.ss:?:?"))
|
"foo.rkt:?:?"))
|
||||||
))
|
))
|
||||||
|
|
|
@ -27,10 +27,10 @@
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
|
|
||||||
|
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
schemeunit/private/monad)
|
rktunit/private/monad)
|
||||||
|
|
||||||
(provide monad-tests)
|
(provide monad-tests)
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
schemeunit/private/result)
|
rktunit/private/result)
|
||||||
|
|
||||||
(provide result-tests)
|
(provide result-tests)
|
||||||
|
|
|
@ -1,10 +1,10 @@
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require schemeunit
|
(require rktunit
|
||||||
schemeunit/text-ui
|
rktunit/text-ui
|
||||||
"all-schemeunit-tests.ss")
|
"all-rktunit-tests.rkt")
|
||||||
|
|
||||||
(run-tests all-schemeunit-tests)
|
(run-tests all-rktunit-tests)
|
||||||
|
|
||||||
;; These tests should all error, so we switch the meaning of correct and incorrect. If the error display changes significantly, DrDr will catch it
|
;; These tests should all error, so we switch the meaning of correct and incorrect. If the error display changes significantly, DrDr will catch it
|
||||||
(parameterize ([current-error-port (current-output-port)]
|
(parameterize ([current-error-port (current-output-port)]
|
|
@ -29,9 +29,9 @@
|
||||||
;; part of the standard test suite and must be run
|
;; part of the standard test suite and must be run
|
||||||
;; separately.
|
;; separately.
|
||||||
|
|
||||||
#lang scheme/base
|
#lang racket/base
|
||||||
|
|
||||||
(require schemeunit/private/check)
|
(require rktunit/private/check)
|
||||||
|
|
||||||
;; This check should succeed
|
;; This check should succeed
|
||||||
(check = 1 1 0.0)
|
(check = 1 1 0.0)
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user