REBOL [ Title: "Simple Test Suite" file: %test-simple.r date: 15-June-2006 author: "Brian Wisti" home: none email: "%brianwisti--yahoo--com" Version: 0.3.0 purpose: { Add support for simple test mechanisms to REBOL, similar to Perl's Test::Simple. The basic idea? Make testing simple so everybody can make tests. } Library: [ level: 'beginner platform: 'all type: [module tool] domain: [debug testing] tested-under: [Linux Windows] support: [ { This release should be considered 'beta' quality. I need suggestions for ways to improve it while maintaining the simplicity of the interface. } ] license: 'mit see-also: none ] changes: [ [ 7-mar-2005 0.1.0 "Initial Posting on rebol.org" ] [ 8-mar-2005 0.1.1 "Default behavior is now to print test results to stdout" ] [ 18-aug-2005 0.2.0 "Added a match function for the common test of comparing two values" ] [ 15-June-2006 0.3.0 "Added preliminary support for test suites - grouped tests" ] ] ] test: make object! [ use-stdout: false name: "Test" test-count: 0 pass-count: 0 success-string: "OK" failure-string: "Not OK" wrapup-message: copy "" test-log: make list! [] ok: func [ "Test if a condition is true" test-condition [block!] "The condition to be tested" /log "If you want to log a message on success" message [string!] "optional string to display on success" /local test-result results ] [ results: make list! [] test-count: test-count + 1 test-result: do test-condition if test-result == true [ pass-count: pass-count + 1 ] results: append results test-result if log [ results: append results message ] test-log: append/only test-log results if use-stdout [ print results ] return test-result ] match: func [ "Shorthand test for comparing 2 values" values /log message /local description match-test last-test ] [ values: reduce values match-test: [ values/1 = values/2 ] result: either log [ ok/log match-test message ] [ ok/log match-test "" ] last-test: last test-log last-test: append/only last-test values return result ] wrapup: func [ "Returns a summary of test results" ] [ if wrapup-message = "" [ wrapup-message: join name [ ": " pass-count "/" test-count " passed" ] ] if use-stdout [ print wrapup-message ] return wrapup-message ] summary: func [ "Returns the output logged from assertions run" /full "Display usually ignored output for passed tests" /local output output-text entry entry-text ] [ output: make list! [] output-text: copy "" forall test-log [ entry-text: copy "" entry: first test-log if any [full entry/1 == false] [ entry-text: rejoin [ index? test-log " " either entry/1 = true [ success-string ] [ failure-string ] either (length? entry) >= 2 [ rejoin [ " " entry/2 ] ] [ "" ] either (length? entry) >= 3 [ rejoin [ "^/Expected: <" (mold entry/3/1) ">^/" "Got: <" (replace/all (mold entry/3/2) "^/" "^^/") ">" ] ] [ "" ] ] ] if entry-text <> "" [ output: append/only output entry-text ] ] forall output [ output-text: append output-text output/1 output-text: append output-text "^/" ] return output-text ] ] test-suite: make object! [ tests: make list! [] tests-ran: make list! [] add-test: func [ "Adds a new test to the suite" test-case "The test object to be added" ] [ tests: append/only tests test-case return length? tests ] run-tests: func [ "Invoke the tests added to this suite" ] [ tests-ran: make list! [] foreach my-test tests [ tests-ran: append/only tests-ran make test my-test ] return length? tests-ran ] wrapup: func [ "Get wrapup information about tests run" /local message wrapups ] [ wrapups: make list! [] message: copy "" foreach my-test tests-ran [ wrapups: append wrapups my-test/wrapup ] forall wrapups [ message: join message [ wrapups/1 "^/" ] ] return message ] summary: func [ "Get summary information about tests run" /full "Display usually ignored output for passed tests" /local message test-message ] [ message: copy "" foreach my-test tests-ran [ either full [ message: join message [ my-test/name ": " my-test/summary/full ] ] [ message: my-test/summary if message <> "" [ message: rejoin [ my-test/name ": " message ] ] ] ] return message ] summarize: func [ "Get combined summary and wrapup information for tests run" /full "Get full summaries for each test run" /local message output ] [ message: copy "" output: copy "" foreach my-test tests-ran [ message: join my-test/wrapup [ "^/" either full [ my-test/summary/full ] [ my-test/summary ] ] output: rejoin [ output message ] ] return output ] ] comment { The MIT License Copyright (c) 2005 Brian Wisti Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. }