Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- REBOL [
- Title: "Simple testing framework"
- Author: "Peter W A Wood"
- File: %quick-test.reb
- Version: 0.1.1
- Rights: "Copyright (C) 2011-2016 Peter W A Wood. All rights reserved."
- License: "BSD-3"
- ]
- qt: make object! [
- ;; switches
- batch: false
- logging: false
- quiet: false
- ;; set up alternate print functions
- sys-print: :print
- sys-prin: :prin
- ;; set-up alternative now
- sys-now: :now
- test-prin: func [v] [
- unless batch [sys-prin v]
- if logging [write-log v]
- ]
- output: copy ""
- set 'print func [v][append output rejoin [v "^/"]]
- set 'prin func [v][append output reduce v]
- ;; set up log
- sys-write: :write
- log-file: join system/options/home %qt.log
- write-log: func[v][
- sys-write/append log-file v
- ]
- ;; text fields
- run-name: copy ""
- file-name: copy ""
- group-name: copy ""
- test-name: copy ""
- ;; counters
- data: make object! [
- tests: 0
- passes: 0
- failures: 0
- ]
- run: make data []
- file: make data []
- asserts: make data []
- ;; group switches
- group-name-not-prined: true
- group?: false
- ;; helper functions
- end-test: does [
- either equal? asserts/failures 0 [
- file/passes: file/passes + 1
- ][
- file/failures: file/failures + 1
- ]
- ]
- init-group: does [
- group-name-not-prined: true
- group?: false
- group-name: ""
- ]
- init-data: func [
- data [object!]
- ][
- data/tests: 0
- data/passes: 0
- data/failures: 0
- ]
- init-run: does [
- init-data run
- init-group
- if logging [sys-write log-file ""]
- ]
- init-file: does [
- init-data file
- init-group
- ]
- print-totals: func [
- data [object!]
- ][
- test-prin compose [" Number of Tests Performed: " (data/tests) "^/"]
- test-prin compose [" Number of Tests Passed: " (data/passes) "^/"]
- test-prin compose [" Number of Tests Failed: " (data/failures) "^/"]
- if data/failures <> 0 [
- test-prin ["****************TEST FAILURES****************" "^/"]
- ]
- ]
- ;; testing dialect functions
- start-file: func [
- title [string!]
- ][
- init-file
- test-prin compose ["~~~Started Test~~~ " (title) "^/"]
- file-name: title
- group?: false
- init-data asserts
- ]
- start-group: func [
- title [string!]
- ][
- group-name: title
- group?: true
- ]
- start-test: func [
- title [string!]
- ][
- unless equal? file/tests 0 [end-test]
- test-name: title
- file/tests: file/tests + 1
- output: copy ""
- init-data asserts
- ]
- assert: func [
- assertion [logic!]
- ][
- asserts/tests: asserts/tests + 1
- either assertion [
- asserts/passes: asserts/passes + 1
- ][
- asserts/failures: asserts/failures + 1
- if group? [
- if group-name-not-prined [
- test-prin compose ["^/" "===group=== " (group-name) "^/"]
- group-name-not-prined: false
- ]
- ]
- test-prin compose["--test-- " (test-name) " assertion " (asserts/tests)
- " FAILED**************" "^/"]
- ]
- ]
- assert-printed?: func [msg] [
- assert found? find output msg
- ]
- assert~=: func[
- x [number!]
- y [number!]
- e [number!]
- /local
- diff e1 e2
- ][
- ;; calculate tolerance to use
- ;; as e * max (1, x, y)
- either x > 0.0 [
- e1: x * e
- ][
- e1: -1.0 * x * e
- ]
- if e > e1 [e1: e]
- either y > 0.0 [
- e2: y * e
- ][
- e2: -1.0 * y * e
- ]
- if e1 > e2 [e2: e1]
- ;; perform almost equal check
- either x > y [
- diff: x - y
- ][
- diff: y - x
- ]
- either diff > e2 [
- assert false
- ][
- assert true
- ]
- ]
- end-group: func [] [
- init-group
- ]
- end-file: func [] [
- if 0 <> (asserts/passes + asserts/failures) [end-test] ; end last test
- test-prin compose ["~~~Finished Test~~~ " (file-name) "^/"]
- print-totals file
- test-prin "^/"
- ;; update run totals
- run/passes: run/passes + file/passes
- run/failures: run/failures + file/failures
- run/tests: run/tests + file/tests
- ]
- ;; test runner dialect functions
- set-log-file: func [log-file [file!]] [
- qt/log-file: log-file
- ]
- start-run: func [
- title [string!]
- ][
- init-run
- run-name: title
- test-prin compose ["***Started*** " (title) " at " (qt/sys-now/precise) "^/" "^/"]
- ]
- start-run-batch: func [
- title [string!]
- ][
- batch: true
- logging: true
- start-run title
- ]
- run-test: func[ file [file!]][
- do file
- ]
- end-run: func [][
- test-prin compose ["***Finished*** " (run-name) " at " (qt/sys-now/precise) "^/"]
- print-totals run
- set 'print :sys-print
- set 'prin :sys-prin
- set 'now :sys-now
- if logging [logging: false]
- if batch [
- batch: false
- quit/return min run/failures 1
- ]
- ]
- ;; create the testing "dialect"
- set '~~~start-file~~~ :start-file
- set '===start-group=== :start-group
- set '--test-- :start-test
- set '--assert :assert
- set '--assert-printed? :assert-printed?
- set '--assert~= :assert~=
- set '===end-group=== :end-group
- set '~~~end-file~~~ :end-file
- ;; create the test runner "dialect"
- set '--set-log-file :set-log-file
- set '***start-run*** :start-run
- set '***start-run-batch*** :start-run-batch
- set '--run-test :run-test
- set '***end-run*** :end-run
- ]
Add Comment
Please, Sign In to add comment