Skip to content

Instantly share code, notes, and snippets.

@PeterWAWood
Created June 22, 2018 05:17
Show Gist options
  • Save PeterWAWood/befd37f67d844bb817d63a78df893c78 to your computer and use it in GitHub Desktop.
Save PeterWAWood/befd37f67d844bb817d63a78df893c78 to your computer and use it in GitHub Desktop.
Quick Test for Rebol
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
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment