From 8879c156fb8631fa98a70315c147fbdfeee4b189 Mon Sep 17 00:00:00 2001 From: Mario Fetka Date: Fri, 15 Sep 2017 16:12:49 +0200 Subject: [PATCH] Imported Upstream version 1.21 --- ChangeLog | 389 +++++++++++++ MANIFEST | 17 + Makefile.PL | 66 +++ README | 237 ++++++++ lib/Test/SimpleUnit.pm | 1215 ++++++++++++++++++++++++++++++++++++++++ t/00_require.t | 34 ++ t/01_importAll.t | 36 ++ t/02_importAsserts.t | 36 ++ t/03_importTfuncs.t | 36 ++ t/04_importSkips.t | 36 ++ t/05_importTestData.t | 36 ++ t/10_asserts.t | 482 ++++++++++++++++ t/11_skips.t | 97 ++++ t/12_testdata.t | 87 +++ t/15_setupteardown.t | 230 ++++++++ t/20_emptysuite.t | 40 ++ t/30_bugs.t | 60 ++ 17 files changed, 3134 insertions(+) create mode 100644 ChangeLog create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 lib/Test/SimpleUnit.pm create mode 100644 t/00_require.t create mode 100644 t/01_importAll.t create mode 100644 t/02_importAsserts.t create mode 100644 t/03_importTfuncs.t create mode 100644 t/04_importSkips.t create mode 100644 t/05_importTestData.t create mode 100644 t/10_asserts.t create mode 100644 t/11_skips.t create mode 100644 t/12_testdata.t create mode 100644 t/15_setupteardown.t create mode 100644 t/20_emptysuite.t create mode 100644 t/30_bugs.t diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..1f6fe98 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,389 @@ +2003-01-15 13:48 Michael Granger + + * t/15_setupteardown.t (1.4): + + - Added/refined tests to match refined setup/teardown behaviour. + +2003-01-15 13:47 Michael Granger + + * Makefile.PL (1.5): + + - Converted to use ExtUtils::AutoInstall. + +2003-01-15 13:46 Michael Granger + + * t/: 05_importTestData.t (1.1), 12_testdata.t (1.1): + + Initial commit. + +2003-01-15 12:58 Michael Granger + + * lib/Test/SimpleUnit.pm (1.21): + + - Removed leftover conflict section. + +2003-01-15 12:48 Michael Granger + + * lib/Test/SimpleUnit.pm (1.20): + + - Added 'AutoskipFailedTeardown' global and accessors. + + - Added loadTestData() and saveTestData() functions and ':testdata' export flag + + - Modified comparison assertions to use Data::Compare. + + - Added functions/data to allow modification of output handle. + + - Generalized assertion-bookkeeping into functions. + + - Handled undefined values more cleanly in assertion messages. + + - Added ability to stack setup/teardown functions for one-time setup or + teardowns. + +2002-06-24 16:28 Michael Granger + + * t/: 05_asserts.t (1.5), 06_skips.t (1.4), 07_setupteardown.t + (1.4), 08_emptysuite.t (1.2), 09_bugs.t (1.2): + + 'Updated' + +2002-05-14 17:39 Michael Granger + + * lib/Test/SimpleUnit.pm (1.19): + + - Cleaned up handling of undef values in default error messages for + assertKindOf() and assertInstanceOf(). + +2002-05-13 21:02 Michael Granger + + * Makefile.PL (1.4, RELEASE_1_18): + + - Added some dependencies to the require list. + +2002-05-13 21:01 Michael Granger + + * lib/Test/SimpleUnit.pm (1.18, RELEASE_1_18): + + - Added functions/package variables to support switching the test output IO + handle to something different for the purposes of self-testing. + + - Modified assertion counter code to support recursive calls to runTests(). + +2002-05-13 20:59 Michael Granger + + * t/: 09_bugs.t (1.1), 30_bugs.t (1.1) (utags: RELEASE_1_18): + + - Initial commit. + +2002-04-25 14:53 Michael Granger + + * t/: 07_setupteardown.t (1.3), 15_setupteardown.t (1.3) (utags: + RELEASE_1_18, RELEASE_1_17): + + - Modified to test the setup/teardown superseding rules. + +2002-04-25 14:52 Michael Granger + + * README (1.4, RELEASE_1_18, RELEASE_1_17): + + - Cleaned up to reflect the changes made to the module. + + - Clarified meaning of parts, added better example, etc. + + - Removed references to XUnit, as this isn't exactly an XUnit-type framework. + +2002-04-25 14:50 Michael Granger + + * lib/Test/SimpleUnit.pm (1.17, RELEASE_1_17): + + - Cleaned up and corrected documentation. + + - Separated example code from synopsis + + - Added beginnings of debugging code + + - Modified setup/teardown to use superseding rule instead of additive rules. + +2002-04-23 16:04 Michael Granger + + * lib/Test/SimpleUnit.pm (1.16, RELEASE_1_16): + + - Split up somewhat into functions. + + - Fixed bug that surfaced when running an empty test suite, or a suite with only + 'setup' and 'teardown' tests. + + - Fixed error reporting: now failures are reported for TEST_VERBOSE=1 as well as + VERBOSE=1. + +2002-04-23 16:01 Michael Granger + + * t/: 08_emptysuite.t (1.1), 20_emptysuite.t (1.1) (utags: + RELEASE_1_18, RELEASE_1_17, RELEASE_1_16): + + Initial commit. + +2002-04-22 16:15 Michael Granger + + * lib/Test/SimpleUnit.pm (1.15, RELEASE_1_15): + + - Fixed some X<> POD constructs that should have been L<> ones. + +2002-04-22 16:14 Michael Granger + + * README (1.3, RELEASE_1_16, RELEASE_1_15): + + - Added longer description. + +2002-04-15 13:54 Michael Granger + + * t/: 06_skips.t (1.3), 11_skips.t (1.3) (utags: RELEASE_1_18, + RELEASE_1_15, RELEASE_1_14, RELEASE_1_17, RELEASE_1_16): + + - Added 'AutoskipFailedSetup' tests. + +2002-04-15 13:54 Michael Granger + + * lib/Test/SimpleUnit.pm (1.14, RELEASE_1_14): + + - Updated, added documentation + + - Changed AutoskipFailedSetup to a function, as it was rather incongruous as a + method. The method style stills works, but it's deprecated. + + - Added code to allow 'setup' and 'teardown' cases to specify their coderefs + with a 'func' key rather than 'test' for clarity. + +2002-04-08 12:57 Michael Granger + + * README (1.2, RELEASE_1_14, RELEASE_1_13): + + - De-tabified. + +2002-04-08 12:52 Michael Granger + + * README (1.1): + + Initial commit. + +2002-04-08 12:50 Michael Granger + + * t/: 05_asserts.t (1.4), 10_asserts.t (1.4) (utags: RELEASE_1_18, + RELEASE_1_15, RELEASE_1_14, RELEASE_1_17, RELEASE_1_16, + RELEASE_1_13): + + - Modified error messages to reflect changes in assert(). + +2002-04-08 12:47 Michael Granger + + * lib/Test/SimpleUnit.pm (1.13, RELEASE_1_13): + + - Modified to pass "\n" as the last arg to die to remove the irrelevant 'at + line...' message. When I have more time, I should add code to backtrace + through caller() and get a useful equivalent. + + - Look for $ENV{TEST_VERBOSE}, too. + +2002-03-29 16:45 Michael Granger + + * Makefile.PL (1.3, RELEASE_1_17, RELEASE_1_16, RELEASE_1_15, + RELEASE_1_14, RELEASE_1_13, RELEASE_1_12): + + - Fixed ci/tag target + +2002-03-29 16:41 Michael Granger + + * Makefile.PL (1.2), lib/Test/SimpleUnit.pm (1.12, RELEASE_1_12), + t/00_require.t (1.2, RELEASE_1_18, RELEASE_1_17, RELEASE_1_16, + RELEASE_1_15, RELEASE_1_14, RELEASE_1_13, RELEASE_1_12), + t/01_importAll.t (1.2, RELEASE_1_18, RELEASE_1_17, RELEASE_1_16, + RELEASE_1_15, RELEASE_1_14, RELEASE_1_13, RELEASE_1_12), + t/02_importAsserts.t (1.3, RELEASE_1_18, RELEASE_1_17, + RELEASE_1_16, RELEASE_1_15, RELEASE_1_14, RELEASE_1_13, + RELEASE_1_12), t/03_importTfuncs.t (1.2, RELEASE_1_18, + RELEASE_1_17, RELEASE_1_16, RELEASE_1_15, RELEASE_1_14, + RELEASE_1_13, RELEASE_1_12), t/04_importSkips.t (1.2, RELEASE_1_18, + RELEASE_1_17, RELEASE_1_16, RELEASE_1_15, RELEASE_1_14, + RELEASE_1_13, RELEASE_1_12), t/05_asserts.t (1.3, RELEASE_1_12), + t/06_skips.t (1.2, RELEASE_1_13, RELEASE_1_12), + t/07_setupteardown.t (1.2, RELEASE_1_16, RELEASE_1_15, + RELEASE_1_14, RELEASE_1_13, RELEASE_1_12), t/10_asserts.t (1.3, + RELEASE_1_12), t/11_skips.t (1.2, RELEASE_1_13, RELEASE_1_12), + t/15_setupteardown.t (1.2, RELEASE_1_16, RELEASE_1_15, + RELEASE_1_14, RELEASE_1_13, RELEASE_1_12): + + - Renamed to Test::SimpleUnit + +2002-03-29 15:59 Michael Granger + + * TestFramework.pm (1.12): + + Renamed and moved into lib/Test + +2002-03-28 14:01 Michael Granger + + * TestFramework.pm (1.11, RELEASE_1_11), lib/Test/SimpleUnit.pm + (1.11): + + - Fixed copyright. + +2002-03-28 13:59 Michael Granger + + * TestFramework.pm (1.10), lib/Test/SimpleUnit.pm (1.10): + + - assertExceptionMatches(): New assertion function. + + - assertExceptionType(): New assertion function. + + - assertKindOf(): New assertion function. + + - Corrected skip handling for setup/teardown. + + - Added handler for 'skipAll' to setup/teardown. + +2002-03-28 12:00 Michael Granger + + * t/: 05_asserts.t (1.2), 10_asserts.t (1.2) (utags: RELEASE_1_11): + + - Added tests for assertExceptionType() and assertExceptionMatch(). + + - Simplified some of the other tests with new asserts. + +2002-03-22 18:21 Michael Granger + + * t/: 07_setupteardown.t (1.1), 15_setupteardown.t (1.1) (utags: + RELEASE_1_11, RELEASE_1_09): + + First commit. + +2002-03-22 18:20 Michael Granger + + * TestFramework.pm (1.9, RELEASE_1_09), lib/Test/SimpleUnit.pm + (1.9): + + - Added 'setup' and 'teardown' test handling to facilitate XUnit-style pre- and post-test functions. This feature still needs documenting. + + - AutoskipFailedSetup(): New method to automatically skip any tests in a test case after a 'setup' test has failed. + +2002-03-21 18:30 Michael Granger + + * t/: 04_importSkips.t (1.1, RELEASE_1_11), 05_asserts.t (1.1), + 06_skips.t (1.1, RELEASE_1_11), 10_asserts.t (1.1), 11_skips.t + (1.1, RELEASE_1_11) (utags: RELEASE_1_09): + + Initial commit. + +2002-03-21 18:30 Michael Granger + + * t/04_asserts.t (1.3): + + - Renamed to 05_asserts.t to make room for the skip-import tests. + +2002-03-21 18:27 Michael Granger + + * TestFramework.pm (1.8), lib/Test/SimpleUnit.pm (1.8): + + - fail: New function + + - skipOne: New function + + - skipAll: New function + + - Fixed up some warnings that showed up when using assertUndef() and assertNot() + with undefined values and no message. + +2002-03-05 15:47 Michael Granger + + * t/04_asserts.t (1.2): + + - Modified import tag to reflect name change from 'assertFunctions' to + 'asserts'. + + - Added tests for new assertions 'assertDefined' and 'assertUndef'. + +2002-03-05 15:46 Michael Granger + + * t/02_importAsserts.t (1.2, RELEASE_1_11, RELEASE_1_09): + + - Modified import tag to reflect name change from 'assertFunctions' to + 'asserts'. + +2002-03-05 15:46 Michael Granger + + * TestFramework.pm (1.7), lib/Test/SimpleUnit.pm (1.7): + + - Changed the name of the assertion exporter tag to 'asserts'; an + 'assertFunctions' tag remains for backwards-compatibility, but may be + deprecated in the future. + + - Added 'assertUndef' assertion + + - Added 'assertDefined' assertion + +2001-11-28 13:13 Michael Granger + + * TestFramework.pm (1.6), lib/Test/SimpleUnit.pm (1.6): + + - Update documentation. + +2001-10-29 12:43 Michael Granger + + * t/04_asserts.t (1.1): + + First release. + +2001-10-29 12:43 Michael Granger + + * TestFramework.pm (1.5), lib/Test/SimpleUnit.pm (1.5): + + - Cleaned up a bunch of places where an undefined value in an assertion value + was not handled gracefully. There are probably more somewhere. + + - Added two more assertion functions: assertMatches() and assertNotRef(). + + - Moved the scalar test out of assertRef() and into the new assertNotRef(). + + - Made the error message for assertInstanceOf() a bit more accurate. + +2001-09-08 23:12 Michael Granger + + * TestFramework.pm (1.4), lib/Test/SimpleUnit.pm (1.4): + + - Fixed POD escape thingies in the docs. + +2001-09-08 23:10 Michael Granger + + * TestFramework.pm (1.3), lib/Test/SimpleUnit.pm (1.3): + + - Fixed auto-generated docs, as the moduletool parser apparently doesn't like + code sample indent stuff. + +2001-08-03 16:35 Michael Granger + + * TestFramework.pm (1.2), lib/Test/SimpleUnit.pm (1.2): + + - Fixed and added more documentation + + - Added true return value at module end + +2001-08-03 15:55 Michael Granger + + * Makefile.PL (1.1.1.1, RELEASE_1_11, RELEASE_1_09, RELEASE_1_1), + TestFramework.pm (1.1.1.1, RELEASE_1_1), lib/Test/SimpleUnit.pm + (1.1.1.1), t/00_require.t (1.1.1.1, RELEASE_1_11, RELEASE_1_09, + RELEASE_1_1), t/01_importAll.t (1.1.1.1, RELEASE_1_11, + RELEASE_1_09, RELEASE_1_1), t/02_importAsserts.t (1.1.1.1, + RELEASE_1_1), t/03_importTfuncs.t (1.1.1.1, RELEASE_1_11, + RELEASE_1_09, RELEASE_1_1): + + Initial release. + +2001-08-03 15:55 Michael Granger + + * Makefile.PL (1.1), TestFramework.pm (1.1), lib/Test/SimpleUnit.pm + (1.1), t/00_require.t (1.1), t/01_importAll.t (1.1), + t/02_importAsserts.t (1.1), t/03_importTfuncs.t (1.1): + + Initial revision + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..556f397 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,17 @@ +ChangeLog +MANIFEST +Makefile.PL +README +lib/Test/SimpleUnit.pm +t/00_require.t +t/01_importAll.t +t/02_importAsserts.t +t/03_importTfuncs.t +t/04_importSkips.t +t/05_importTestData.t +t/10_asserts.t +t/11_skips.t +t/12_testdata.t +t/15_setupteardown.t +t/20_emptysuite.t +t/30_bugs.t diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..7fa8470 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,66 @@ +#!/usr/bin/perl +# +# Perl Makefile for Test::SimpleUnit +# $Id: Makefile.PL,v 1.5 2003/01/15 20:47:17 deveiant Exp $ +# +# Invocation: +# $ perl Makefile.PL # interactive behaviour +# $ perl Makefile.PL --defaultdeps # accept default value on prompts +# $ perl Makefile.PL --checkdeps # check only, no Makefile produced +# $ perl Makefile.PL --skipdeps # ignores all dependencies +# $ perl Makefile.PL --testonly # don't write installation targets +# +# Then, to build: +# $ make [all|test|install] # install dependencies first +# $ make checkdeps # same as the --checkdeps above +# $ make installdeps # install dependencies only +# + +# ExtUtils::AutoInstall Bootstrap Code, version 5. +BEGIN{my$p='ExtUtils::AutoInstall';my$v=0.40;eval"use $p $v;1 +"or do{my$e=$ENV{PERL_EXTUTILS_AUTOINSTALL};(!defined($e)||$e +!~m/--(?:default|skip|testonly)/and-t STDIN or eval"use Ext". +"Utils::MakeMaker;WriteMakefile('PREREQ_PM'=>{'$p',$v});1"and +exit)and print"==> $p $v required. Install it from CPAN? [Y". +"/n] "and!~/^n/i and print"*** Installing $p\n"and do{ +eval{require CPANPLUS;CPANPLUS::install $p};eval"use $p $v;1" +or eval{require CPAN;CPAN::install$p};eval"use $p $v;1"or die +"*** Please install $p $v manually from cpan.org first.\n"}}} + +# the above handlers must be declared before the 'use' statement +use ExtUtils::AutoInstall ( + + # required AutoInstall version + -version => '0.40', + + # core modules; may also be 'all' + -core => { + Data::Compare => '0.02', + Data::Dumper => '', + Scalar::Util => '', + Carp => '', + IO::Handle => '', + IO::File => '', + Fcntl => '', + constant => '', + }, + + ); + + +WriteMakefile( + NAME => 'Test::SimpleUnit', + DISTNAME => 'Test-SimpleUnit', + VERSION_FROM => 'lib/Test/SimpleUnit.pm', # finds $VERSION + AUTHOR => 'Michael Granger ', + ABSTRACT => 'A simplified XUnit testing framework', + dist => { + CI => "cvs commit", + RCS_LABEL => 'cvs tag RELEASE_$(VERSION_SYM)', + SUFFIX => ".bz2", + DIST_DEFAULT => 'all tardist', + COMPRESS => "bzip2", + }, + clean => { FILES => "*testdata*" }, +); + diff --git a/README b/README new file mode 100644 index 0000000..e5d7aab --- /dev/null +++ b/README @@ -0,0 +1,237 @@ + + Test::SimpleUnit + a simplified unit testing framework + +Authors +------- + + Michael Granger + + +General Information +------------------- + +This is a simplified Perl unit-testing framework for creating unit tests to be +run either standalone or under Test::Harness. + + +Testing + + Testing in Test::SimpleUnit is done by running a test suite, either via 'make + test', which uses the Test::Harness 'test' target written by + ExtUtils::MakeMaker, or as a standalone script. + + If errors occur while running tests via the 'make test' method, you can get + more verbose output about the test run by adding "TEST_VERBOSE=1" to the end + of the "make" invocation: + + $ make test TEST_VERBOSE=1 + + If you want to display only the messages caused by failing assertions, you can + add a "VERBOSE=1" to the end of the "make" invocation instead: + + $ make test VERBOSE=1 + + +Test Suites + + A test suite is one or more test cases, each of which tests a specific unit of + functionality. + + +Test Cases + + A test case is a unit of testing which consists of one or more tests, combined + with setup and teardown functions that make the necessary preparations for + testing. + + You may wish to split test cases up into separate files under a "t/" directory + so they will run under a Test::Harness-style "make test". + + +Tests + + A test is a hashref which contains two key-value pairs: a name key with the + name of the test as the value, and a code reference under a test key: + + { + name => 'This is the name of the test', + test => sub { ...testing code... } + } + + Each test's "test" function can make one or more assertions by using the + Assertion Functions provided, or can indicate that it or any trailing tests in + the same test case should be skipped by calling one of the provided Skip + Functions. + + +Setup and Teardown Functions + + If a test has the name 'setup' or 'teardown', it is run before or after each + test that follows it, respectively. A second or succeeding setup or teardown + function will supersede any function of the same type which preceded it. This + allows a test designer to change the setup function as the tests progress. See + the EXAMPLE section for an example of how to use this. + + If a test is preceeded by multiple new setup/teardown functions, the last one + to be specified is kept, and any others are discarded after being executed + once. This allows one to specify one-time setup and/or teardown functions at a + given point of testing. + + The code reference value within a *setup* or *teardown* test case can + optionally be named "func" instead of "test" for clarity. If there are both + "func" and "test" key-value pairs in a *setup* or *teardown* case, the "test" + pair is silently ignored. + + +Saving Test Data + + If the test suite requires configuration, or some other data which should + persist between test cases, it can be dumped via Data::Dumper to a file with + the saveTestData() function. In succeeding tests, it can be reloaded using the + loadTestData() function. + + + +Example +------- + + use Test::SimpleUnit qw{:functions}; + + # If a setup function fails, skip the rest of the tests + Test::SimpleUnit::AutoskipFailedSetup( 1 ); + + my $Instance; + my $RequireWasOkay = 0; + + my @tests = ( + + # Require the module + { + name => 'require', + test => sub { + + # Make sure we can load the module to be tested. + assertNoException { require MyClass }; + + # Try to import some functions, generating a custom error message if it + # fails. + assertNoException { MyClass->import(':myfuncs') } "Failed to import :myfuncs"; + + # Make sure calling 'import()' actually imported the functions + assertRef 'CODE', *::myfunc{CODE}; + assertRef 'CODE', *::myotherfunc{CODE}; + + # Set the flag to let the setup function know the module loaded okay + $RequireWasOkay = 1; + }, + }, + + # Setup function (this will be run before any tests which follow) + { + name => 'setup', + test => sub { + # If the previous test didn't finish, it's untestable, so just skip the + # rest of the tests + skipAll "Module failed to load" unless $RequireWasOkay; + $Instance = new MyClass; + }, + }, + + # Teardown function (this will be run after any tests which follow) + { + name => 'teardown', + test => sub { + undef $Instance; + }, + }, + + # One-time setup function -- overrides the previous setup, but is + # immediately discarded after executing once. + { + name => 'setup', + func => sub { + MyClass::prepNetwork(); + }, + }, + + # Test the connect() and disconnect() methods + { + name => 'connect() and disconnect()', + test => sub { + my $rval; + + assertNoException { $rval = $Instance->connect }; + assert $rval, "Connect failed without error."; + assertNoException { $Instance->disconnect }; + }, + }, + + # Now override the previous setup function with a new one that does + # a connect() before each remaining test. + { + name => 'setup', + test => sub { + $Instance = new MyClass; + $Instance->connect; + }, + } + + # Same thing for teardown/disconnect() + { + name => 'teardown', + test => sub { + $Instance->disconnect; + undef $Instance; + }, + }, + + ... + + ); + + runTests( @testSuite ); + + +Caveats +------- + +I would greatly appreciate feedback on any aspect of this software. Suggestions, +feature requests, questions, design critiques, and bug reports are most +welcome. Relevant patches are particularly helpful. I may be reached at +. + + +Installation +------------ + + $ perl Makefile.PL + $ make + $ make test + (become root) + # make install + + +== Legal + +This module is Open Source Software which is Copyright (c) 1999-2003 by The +FaerieMUD Consortium. + +You may use, modify, and/or redistribute this software under the terms of either +the Perl Artistic License or the GNU Public License (version 2 or later), +whichever you prefer. A copy of the Artistic license should have been included +in this distribution (See the file Artistic). If it was not, a copy of it may be +obtained from http://language.perl.com/misc/Artistic.html or +http://www.faeriemud.org/artistic.html). + +THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, +INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND +FITNESS FOR A PARTICULAR PURPOSE. + + +Rev: $Id: README,v 1.5 2003/01/15 21:48:39 deveiant Exp $ + + + + + diff --git a/lib/Test/SimpleUnit.pm b/lib/Test/SimpleUnit.pm new file mode 100644 index 0000000..5310942 --- /dev/null +++ b/lib/Test/SimpleUnit.pm @@ -0,0 +1,1215 @@ +#!/usr/bin/perl +############################################################################## + +=head1 NAME + +Test::SimpleUnit - Simplified Perl unit-testing framework + +=head1 SYNOPSIS + + use Test::SimpleUnit qw{:functions}; + runTests( + {name => "test1", test => sub {...}}, + {name => "testN", test => sub {...}} + ); + +=head1 EXAMPLE + + use Test::SimpleUnit qw{:functions}; + + # If a setup or teardown function fails, skip the rest of the tests + Test::SimpleUnit::AutoskipFailedSetup( 1 ); + Test::SimpleUnit::AutoskipFailedTeardown( 1 ); + + my $Instance; + my $RequireWasOkay = 0; + + my @tests = ( + + # Require the module + { + name => 'require', + test => sub { + + # Make sure we can load the module to be tested. + assertNoException { require MyClass }; + + # Try to import some functions, generating a custom error message if it + # fails. + assertNoException { MyClass->import(':myfuncs') } "Failed to import :myfuncs"; + + # Make sure calling 'import()' actually imported the functions + assertRef 'CODE', *::myfunc{CODE}; + assertRef 'CODE', *::myotherfunc{CODE}; + + # Set the flag to let the setup function know the module loaded okay + $RequireWasOkay = 1; + }, + }, + + # Setup function (this will be run before any tests which follow) + { + name => 'setup', + test => sub { + # If the previous test didn't finish, it's untestable, so just skip the + # rest of the tests + skipAll "Module failed to load" unless $RequireWasOkay; + $Instance = new MyClass; + }, + }, + + # Teardown function (this will be run after any tests which follow) + { + name => 'teardown', + test => sub { + undef $Instance; + }, + }, + + # Test the connect() and disconnect() methods + { + name => 'connect() and disconnect()', + test => sub { + my $rval; + + assertNoException { $rval = $Instance->connect }; + assert $rval, "Connect failed without error."; + assertNoException { $Instance->disconnect }; + }, + }, + + # One-time setup function -- overrides the previous setup, but is + # immediately discarded after executing once. + { + name => 'setup', + func => sub { + MyClass::prepNetwork(); + }, + }, + + # Now override the previous setup function with a new one that does + # a connect() before each remaining test. + { + name => 'setup', + test => sub { + $Instance = new MyClass; + $Instance->connect; + }, + } + + # Same thing for teardown/disconnect() + { + name => 'teardown', + test => sub { + $Instance->disconnect; + undef $Instance; + }, + }, + + ... + + ); + + runTests( @testSuite ); + +=head1 DESCRIPTION + +This is a simplified Perl unit-testing framework for creating unit tests to be +run either standalone or under Test::Harness. + +=head2 Testing + +Testing in Test::SimpleUnit is done by running a test suite, either via 'make +test', which uses the L 'test' target written by +L, or as a standalone script. + +If errors occur while running tests via the 'make test' method, you can get more +verbose output about the test run by adding C to the end of the +C invocation: + + $ make test TEST_VERBOSE=1 + +If you want to display only the messages caused by failing assertions, you can +add a C to the end of the C invocation instead: + + $ make test VERBOSE=1 + +=head2 Test Suites + +A test suite is one or more test cases, each of which tests a specific unit of +functionality. + +=head2 Test Cases + +A test case is a unit of testing which consists of one or more tests, combined +with setup and teardown functions that make the necessary preparations for +testing. + +You may wish to split test cases up into separate files under a C directory +so they will run under a L-style C. + +=head2 Tests + +A test is a hashref which contains two key-value pairs: a I key with the +name of the test as the value, and a code reference under a I key: + + { + name => 'This is the name of the test', + test => sub { ...testing code... } + } + +Each test's C function can make one or more assertions by using the +L provided, or can indicate that it +or any trailing tests in the same test case should be skipped by calling one of +the provided L. + +=head2 Setup and Teardown Functions + +If a test has the name 'setup' or 'teardown', it is run before or after each +test that follows it, respectively. A second or succeeding setup or teardown +function will supersede any function of the same type which preceded it. This +allows a test designer to change the setup function as the tests progress. See +the L section for an example of how to use this. + +If a test is preceeded by multiple new setup/teardown functions, the last one to +be specified is kept, and any others are discarded after being executed +once. This allows one to specify one-time setup and/or teardown functions at a +given point of testing. + +The code reference value within a I or I test case can +optionally be named C instead of C for clarity. If there are both +C and C key-value pairs in a I or I case, the +C pair is silently ignored. + +=head2 Saving Test Data + +If the test suite requires configuration, or some other data which should +persist between test cases, it can be dumped via Data::Dumper to a file with the +L function. In succeeding tests, it can +be reloaded using the L function. + +=head1 REQUIRES + +L, L, L, +L, L, L, +L, L + +=head1 EXPORTS + +Nothing by default. + +This module exports several useful assertion functions for the following tags: + +=over 4 + +=item B<:asserts> + +L, L, +L, L, +L, L, L, +L, L, L, L, L, +L, L, L + +=item B<:skips> + +L, L + +=item B<:testFunctions> + +L + +=item B<:testdata> + +L, L + +=item B<:functions> + +All of the above. + +=back + +=head1 AUTHOR + +Michael Granger Eged@FaerieMUD.orgE + +Copyright (c) 1999-2003 The FaerieMUD Consortium. All rights reserved. + +This module is free software. You may use, modify, and/or redistribute this +software under the terms of the Perl Artistic License. (See +http://language.perl.com/misc/Artistic.html) + +=cut + +############################################################################## +package Test::SimpleUnit; +use strict; +use warnings qw{all}; + +############################################################################### +### I N I T I A L I Z A T I O N +############################################################################### +BEGIN { + ### Versioning stuff and custom includes + use vars qw{$VERSION $RCSID}; + $VERSION = 1.21; + $RCSID = q$Id: SimpleUnit.pm,v 1.24 2003/01/15 21:44:46 deveiant Exp $; + + ### Export functions + use base qw{Exporter}; + use vars qw{@EXPORT @EXPORT_OK %EXPORT_TAGS}; + + @EXPORT = qw{}; + @EXPORT_OK = qw{ + &saveTestData + &loadTestData + + &assert + &assertNot + &assertDefined + &assertUndef + &assertNoException + &assertException + &assertExceptionType + &assertExceptionMatches + &assertEquals + &assertMatches + &assertRef + &assertNotRef + &assertInstanceOf + &assertKindOf + + &fail + + &skipOne + &skipAll + + &runTests + }; + %EXPORT_TAGS = ( + functions => \@EXPORT_OK, + testdata => [@EXPORT_OK[ 0 .. 2 ]], + asserts => [@EXPORT_OK[ 2 .. $#EXPORT_OK-3 ]], + assertFunctions => [@EXPORT_OK[ 2 .. $#EXPORT_OK-3 ]], # Backwards-compatibility + skips => [@EXPORT_OK[ $#EXPORT_OK-3 .. $#EXPORT_OK-1 ]], + testFunctions => [$EXPORT_OK[ $#EXPORT_OK ]], + ); + + # More readable constants + use constant TRUE => 1; + use constant FALSE => 0; + + # Load other modules + use Data::Dumper qw{}; + use Data::Compare qw{Compare}; + use Scalar::Util qw{blessed dualvar}; + use IO::Handle qw{}; + use IO::File qw{}; + use Fcntl qw{O_CREAT O_RDONLY O_WRONLY O_TRUNC}; + use Carp qw{croak confess}; +} + + +##################################################################### +### C L A S S V A R I A B L E S +##################################################################### +our ( $AutoskipFailedSetup, $AutoskipFailedDataLoad, $AutoskipFailedTeardown, + $Debug, $DefaultOutputHandle, $OutputHandle, @Counters ); + +$AutoskipFailedSetup = FALSE; +$AutoskipFailedDataLoad = FALSE; +$AutoskipFailedTeardown = FALSE; +$Debug = FALSE; +$DefaultOutputHandle = IO::Handle->new_from_fd( fileno STDOUT, 'w' ); +$OutputHandle = $DefaultOutputHandle; + +@Counters = (); + + +### FUNCTION: AutoskipFailedSetup( $trueOrFalse ) +### If set to a true value, any failed setup functions will cause the test to be +### skipped instead of running. +sub AutoskipFailedSetup { + shift if @_ && $_[0] eq __PACKAGE__; # <- Backward compatibility + $AutoskipFailedSetup = shift if @_; + return $AutoskipFailedSetup; +} + + +### FUNCTION: AutoskipFailedDataLoad( $trueOrFalse ) +### If set to a true value, any failure to reload test data via loadTestData() +### will cause the test to be skipped instead of running. +sub AutoskipFailedDataLoad { + shift if @_ && $_[0] eq __PACKAGE__; # <- Backward compatibility + $AutoskipFailedDataLoad = shift if @_; + return $AutoskipFailedDataLoad; +} + + +### FUNCTION: AutoskipFailedTeardown( $trueOrFalse ) +### If set to a true value, any failed teardown functions will cause the test to +### be skipped instead of running. +sub AutoskipFailedTeardown { + shift if @_ && $_[0] eq __PACKAGE__; # <- Backward compatibility + $AutoskipFailedTeardown = shift if @_; + return $AutoskipFailedTeardown; +} + + +### FUNCTION: Debug( $trueOrFalse ) +### If set to a true value, the test suite will be dumped to STDERR before +### running. +sub Debug { + $Debug = shift if @_; + print STDERR ">>> Turned debugging on.\n" if $Debug; + return $Debug; +} + + +### FUNCTION: OutputHandle( $handle ) +### Set the I that will be used to output test progress +### information. This can be used to run tests under Test::Harness without +### influencing the test result, such as when invoking runTests() from within an +### assertion. It defaults to STDOUT, which will be what it is restored to if it +### is called with no argument. The argument is tested for support for the +### 'print', 'flush', and 'printf' methods, and dies if it does not support +### them. This function is mostly to support self-testing. +sub OutputHandle { + my $ofh = shift || $DefaultOutputHandle; + croak( "Invalid output handle for test output ($OutputHandle)" ) + unless UNIVERSAL::can($ofh, 'print') + && UNIVERSAL::can($ofh, 'flush') + && UNIVERSAL::can($ofh, 'printf'); + $ofh->autoflush; + $OutputHandle = $ofh; +} + + +### (PRIVATE) FUNCTION: _PushAssertionCounter() +### Add a pair of assertion counters to the stack. Assertion counters are used +### to count assertion runs/successes, and this adds a level in case of +### recursive runTests() calls. +sub _PushAssertionCounter { + unshift @Counters, { run => 0, succeed => 0 }; +} + + +### (PRIVATE) FUNCTION: _CountAssertion() +### Add 1 to the count of assertions run in the current counter frame. +sub _CountAssertion { + croak( "No counter frames in the stack" ) + unless @Counters; + $Counters[ 0 ]{run}++; +} + + +### (PRIVATE) FUNCTION: _CountSuccess() +### Add 1 to the count of successful assertions in the current counter frame. +sub _CountSuccess { + croak( "No counter frames in the stack" ) + unless @Counters; + $Counters[ 0 ]{succeed}++; +} + +### (PRIVATE) FUNCTION: _PopAssertionCounter() +### Remove the current assertion counter, and return a list of the number of +### assertions run, and the number of assertions which succeeded. +sub _PopAssertionCounter { + croak( "No counter frames in the stack" ) + unless @Counters; + my $counterFrame = shift @Counters; + return( $counterFrame->{run}, $counterFrame->{succeed} ); +} + + +##################################################################### +### F O R W A R D D E C L A R A T I O N S +##################################################################### +sub saveTestData ($\%); +sub loadTestData ($); + +sub assert ($;$); +sub assertNot ($;$); +sub assertDefined ($;$); +sub assertUndef ($;$); +sub assertNoException (&;$); +sub assertException (&;$); +sub assertExceptionType (&$;$); +sub assertExceptionMatches (&$;$); +sub assertEquals ($$;$); +sub assertMatches ($$;$); +sub assertRef ($$;$); +sub assertNotRef ($;$); +sub assertInstanceOf ($$;$); +sub assertKindOf ($$;$); + +sub fail (;$); + +sub skipOne (;$); +sub skipAll (;$); + +sub runTests; + + + +##################################################################### +### T E S T D A T A L O A D / S A V E F U N C T I O N S +##################################################################### + +### (TEST DATA) FUNCTION: saveTestData( $filename, %datahash ) +### Save the key/value pairs in I<%datahash> to a file with the specified +### I for later loading via loadTestData(). +sub saveTestData ($\%) { + my ( $filename, $datahash ) = @_; + + my $data = Data::Dumper->new( [$datahash], [qw{datahash}] ) + or die "Couldn't create Data::Dumper object"; + my $datafile = IO::File->new( $filename, O_CREAT|O_WRONLY|O_TRUNC ) + or die "open: $filename: $!"; + my $dumped = $data->Indent(0)->Purity(1)->Terse(1)->Dumpxs; + + if ( $Debug ) { + print STDERR "saveTestData: Saving dumped test data '$dumped'\n"; + } + + $datafile->printflush( $dumped ); + $datafile->close; + + return TRUE; +} + + +### (TEST DATA) FUNCTION: loadTestData( $filename ) +### Load key/data pairs from a data file that was saved from previous +### tests. Returns a reference to a hash of data items. +sub loadTestData ($) { + my $filename = shift; + + my $datafile = IO::File->new( $filename, O_RDONLY ) + or die "open: $filename: $!"; + my $dumped = join '', $datafile->getlines; + + if ( $Debug ) { + print STDERR "loadTestData: Loading dumped test data '$dumped'\n"; + } + + my $data = eval $dumped; + + if ( $@ ) { + my $message = "Error while evaluating dumped data: $@"; + $message = bless \$message, 'SKIPALL' if $AutoskipFailedDataLoad; + die $message; + } + + return $data; +} + + + + +##################################################################### +### T E S T I N G F U N C T I O N S +##################################################################### + +### (ASSERTION) FUNCTION: assert( $value[, $failureMessage] ) +### Die with a failure message if the specified value is not true. If the +### optional failureMessage is not given, one will be generated. +sub assert ($;$) { + my ( $assert, $message ) = @_; + + Test::SimpleUnit::_CountAssertion(); + $message ||= defined $assert ? "$assert" : "(undef)"; + die( $message, "\n" ) unless $assert; + Test::SimpleUnit::_CountSuccess(); + + return 1; +} + +### (ASSERTION) FUNCTION: assertNot( $value[, $failureMessage] ) +### Die with a failure message if the specified value B true. If the +### optional failureMessage is not given, one will be generated. +sub assertNot ($;$) { + my ( $assert, $message ) = @_; + assert( !$assert, $message || "Expected a false value, got '". + (defined $assert ? "$assert" : "(undef)"). "'" ); +} + +### (ASSERTION) FUNCTION: assertDefined( $value[, $failureMessage] ) +### Die with a failure message if the specified value is undefined. If the +### optional failureMessage is not given, one will be generated. +sub assertDefined ($;$) { + my ( $assert, $message ) = @_; + assert( defined($assert), $message || "Expected a defined value, got an undef" ); +} + +### (ASSERTION) FUNCTION: assertUndef( $value[, $failureMessage] ) +### Die with a failure message if the specified value is defined. If the +### optional failureMessage is not given, one will be generated. +sub assertUndef ($;$) { + my ( $assert, $message ) = @_; + assert( !defined($assert), $message || "Expected an undefined value, got '". + (defined $assert ? "$assert" : "(undef)") . "'" ); +} + +### (ASSERTION) FUNCTION: assertNoException( \&code[, $failureMessage] ) +### Evaluate the specified coderef, and die with a failure message if it +### generates an exception. If the optional failureMessage is not given, one +### will be generated. +sub assertNoException (&;$) { + my ( $code, $message ) = @_; + + eval { $code->() }; + assertNot( $@, $message || "Exception raised: $@" ); +} + +### (ASSERTION) FUNCTION: assertException( \&code[, $failureMessage] ) +### Evaluate the specified I, and die with a failure message if it does +### not generate an exception. If the optional I is not given, one +### will be generated. +sub assertException (&;$) { + my ( $code, $message ) = @_; + + eval { $code->() }; + assert( $@, $message || "No exception raised." ); +} + +### (ASSERTION) FUNCTION: assertExceptionType( \&code, $type[, $failureMessage] ) +### Evaluate the specified I, and die with a failure message if it does +### not generate an exception which is an object blessed into the specified +### I or one of its subclasses (ie., the exception must return true to +### C<$exception->isa($type)>. If the optional I is not given, one +### will be generated. +sub assertExceptionType (&$;$) { + my ( $code, $type, $message ) = @_; + + eval { $code->() }; + assert $@, ($message||"Expected an exception of type '$type', but none was raised."); + + $message ||= sprintf( "Expected exception of type '%s', got a '%s' instead.", + $type, blessed $@ || $@ ); + assertKindOf( $type, $@, $message ); +} + +### (ASSERTION) FUNCTION: assertExceptionMatches( \&code, $regex[, $failureMessage] ) +### Evaluate the specified I, and die with a failure message if it does +### not generate an exception which matches the specified I. If the +### optional I is not given, one will be generated. +sub assertExceptionMatches (&$;$) { + my ( $code, $regex, $message ) = @_; + + eval { $code->() }; + assert $@, ($message || "Expected an exception which matched /$regex/, but none was raised."); + my $err = "$@"; + + $message ||= sprintf( "Expected exception matching '%s', got '%s' instead.", + $regex, $err ); + assertMatches( $regex, $err, $message ); +} + + +### (ASSERTION) FUNCTION: assertEquals( $wanted, $tested[, $failureMessage] ) +### Die with a failure message if the specified wanted value doesn't equal the +### specified tested value. The comparison is done with Data::Compare, so +### arbitrarily complex data structures may be compared, as long as they contain +### no GLOB, CODE, or REF references. If the optional failureMessage is not +### given, one will be generated. +sub assertEquals ($$;$) { + my ( $wanted, $tested, $message ) = @_; + + $message ||= sprintf( "Wanted '%s', got '%s' instead", + defined $wanted ? $wanted : "(undef)", + defined $tested ? $tested : "(undef)" ); + assert( Compare($wanted, $tested), $message ); +} + +### (ASSERTION) FUNCTION: assertMatches( $wantedRegexp, $testedValue[, $failureMessage] ) +### Die with a failure message if the specified tested value doesn't match +### the specified wanted regular expression. If the optional failureMessage is +### not given, one will be generated. +sub assertMatches ($$;$) { + my ( $wanted, $tested, $message ) = @_; + + if ( ! blessed $wanted || ! $wanted->isa('Regexp') ) { + $wanted = qr{$wanted}; + } + + $message ||= "Tested value '$tested' did not match wanted regex '$wanted'"; + assert( ($tested =~ $wanted), $message ); +} + +### (ASSERTION) FUNCTION: assertRef( $wantedType, $testedValue[, $failureMessage] ) +### Die with a failure message if the specified testedValue is not of the +### specified wantedType. The wantedType can either be a ref-type like 'ARRAY' +### or 'GLOB' or a package name for testing object classes. If the optional +### failureMessage is not given, one will be generated. +sub assertRef ($$;$) { + my ( $wantedType, $testValue, $message ) = @_; + + $message ||= ("Expected a $wantedType value, got a " . + ( ref $testValue ? ref $testValue : (defined $testValue ? 'scalar' : 'undefined value') )); + assert( ref $testValue && (ref $testValue eq $wantedType || UNIVERSAL::isa($wantedType, $testValue)), $message ); +} + + +### (ASSERTION) FUNCTION: assertNotRef( $testedValue[, $failureMessage] ) +### Die with a failure message if the specified testedValue is a reference of +### any kind. If the optional failureMessage is not given, one will be +### generated. +sub assertNotRef ($;$) { + my ( $testValue, $message ) = @_; + + $message ||= ( "Expected a simple scalar, got a " . (ref $testValue ? ref $testValue : 'scalar') ); + assert( !ref $testValue, $message ); +} + + +### (ASSERTION) FUNCTION: assertInstanceOf( $wantedClass, $testedValue[, $failureMessage] ) +### Die with a failure message if the specified testedValue is not an instance +### of the specified wantedClass. If the optional failureMessage is not given, +### one will be generated. +sub assertInstanceOf ($$;$) { + my ( $wantedClass, $testValue, $message ) = @_; + + my $defaultMessage = sprintf( "Expected an instance of '%s', got a non-object ('%s')", + $wantedClass, + defined $testValue ? $testValue : "(undef)" ); + assert( blessed $testValue, $message || $defaultMessage ); + + $message ||= sprintf( "Expected an instance of '$wantedClass', got an instance of '%s' instead", + blessed $testValue ); + assertEquals( $wantedClass, ref $testValue, $message ); +} + + +### (ASSERTION) FUNCTION: assertKindOf( $wantedClass, $testedValue[, $failureMessage] ) +### Die with a failure message if the specified testedValue is not an instance +### of the specified wantedClass B one of its derivatives. If the optional +### failureMessage is not given, one will be generated. +sub assertKindOf ($$;$) { + my ( $wantedClass, $testValue, $message ) = @_; + + my $defaultMessage = sprintf( "Expected an instance of '%s' or a subclass, got a non-object ('%s')", + $wantedClass, + defined $testValue ? $testValue : "(undef)" ); + assert( blessed $testValue, $message || $defaultMessage ); + + $message ||= sprintf( "Expected an instance of '%s' or a subclass, got an instance of '%s' instead", + $wantedClass, + blessed $testValue ); + assert( $testValue->isa($wantedClass), $message ); +} + + +### (ASSERTION) FUNCTION: fail( [$failureMessage] ) +### Die with a failure message unconditionally. If the optional +### I is not given, a generic failure message will be used +### instead. +sub fail (;$) { + my $message = shift || "Failed (no reason given)"; + Test::SimpleUnit::_CountAssertion(); + die( $message ); +} + + +### (SKIP) FUNCTION: skipOne( [$message] ) +### Skip the rest of this test, optionally outputting a message as to why the +### rest of the test was skipped. +sub skipOne (;$) { + my $message = shift || ''; + die bless \$message, 'SKIPONE'; +} + + +### (SKIP) FUNCTION: skipAll( [$message] ) +### Skip all the remaining tests, optionally outputting a message as to why the +### they were skipped. +sub skipAll (;$) { + my $message = shift || ''; + die bless \$message, 'SKIPALL'; +} + + +### FUNCTION: runTests( @testSuite ) +### Run the tests in the specified testSuite, generating output appropriate for +### the harness under which it is running. The testSuite should consist of one +### or more hashrefs of the following form: +### +### { +### name => 'testName', +### test => sub { I } +### } +### +### The I should make one or more assertions, and eventually return a +### true value if it succeeds. +sub runTests { + my @testSuite = @_; + + my ( + $tests, + $setupFuncs, + $teardownFuncs, + @failures, + ); + + # Split setup funcs, teardown funcs, and tests into three arrayrefs + ( $setupFuncs, $tests, $teardownFuncs ) = _prepSuite( @testSuite ); + + if ( $Debug ) { + print STDERR Data::Dumper->Dumpxs( [$setupFuncs,$tests,$teardownFuncs], + [qw{setupFuncs tests teardownFuncs}] ), "\n"; + } + + # If we have non-setup/teardown tests, run them + if ( @$tests ) { + @failures = _runTests( $setupFuncs, $tests, $teardownFuncs ); + + # If there were any failures + if ( @failures && ($ENV{VERBOSE} || $ENV{TEST_VERBOSE}) ) { + print STDERR "Failures: \n", join( "\n", @failures ), "\n\n"; + } + } + + # Otherwise, just skip everything + else { + $OutputHandle->print( "1..1\n" ); + $OutputHandle->print( "ok # skip: Empty test suite.\n" ); + } + + return 1; +} + + +### (PROTECTED) FUNCTION: _runTests( \@setupFuncs, \@tests, \@teardownFuncs ) +### Run the specified I, running any I before each one, and +### any I after each one. +sub _runTests { + my ( $setupFuncs, $tests, $teardownFuncs ) = @_; + + my ( + $runningUnderTestHarness, + $testCount, + @failures, + $skip, + $func, + ); + + Test::SimpleUnit::_PushAssertionCounter(); + $runningUnderTestHarness = 1 if $ENV{HARNESS_ACTIVE}; + + # Print the preamble and intialize some vars + if ( $Debug ) { + print STDERR Data::Dumper->Dumpxs( [$setupFuncs,$tests,$teardownFuncs], + [qw{setupFuncs tests teardownFuncs}] ), "\n"; + print STDERR "Scalar tests = ", scalar @$tests, "\n"; + } + $OutputHandle->printf( "1..%d\n", scalar @$tests ); + $OutputHandle->flush; + $testCount = 0; + @failures = (); + $skip = ''; + + # If neither the VERBOSE nor TEST_VERBOSE vars were set, don't show STDERR + unless ( $ENV{VERBOSE} || $ENV{TEST_VERBOSE} ) { + open( STDERR, "+>/dev/null" ); + } + + + TEST: foreach my $test ( @$tests ) { + $testCount++; + + # Run the current setup function unless we're in skip mode, there aren't + # any setup functions, or the earliest one occurs after the current test + unless ( $skip || !@$setupFuncs || $setupFuncs->[0]{index} > $testCount - 1 ) { + my @tossedFuncs = (); + + # Remove tests that will be superceded this turn... + SETUP: while ( @$setupFuncs > 1 && $setupFuncs->[1]{index} <= $testCount - 1 ) { + printf STDERR ("Test '%s' superceded by '%s'\n", + $setupFuncs->[0]{name}, + $setupFuncs->[1]{name}); + push @tossedFuncs, shift(@$setupFuncs); + next SETUP; + } + + # Get the function and execute it + foreach my $setup ( @tossedFuncs, $setupFuncs->[0] ) { + $func = $setup->{func} || $setup->{test}; + eval { $func->($test) }; + + # If there was an error, handle any autoskipping + if ( $@ ) { + # Handle an explicit skipAll in a setup function + if ( ref $@ eq 'SKIPALL' ) { + $OutputHandle->print( "ok # skip: ${$@}\n" ); + $skip = ${$@}; + next TEST; + } else { + print STDERR "Warning: Setup failed: $@\n"; + $OutputHandle->print( "ok # skip: Setup failed ($@)\n" ), $skip = ${$@} + if $AutoskipFailedSetup; + } + } + + # Remove a test which is superceded by the following one + if ( @$setupFuncs > 1 && $setupFuncs->[1]{index} <= $testCount ) { + if ( $Debug ) { + printf STDERR ("Test '%s' succeeded by '%s'\n", + $func->{name}, + $setupFuncs->[1]{name}); + } + shift @$setupFuncs; + } + + } + } + + # Print the test header and skip if we're skipping + $OutputHandle->print( $testCount, ". $test->{name}: " ) unless $runningUnderTestHarness; + $OutputHandle->print( "ok # skip $skip\n" ), next TEST if $skip; + + # If the test doesn't have a 'test' key, or its not a coderef, skip it + $OutputHandle->print( "ok # skip No test function\n" ), next TEST + unless exists $test->{test}; + $OutputHandle->print( "ok # skip Test function is not a coderef\n" ), next TEST + unless ref $test->{test} eq 'CODE'; + + if ( $Debug ) { + print STDERR "Output handle before eval = fd ", $OutputHandle->fileno, "\n"; + } + + # Run the actual test + eval { + $test->{test}(); + }; + + if ( $Debug ) { + print STDERR "Output handle after eval = fd ", $OutputHandle->fileno, "\n"; + } + + # If there was an exception, handle it. It's either a 'skip the rest', + # 'skip this one', or a bonafide error + if ( $@ ) { + if ( ref $@ eq 'SKIPONE' ) { + $OutputHandle->print( "ok # skip: ${$@}\n" ); + } elsif ( ref $@ eq 'SKIPALL' ) { + $OutputHandle->print( "ok # skip: ${$@}\n" ); + $skip = ${$@}; + } else { + push @failures, "$test->{name}: $@"; + $OutputHandle->print( "not ok # $@\n" ); + } + } else { + $OutputHandle->print( "ok\n" ); + } + + # Run the current teardown function unless we're in skip mode, there aren't + # any teardown functions, or the earliest one occurs after the current test + unless ( $skip || !@$teardownFuncs || $teardownFuncs->[0]{index} > $testCount - 1 ) { + my @tossedFuncs = (); + + # Remove tests that will be superceded this turn... + TEARDOWN: while ( @$teardownFuncs > 1 && $teardownFuncs->[1]{index} <= $testCount - 1 ) { + printf STDERR ("Test '%s' superceded by '%s'\n", + $teardownFuncs->[0]{name}, + $teardownFuncs->[1]{name}); + push @tossedFuncs, shift(@$teardownFuncs); + next TEARDOWN; + } + + # Get the function and execute it + foreach my $teardown ( @tossedFuncs, $teardownFuncs->[0] ) { + $func = $teardown->{func} || $teardown->{test}; + eval { $func->($test) }; + + # If there was an error, handle any autoskipping + if ( $@ ) { + # Handle an explicit skipAll in a teardown function + if ( ref $@ eq 'SKIPALL' ) { + $OutputHandle->print( "ok # skip: ${$@}\n" ); + $skip = ${$@}; + next TEST; + } else { + print STDERR "Warning: Teardown failed: $@\n"; + $OutputHandle->print( "ok # skip: Teardown failed ($@)\n" ), $skip = ${$@} + if $AutoskipFailedTeardown; + } + } + + # Remove a test which is superceded by the following one + if ( @$teardownFuncs > 1 && $teardownFuncs->[1]{index} <= $testCount ) { + if ( $Debug ) { + printf STDERR ("Test '%s' succeeded by '%s'\n", + $func->{name}, + $teardownFuncs->[1]{name}); + } + shift @$teardownFuncs; + } + + } + } + } + + my ( $assertCount, $succeedCount ) = Test::SimpleUnit::_PopAssertionCounter(); + if ( $Debug ) { + print STDERR "Assertion counter came back: $succeedCount/$assertCount\n"; + } + $OutputHandle->print( "$succeedCount out of $assertCount assertions passed.\n" ) + unless $runningUnderTestHarness; + + return @failures; +} + + +### (PROTECTED) FUNCTION: _prepSuite( @tests ) +### Split the specified array of test hashrefs into three arrays: setupFuncs, +### tests, and teardownFuncs. Return references to the three arrays. +sub _prepSuite { + my @testSuite = @_; + + my ( @setupFuncs, @teardownFuncs ); + + # Scan the test suite for setup and teardown, splicing them off into the + # appropriate array if found + SCAN: for ( my $i = 0 ; $i <= $#testSuite ; $i++ ) { + last SCAN unless @testSuite; + + if ( $testSuite[$i]->{name} =~ m{^set[^a-z]?up$}i ) { + push @setupFuncs, splice( @testSuite, $i, 1 ); + $setupFuncs[ $#setupFuncs ]{index} = $i; + redo SCAN; + } + + elsif ( $testSuite[$i]->{name} =~ m{^tear[^a-z]?down$}i ) { + push @teardownFuncs, splice( @testSuite, $i, 1 ); + $teardownFuncs[ $#teardownFuncs ]{index} = $i; + redo SCAN; + } + } + + return ( \@setupFuncs, \@testSuite, \@teardownFuncs ); +} + + + +1; + + +### AUTOGENERATED DOCUMENTATION FOLLOWS + +=head1 FUNCTIONS + +=over 4 + +=item I + +If set to a true value, any failure to reload test data via loadTestData() +will cause the test to be skipped instead of running. + +=item I + +If set to a true value, any failed setup functions will cause the test to be +skipped instead of running. + +=item I + +If set to a true value, any failed teardown functions will cause the test to +be skipped instead of running. + +=item I + +If set to a true value, the test suite will be dumped to STDERR before +running. + +=item I + +Set the I that will be used to output test progress +information. This can be used to run tests under Test::Harness without +influencing the test result, such as when invoking runTests() from within an +assertion. It defaults to STDOUT, which will be what it is restored to if it +is called with no argument. The argument is tested for support for the +'print', 'flush', and 'printf' methods, and dies if it does not support +them. This function is mostly to support self-testing. + +=item I + +Run the tests in the specified testSuite, generating output appropriate for +the harness under which it is running. The testSuite should consist of one +or more hashrefs of the following form: + +=back + +=head2 Assertion Functions + +=over 4 + +=item I + +Die with a failure message if the specified value is not true. If the +optional failureMessage is not given, one will be generated. + +=item I + +Die with a failure message if the specified value is undefined. If the +optional failureMessage is not given, one will be generated. + +=item I + +Die with a failure message if the specified wanted value doesn't equal the +specified tested value. The comparison is done with Data::Compare, so +arbitrarily complex data structures may be compared, as long as they contain +no GLOB, CODE, or REF references. If the optional failureMessage is not +given, one will be generated. + +=item I + +Evaluate the specified I, and die with a failure message if it does +not generate an exception. If the optional I is not given, one +will be generated. + +=item I + +Evaluate the specified I, and die with a failure message if it does +not generate an exception which matches the specified I. If the +optional I is not given, one will be generated. + +=item I + +Evaluate the specified I, and die with a failure message if it does +not generate an exception which is an object blessed into the specified +I or one of its subclasses (ie., the exception must return true to +C<$exception->isa($type)>. If the optional I is not given, one +will be generated. + +=item I + +Die with a failure message if the specified testedValue is not an instance +of the specified wantedClass. If the optional failureMessage is not given, +one will be generated. + +=item I + +Die with a failure message if the specified testedValue is not an instance +of the specified wantedClass B one of its derivatives. If the optional +failureMessage is not given, one will be generated. + +=item I + +Die with a failure message if the specified tested value doesn't match +the specified wanted regular expression. If the optional failureMessage is +not given, one will be generated. + +=item I + +Evaluate the specified coderef, and die with a failure message if it +generates an exception. If the optional failureMessage is not given, one +will be generated. + +=item I + +Die with a failure message if the specified value B true. If the +optional failureMessage is not given, one will be generated. + +=item I + +Die with a failure message if the specified testedValue is a reference of +any kind. If the optional failureMessage is not given, one will be +generated. + +=item I + +Die with a failure message if the specified testedValue is not of the +specified wantedType. The wantedType can either be a ref-type like 'ARRAY' +or 'GLOB' or a package name for testing object classes. If the optional +failureMessage is not given, one will be generated. + +=item I + +Die with a failure message if the specified value is defined. If the +optional failureMessage is not given, one will be generated. + +=item I + +Die with a failure message unconditionally. If the optional +I is not given, a generic failure message will be used +instead. + +=back + +=head2 Private Functions + +=over 4 + +=item I<_CountAssertion()> + +Add 1 to the count of assertions run in the current counter frame. + +=item I<_CountSuccess()> + +Add 1 to the count of successful assertions in the current counter frame. + +=item I<_PopAssertionCounter()> + +Remove the current assertion counter, and return a list of the number of +assertions run, and the number of assertions which succeeded. + +=item I<_PushAssertionCounter()> + +Add a pair of assertion counters to the stack. Assertion counters are used +to count assertion runs/successes, and this adds a level in case of +recursive runTests() calls. + +=back + +=head2 Protected Functions + +=over 4 + +=item I<_prepSuite( @tests )> + +Split the specified array of test hashrefs into three arrays: setupFuncs, +tests, and teardownFuncs. Return references to the three arrays. + +=item I<_runTests( \@setupFuncs, \@tests, \@teardownFuncs )> + +Run the specified I, running any I before each one, and +any I after each one. + +=back + +=head2 Skip Functions + +=over 4 + +=item I + +Skip all the remaining tests, optionally outputting a message as to why the +they were skipped. + +=item I + +Skip the rest of this test, optionally outputting a message as to why the +rest of the test was skipped. + +=back + +=head2 Test Data Functions + +=over 4 + +=item I + +Load key/data pairs from a data file that was saved from previous +tests. Returns a reference to a hash of data items. + +=item I + +Save the key/value pairs in I<%datahash> to a file with the specified +I for later loading via loadTestData(). + +=back + +=cut + diff --git a/t/00_require.t b/t/00_require.t new file mode 100644 index 0000000..926d0b9 --- /dev/null +++ b/t/00_require.t @@ -0,0 +1,34 @@ +#!/usr/bin/perl +# +# Test script for Test::SimpleUnit (require) +# $Id: 00_require.t,v 1.2 2002/03/29 23:41:49 deveiant Exp $ +# +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' +# +# Please do not commit any changes you make to the module without a +# successful 'make test'! +# +package main; +use strict; + +BEGIN { $| = 1; use vars qw{$LoadedOkay} } +END { print "1..1\nnot ok 1\n" unless $LoadedOkay; } + +### Load up the test framework +require Test::SimpleUnit; + +### Test suite (in the order they're run) +my @testSuite = ( + { + name => 'Require', + test => sub { + $LoadedOkay = 1; + }, + }, + +); + +Test::SimpleUnit::runTests( @testSuite ); + + diff --git a/t/01_importAll.t b/t/01_importAll.t new file mode 100644 index 0000000..720383d --- /dev/null +++ b/t/01_importAll.t @@ -0,0 +1,36 @@ +#!/usr/bin/perl +# +# Test script for Test::SimpleUnit (import functions) +# $Id: 01_importAll.t,v 1.2 2002/03/29 23:41:49 deveiant Exp $ +# +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl t/01_import.t' +# +# Please do not commit any changes you make to the module without a +# successful 'make test'! +# +package main; +use strict; + +BEGIN { $| = 1; } + +### Load up the test framework +use Test::SimpleUnit qw{:functions}; + +sub genTest { + my $functionName = shift; + return { + name => $functionName, + test => sub { + no strict 'refs'; + die "$functionName() was not imported" unless defined *{"main::${functionName}"}{CODE}; + }, + }; +} + +### Generate a test suite out of the list of exported functions for the +### 'functions' tag +my @testSuite = map { s{^&}{}; genTest $_ } @{$Test::SimpleUnit::EXPORT_TAGS{functions}}; +Test::SimpleUnit::runTests( @testSuite ); + + diff --git a/t/02_importAsserts.t b/t/02_importAsserts.t new file mode 100644 index 0000000..b374ceb --- /dev/null +++ b/t/02_importAsserts.t @@ -0,0 +1,36 @@ +#!/usr/bin/perl +# +# Test script for Test::SimpleUnit (import functions) +# $Id: 02_importAsserts.t,v 1.3 2002/03/29 23:41:49 deveiant Exp $ +# +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl t/01_import.t' +# +# Please do not commit any changes you make to the module without a +# successful 'make test'! +# +package main; +use strict; + +BEGIN { $| = 1; } + +### Load up the test framework +use Test::SimpleUnit qw{:asserts}; + +sub genTest { + my $functionName = shift; + return { + name => $functionName, + test => sub { + no strict 'refs'; + die "$functionName() was not imported" unless defined *{"main::${functionName}"}{CODE}; + }, + }; +} + +### Generate a test suite out of the list of exported functions for the +### 'functions' tag +my @testSuite = map { s{^&}{}; genTest $_ } @{$Test::SimpleUnit::EXPORT_TAGS{asserts}}; +Test::SimpleUnit::runTests( @testSuite ); + + diff --git a/t/03_importTfuncs.t b/t/03_importTfuncs.t new file mode 100644 index 0000000..fd7f2da --- /dev/null +++ b/t/03_importTfuncs.t @@ -0,0 +1,36 @@ +#!/usr/bin/perl +# +# Test script for Test::SimpleUnit (import functions) +# $Id: 03_importTfuncs.t,v 1.2 2002/03/29 23:41:49 deveiant Exp $ +# +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl t/01_import.t' +# +# Please do not commit any changes you make to the module without a +# successful 'make test'! +# +package main; +use strict; + +BEGIN { $| = 1; } + +### Load up the test framework +use Test::SimpleUnit qw{:testFunctions}; + +sub genTest { + my $functionName = shift; + return { + name => $functionName, + test => sub { + no strict 'refs'; + die "$functionName() was not imported" unless defined *{"main::${functionName}"}{CODE}; + }, + }; +} + +### Generate a test suite out of the list of exported functions for the +### 'functions' tag +my @testSuite = map { s{^&}{}; genTest $_ } @{$Test::SimpleUnit::EXPORT_TAGS{testFunctions}}; +Test::SimpleUnit::runTests( @testSuite ); + + diff --git a/t/04_importSkips.t b/t/04_importSkips.t new file mode 100644 index 0000000..271222e --- /dev/null +++ b/t/04_importSkips.t @@ -0,0 +1,36 @@ +#!/usr/bin/perl +# +# Test script for Test::SimpleUnit (import skip functions) +# $Id: 04_importSkips.t,v 1.2 2002/03/29 23:41:49 deveiant Exp $ +# +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl t/01_import.t' +# +# Please do not commit any changes you make to the module without a +# successful 'make test'! +# +package main; +use strict; + +BEGIN { $| = 1; } + +### Load up the test framework +use Test::SimpleUnit qw{:skips}; + +sub genTest { + my $functionName = shift; + return { + name => $functionName, + test => sub { + no strict 'refs'; + die "$functionName() was not imported" unless defined *{"main::${functionName}"}{CODE}; + }, + }; +} + +### Generate a test suite out of the list of exported functions for the +### 'functions' tag +my @testSuite = map { s{^&}{}; genTest $_ } @{$Test::SimpleUnit::EXPORT_TAGS{skips}}; +Test::SimpleUnit::runTests( @testSuite ); + + diff --git a/t/05_importTestData.t b/t/05_importTestData.t new file mode 100644 index 0000000..278d7ca --- /dev/null +++ b/t/05_importTestData.t @@ -0,0 +1,36 @@ +#!/usr/bin/perl +# +# Test script for Test::SimpleUnit +# $Id: 05_importTestData.t,v 1.1 2003/01/15 20:46:44 deveiant Exp $ +# +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl 05_importTestData.t' +# +# Please do not commit any changes you make to the module without a +# successful 'make test'! +# +package main; +use strict; + +BEGIN { $| = 1; } + +### Load up the test framework +use Test::SimpleUnit qw{:testdata}; + +sub genTest { + my $functionName = shift; + return { + name => $functionName, + test => sub { + no strict 'refs'; + die "$functionName() was not imported" unless defined *{"main::${functionName}"}{CODE}; + }, + }; +} + +### Generate a test suite out of the list of exported functions for the +### 'functions' tag +my @testSuite = map { s{^&}{}; genTest $_ } @{$Test::SimpleUnit::EXPORT_TAGS{testdata}}; +Test::SimpleUnit::runTests( @testSuite ); + + diff --git a/t/10_asserts.t b/t/10_asserts.t new file mode 100644 index 0000000..5ea4d0c --- /dev/null +++ b/t/10_asserts.t @@ -0,0 +1,482 @@ +#!/usr/bin/perl +# +# Test script for Test::SimpleUnit (import functions) +# $Id: 10_asserts.t,v 1.4 2002/04/08 18:50:24 deveiant Exp $ +# +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl t/01_import.t' +# +# Please do not commit any changes you make to the module without a +# successful 'make test'! +# + +# Packages for testing OO asserts +package ClassA; +sub new {return bless {}, $_[0]} + +package ClassB; +use base qw{ClassA}; + +package ClassC; +use base qw{ClassB}; + +# Main testing package +package main; +use strict; + +BEGIN { $| = 1; } + +### Load up the test framework +use Test::SimpleUnit qw{:asserts}; + +my @testSuite = ( + + # Test the basic assert() function + { + name => 'Assert', + test => sub { + # Assert( true ) + eval { assert(1); }; + die "Failed assert(1): $@" if $@; + + # Assert( false ) + eval { assert(0); }; + die "assert(0) unexpectedly succeeded." unless $@; + die "Unexpected error message for assert(0): $@ (expected '0')" + unless "$@" =~ m{0}; + + # Assert( false ) with message + eval { assert(0, "message test") }; + die "assert(0,msg) unexpectedly succeeded." unless $@; + die "Unexpected error message for assert(0): $@ (expected 'message test')" + unless "$@" =~ m{message test}; + }, + }, + + # Test assertNot() + { + name => 'AssertNot', + test => sub { + # assertNot( 0 ) + eval { assertNot(0); }; + die "Failed assertNot(0): $@" if $@; + + # assertNot( "" ) + eval { assertNot(""); }; + die "Failed assertNot(\"\"): $@" if $@; + + # assertNot( undef ) + eval { assertNot(undef); }; + die "Failed assertNot(undef): $@" if $@; + + # assertNot( 1 ) + eval { assertNot(1); }; + die "assertNot(1) unexpectedly succeeded." unless $@; + die "Unexpected error message for assertNot(1): $@ (expected 'Expected a false value, got \"1\"')" + unless "$@" =~ m{Expected a false value, got '1'}; + + # AssertNot( false ) with message + eval { assertNot(1, "message test") }; + die "assertNot(1,msg) unexpectedly succeeded." unless $@; + die "Unexpected error message for assertNot(0): $@ (expected 'message test')" + unless "$@" =~ m{message test}; + }, + }, + + # Test assertDefined() + { + name => 'AssertDefined', + test => sub { + # assertDefined( 0 ) + eval { assertDefined(0); }; + die "Failed assertDefined(0): $@" if $@; + + # assertDefined( "" ) + eval { assertDefined(""); }; + die "Failed assertDefined(\"\"): $@" if $@; + + # assertDefined( undef ) + eval { assertDefined(undef); }; + die "assertDefined(undef) unexpectedly succeeded." unless $@; + die "Unexpected error message for assertDefined(undef): $@ ", + "(expected 'Expected a defined value, got an undef')" + unless "$@" =~ m{Expected a defined value, got an undef}; + + # AssertDefined( undef ) with message + eval { assertDefined(undef, "message test") }; + die "assertDefined(undef,msg) unexpectedly succeeded." unless $@; + die "Unexpected error message for assertDefined(undef,msg): $@ ", + "(expected 'message test')" + unless "$@" =~ m{message test}; + }, + }, + + # Test assertUndef() + { + name => 'AssertUndef', + test => sub { + # assertUndef( undef ) + eval { assertUndef(undef); }; + die "Failed assertUndef(undef): $@" if $@; + + # assertUndef( undef ) + eval { assertUndef(1); }; + die "assertUndef(1) unexpectedly succeeded." unless $@; + die "Unexpected error message for assertUndef(1): $@ ", + "(expected 'Expected an undefined value, got '1'')" + unless "$@" =~ m{Expected an undefined value, got '1'}; + + # AssertUndef( undef ) with message + eval { assertUndef(1, "message test") }; + die "assertUndef(1,msg) unexpectedly succeeded." unless $@; + die "Unexpected error message for assertUndef(1,msg): $@ ", + "(expected 'message test')" + unless "$@" =~ m{message test}; + }, + }, + + # Test assertException() + { + name => 'AssertException', + test => sub { + my $res; + + # assertException { die "test" } + $res = eval { assertException {die "test"}; }; + die "Failed assertException {die \"test\"}: $@" if $@; + assert( $res ); + undef $res; + + # assertException { 1 } + eval { assertException {1} }; + die "assertException unexpectedly succeeded" unless $@; + die "Unexpected error message for assertException {1}: $@ ", + "(expected 'No exception raised.')" + unless "$@" =~ m{No exception raised\.}; + + # assertException { 1 }, $msg + eval { assertException {1} "Ack! No exception?"; }; + die "assertException unexpectedly succeeded" unless $@; + die "Unexpected error message for assertException {1}: $@ ", + "(expected 'Ack! No exception?')" + unless "$@" =~ m{Ack! No exception\?}; + }, + }, + + # Test assertExceptionType() + { + name => 'AssertExceptionType', + test => sub { + + # assertExceptionType { die "test" } + eval { assertExceptionType {die bless ["test"], 'test'} 'test'; }; + die "Failed assertExceptionType {die bless [\"test\"], 'test'} 'test': $@" if $@; + + # assertExceptionType { 1 } + eval { assertExceptionType {1} 'any' }; + die "assertExceptionType unexpectedly succeeded" unless $@; + die "Unexpected error message for assertExceptionType {1} 'any': $@ ", + "(expected 'Expected an exception of type 'any', but none was raised. at ", + "blib/lib/Test/SimpleUnit.pm line...')" + unless "$@" =~ m{Expected an exception of type 'any', but none was raised\.}; + + # assertExceptionType { 1 }, $msg + eval { assertExceptionType {1} 'any', "Ack! No exception?"; }; + die "assertExceptionType unexpectedly succeeded" unless $@; + die "Unexpected error message for assertExceptionType {1} 'any', \"Ack! No exception?\": $@ ", + "(expected 'Ack! No exception?')" + unless "$@" =~ m{Ack! No exception\?}; + }, + }, + + # Test assertExceptionMatch() + { + name => 'AssertExceptionMatches', + test => sub { + + # Match a die() + eval { assertExceptionMatches {die "Just testing"} qr{test}i; }; + die "Failed assertExceptionMatches {die \"Just testing\"} qr{test}i: $@" if $@; + + # assertExceptionMatches { 1 } 'any' + eval { assertExceptionMatches {1} qr{any} }; + die "assertExceptionMatches unexpectedly succeeded" unless $@; + die "Unexpected error message for assertExceptionMatches {1} qr{any}: $@ ", + "(expected 'Expected an exception which matched /(?-xism:any)/, but none ", + "was raised.')" + unless "$@" =~ m{Expected an exception which matched \Q/(?-xism:any)/\E, but none was raised\.}; + + # assertExceptionMatches { 1 } 'any', $msg + eval { assertExceptionMatches {1} 'any', "Ack! No exception?"; }; + die "assertExceptionMatches unexpectedly succeeded" unless $@; + die "Unexpected error message for assertExceptionMatches {1} 'any', \"Ack! No exception?\": $@ ", + "(expected 'Ack! No exception?')" + unless "$@" =~ m{Ack! No exception\?}; + }, + }, + + # Test assertNoException() + { + name => 'AssertNoException', + test => sub { + my $res; + my $file = __FILE__; + my $line; + + # assertNoException { 1 } + $res = eval { assertNoException {1}; }; + die "Failed assertNoException {1}: $@" if $@; + assert( $res ); + undef $res; + + # assertNoException { die "test" } + $line = __LINE__ + 1; + eval { assertNoException {die "test"} }; + die "assertNoException unexpectedly succeeded" unless $@; + die "Unexpected error message for assertNoException {die \"test\"}: $@ ", + "(expected 'Exception raised: test at $file line $line')" + unless "$@" =~ m{Exception raised: test at $file line $line}; + + # assertNoException { die "test" }, $msg + eval { assertNoException {die "test"} "Ack! Exception raised!"; }; + die "assertNoException unexpectedly succeeded" unless $@; + die "Unexpected error message for assertNoException {die \"test\"}: $@ ", + "(expected 'Ack! Exception raised!')" + unless "$@" =~ m{Ack! Exception raised!}; + }, + }, + + # Test assertEquals() + { + name => 'AssertEquals', + test => sub { + my $res; + + # assertEquals( 1, 1 ) + assertNoException { $res = assertEquals( 1, 1 ) }; + assert( $res ); + undef $res; + + # assertEquals( 1, "1" ) + assertNoException { $res = assertEquals( 1, "1" ) }; + assert( $res ); + undef $res; + + # assertEquals( "this", "this" ) + assertNoException { $res = assertEquals( "this", "this" ) }; + assert( $res ); + undef $res; + + # assertEquals( undef, undef ) + assertNoException { $res = assertEquals( undef, undef ) }; + assert( $res ); + undef $res; + + # assertEquals( 1, 2 ) + assertExceptionMatches { $res = assertEquals(1, 2) } qr{Wanted '1', got '2' instead}; + assertNot( $res ); + undef $res; + + # assertEquals( 1, 1.1 ) + assertExceptionMatches { $res = assertEquals(1, 1.1) } qr{Wanted '1', got '1.1' instead}; + assertNot( $res ); + undef $res; + + }, + }, + + # Test assertMatches() + { + name => 'AssertMatches', + test => sub { + my $res; + + # assertMatches( '\d+', 1 ) + assertNoException { $res = assertMatches( '\d+', 1 ) }; + assert( $res ); + undef $res; + + # assertMatches( qr{\d+}, 1 ) + assertNoException { $res = assertMatches( qr{\d+}, 1 ) }; + assert( $res ); + undef $res; + + # assertMatches( qr{\s+}, " 1" ) + assertNoException { $res = assertMatches( qr{\s+}, " 1" ) }; + assert( $res ); + undef $res; + + # assertMatches( qr{\s+}, 1 ) + assertExceptionMatches { + $res = assertMatches( qr{\s+}, 1 ) + } qr{Tested value '1' did not match wanted regex '\Q(?-xism:\s+)\E}; + assertNot( $res ); + undef $res; + }, + }, + + # Test assertRef() + { + name => 'AssertRef', + test => sub { + my $res; + + assertNoException { $res = assertRef('HASH', {}) }; + assert( $res ); + undef $res; + + assertNoException { $res = assertRef('GLOB', \*STDIN) }; + assert( $res ); + undef $res; + + assertNoException { $res = assertRef('ARRAY', []) }; + assert( $res ); + undef $res; + + assertNoException { $res = assertRef('SCALAR', \"something") }; + assert( $res ); + undef $res; + + assertNoException { $res = assertRef('ClassA', ClassA->new) }; + assert( $res ); + undef $res; + + assertException { $res = assertRef('HASH', 'something') }; + assertMatches( qr{Expected a HASH value, got a scalar}, $@ ); + assertNot( $res ); + undef $res; + + assertException { $res = assertRef('HASH', undef) }; + assertMatches( qr{Expected a HASH value, got a undefined value}, $@ ); + assertNot( $res ); + undef $res; + + assertException { $res = assertRef('HASH', []) }; + assertMatches( qr{Expected a HASH value, got a ARRAY}, $@ ); + assertNot( $res ); + undef $res; + + assertException { $res = assertRef('ClassA', []) }; + assertMatches( qr{Expected a ClassA value, got a ARRAY}, $@ ); + assertNot( $res ); + undef $res; + + }, + }, + + + # Test assertInstanceOf() + { + name => 'AssertInstanceOf', + test => sub { + my ( $res, $aInstance, $bInstance, $cInstance ); + + $aInstance = ClassA->new; + $bInstance = ClassB->new; + $cInstance = ClassC->new; + + # aInstance should be only a ClassA object... + assertException { assertInstanceOf('ClassB', $aInstance) }; + assertMatches qr{Expected an instance of 'ClassB', got an instance of 'ClassA'}, $@; + assertException { assertInstanceOf('ClassC', $aInstance) }; + assertMatches qr{Expected an instance of 'ClassC', got an instance of 'ClassA'}, $@; + assertNoException { assertInstanceOf('ClassA', $aInstance) }; + + # bInstance should be only a ClassB object + assertException { assertInstanceOf('ClassA', $bInstance) }; + assertMatches qr{Expected an instance of 'ClassA', got an instance of 'ClassB'}, $@; + assertException { assertInstanceOf('ClassC', $bInstance) }; + assertMatches qr{Expected an instance of 'ClassC', got an instance of 'ClassB'}, $@; + assertNoException { assertInstanceOf('ClassB', $bInstance) }; + + # cInstance should be only a ClassC object + assertException { assertInstanceOf('ClassA', $cInstance) }; + assertMatches qr{Expected an instance of 'ClassA', got an instance of 'ClassC'}, $@; + assertException { assertInstanceOf('ClassB', $cInstance) }; + assertMatches qr{Expected an instance of 'ClassB', got an instance of 'ClassC'}, $@; + assertNoException { assertInstanceOf('ClassC', $cInstance) }; + + # A simple scalar shouldn't even make the ->isa() test + assertException { assertInstanceOf('ClassA', "something") }; + assertMatches( qr{Expected an instance of 'ClassA', got a non-object \Q('something')\E}, $@ ); + + # Neither should a plain (unblessed) reference + assertException { assertInstanceOf('ClassA', []) }; + assertMatches( qr{Expected an instance of 'ClassA', got a non-object \('ARRAY\(0x\w+\)'\)}, $@ ); + + }, + }, + + # Test assertKindOf() + { + name => 'AssertKindOf', + test => sub { + my ( $res, $aInstance, $bInstance, $cInstance ); + + $aInstance = ClassA->new; + $bInstance = ClassB->new; + $cInstance = ClassC->new; + + # aInstance should be an ClassA object... + assertNoException { $res = assertKindOf('ClassA', $aInstance) }; + assert( $res ); + undef $res; + + # bInstance should be both a ClassA and a ClassB object + assertNoException { $res = assertKindOf('ClassA', $bInstance) }; + assert( $res ); + undef $res; + + assertNoException { $res = assertKindOf('ClassB', $bInstance) }; + assert( $res ); + undef $res; + + # cInstance should be all three + assertNoException { $res = assertKindOf('ClassA', $cInstance) }; + assert( $res ); + undef $res; + + assertNoException { $res = assertKindOf('ClassB', $cInstance) }; + assert( $res ); + undef $res; + + assertNoException { $res = assertKindOf('ClassC', $cInstance) }; + assert( $res ); + undef $res; + + # But aInstance should be neither a B nor a C + assertException { $res = assertKindOf('ClassB', $aInstance) }; + assertMatches( qr{Expected an instance of 'ClassB' or a subclass, got an instance of 'ClassA'}, $@ ); + assertNot( $res ); + undef $res; + + assertException { $res = assertKindOf('ClassC', $aInstance) }; + assertMatches( qr{Expected an instance of 'ClassC' or a subclass, got an instance of 'ClassA'}, $@ ); + assertNot( $res ); + undef $res; + + # Neither should bInstance be a C + assertException { $res = assertKindOf('ClassC', $bInstance) }; + assertMatches( qr{Expected an instance of 'ClassC' or a subclass, got an instance of 'ClassB'}, $@ ); + assertNot( $res ); + undef $res; + + # A simple scalar shouldn't even make the ->isa() test + assertException { $res = assertKindOf('ClassA', "something") }; + assertMatches( qr{Expected an instance of 'ClassA' or a subclass, got a non-object \Q('something')\E}, $@ ); + assertNot( $res ); + undef $res; + + # Neither should a plain (unblessed) reference + assertException { $res = assertKindOf('ClassA', []) }; + assertMatches( qr{Expected an instance of 'ClassA' or a subclass, got a non-object \('ARRAY\(0x\w+\)'\)}, $@ ); + assertNot( $res ); + undef $res; + + }, + }, +); + +Test::SimpleUnit::runTests( @testSuite ); + + diff --git a/t/11_skips.t b/t/11_skips.t new file mode 100644 index 0000000..6672cd0 --- /dev/null +++ b/t/11_skips.t @@ -0,0 +1,97 @@ +#!/usr/bin/perl +# +# Test script for Test::SimpleUnit +# $Id: 11_skips.t,v 1.3 2002/04/15 19:54:35 deveiant Exp $ +# +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl 05_skip.t' +# +# Please do not commit any changes you make to the module without a +# successful 'make test'! +# +package main; +use strict; + +BEGIN { $| = 1; } + +### Load up the test framework +use Test::SimpleUnit qw{:functions}; + + +### Test suite (in the order they're run) +my @testSuite = ( + + { + name => 'Autoskip setting', + test => sub { + # Backwards compat + assertNoException { Test::SimpleUnit->AutoskipFailedSetup(1) }; + assert Test::SimpleUnit::AutoskipFailedSetup(); + + assertNoException { Test::SimpleUnit::AutoskipFailedSetup(0) }; + assertNot Test::SimpleUnit::AutoskipFailedSetup(); + }, + }, + + { + name => 'Skip one (no message)', + test => sub { + eval { skipOne }; + assertInstanceOf 'SKIPONE', $@; + }, + }, + + { + name => 'Skip one (with message)', + test => sub { + eval { skipOne "Testing" }; + assertInstanceOf 'SKIPONE', $@; + assertEquals "Testing", ${$@}; + }, + }, + + { + name => 'Real skip one', + test => sub { + skipOne "Passed."; + fail "Test wasn't skipped."; + }, + }, + + { + name => 'Skip all (no message)', + test => sub { + eval { skipAll }; + assertInstanceOf 'SKIPALL', $@; + }, + }, + + { + name => 'Skip all (with message)', + test => sub { + eval { skipAll "Testing" }; + assertInstanceOf 'SKIPALL', $@; + assertEquals "Testing", ${$@}; + }, + }, + + { + name => 'Real skip all', + test => sub { + skipAll "Passed."; + fail "Immediate test body wasn't skipped by skipAll."; + }, + }, + + { + name => 'Should be skipped', + test => sub { + fail "Following test body wasn't skipped by skipAll."; + }, + }, + + +); + +runTests( @testSuite ); + diff --git a/t/12_testdata.t b/t/12_testdata.t new file mode 100644 index 0000000..80f8205 --- /dev/null +++ b/t/12_testdata.t @@ -0,0 +1,87 @@ +#!/usr/bin/perl +# +# Test script for Test::SimpleUnit +# $Id: 12_testdata.t,v 1.1 2003/01/15 20:46:44 deveiant Exp $ +# +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl 10_testdata.t' +# +# Please do not commit any changes you make to the module without a +# successful 'make test'! +# +package main; +use strict; + +BEGIN { $| = 1; } + +### Load up the test framework +use Test::SimpleUnit qw{:functions}; + +my ( + $filename, + %testData, + ); + + +### Test suite (in the order they're run) +my @testSuite = ( + + ### Setup/Teardown functions + { + name => 'setup', + func => sub { + $filename = "12testdata.$$"; + %testData = ( + some => 'data', + for => "testing", + complex => [qw{an arrayref }], + hoh => { + more => 'keys', + and => 'vals', + another => {}, + }, + ); + }, + }, + + { + name => 'teardown', + func => sub { + $filename = ''; + %testData = (); + }, + }, + + + ### Save the test data + { + name => 'savedata', + test => sub { + Test::SimpleUnit::Debug( 1 ); + assertNoException { + saveTestData( $filename, %testData ); + }; + assert -f $filename; + }, + }, + + ### Load the test data back up and compare it with the original + { + name => 'loaddata', + test => sub { + my $datahash; + + Test::SimpleUnit::Debug( 1 ); + assertNoException { + $datahash = loadTestData( $filename ); + }; + assertRef 'HASH', $datahash; + assertEquals \%testData, $datahash; + }, + }, + + +); + +runTests( @testSuite ); + diff --git a/t/15_setupteardown.t b/t/15_setupteardown.t new file mode 100644 index 0000000..3736357 --- /dev/null +++ b/t/15_setupteardown.t @@ -0,0 +1,230 @@ +#!/usr/bin/perl +# +# Test script for Test::SimpleUnit +# $Id: 15_setupteardown.t,v 1.4 2003/01/15 20:48:07 deveiant Exp $ +# +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl 07_setupteardown.t' +# +# Please do not commit any changes you make to the module without a +# successful 'make test'! +# +package main; +use strict; + +BEGIN { $| = 1; } + +### Load up the test framework +use Test::SimpleUnit qw{:functions}; + +#Test::SimpleUnit::Debug( 1 ); + +my %setupRuns = (); +my %teardownRuns = (); + + +### Test suite (in the order they're run) +my @testSuite = ( + + ### Plain setup + + # First setup function + { + name => 'setup', + func => sub { + $setupRuns{first}++; + }, + }, + + # Test to make sure the setup ran + { + name => 'test first setup', + test => sub { + assertEquals 1, $setupRuns{first}; + }, + }, + + ### Overridden setup + + # Override the first setup with this, the second one + { + name => 'setup', + test => sub { + $setupRuns{second}++; + }, + }, + + # Test to be sure the two setup functions have run exactly once each + { + name => 'test second setup', + test => sub { + assertEquals 1, $setupRuns{first}; + assertEquals 1, $setupRuns{second}; + }, + }, + + # Test to be sure the first setup has still only run once, but that the + # second has now run twice + { + name => 'test second setup again', + test => sub { + assertEquals 1, $setupRuns{first}; + assertEquals 2, $setupRuns{second}; + }, + }, + + + ### Assure all setups run at least once + + # Override the second setup with this, the third one, but then clobber this + # one with a fourth. This one should only be run once. + { + name => 'setup', + test => sub { + $setupRuns{third}++; + }, + }, + + # Override the third setup with this, the fourth one. + { + name => 'setup', + test => sub { + $setupRuns{fourth}++; + }, + }, + + # Test to be sure the first has now run once, the second twice, the third + # once, and the fourth one once. + { + name => 'test third and fourth setup (1st run)', + test => sub { + assertEquals 1, $setupRuns{first}; + assertEquals 2, $setupRuns{second}; + assertEquals 1, $setupRuns{third}; + assertEquals 1, $setupRuns{fourth}; + }, + }, + + # Test again to be sure the first has now run once, the second twice, the + # third still only once, and the fourth two times. + { + name => 'test third and fourth setup (2nd run)', + test => sub { + assertEquals 1, $setupRuns{first}; + assertEquals 2, $setupRuns{second}; + assertEquals 1, $setupRuns{third}; + assertEquals 2, $setupRuns{fourth}; + }, + }, + + + ### Now do the same thing for teardown functions + + # First teardown function + { + name => 'teardown', + func => sub { + $teardownRuns{first}++; + }, + }, + + # Test to make sure the teardown hasn't yet run, but will in the second test. + { + name => 'test first teardown (pre-run)', + test => sub { + assertNot exists $teardownRuns{first}; + }, + }, + + # Test to make sure the teardown hasn't yet run, but will in the second test. + { + name => 'test first teardown (post-run)', + test => sub { + assertEquals 1, $teardownRuns{first}; + }, + }, + + + ### Overridden teardown + + # Override the first teardown with this, the second one + { + name => 'teardown', + test => sub { + $teardownRuns{second}++; + }, + }, + + # Test the second teardown, pre-run + { + name => 'test second teardown', + test => sub { + assertEquals 2, $teardownRuns{first}; + assertNot exists $teardownRuns{second}; + }, + }, + + # Test the second teardown, post-run + { + name => 'test second teardown', + test => sub { + assertEquals 2, $teardownRuns{first}; + assertEquals 1, $teardownRuns{second}; + }, + }, + + + + ### Assure all teardowns run at least once + + # Override the second teardown with this, the third one, but then clobber this + # one with a fourth. This one should then only be run once. + { + name => 'teardown', + test => sub { + $teardownRuns{third}++; + }, + }, + + # Override the third teardown with this, the fourth one. + { + name => 'teardown', + test => sub { + $teardownRuns{fourth}++; + }, + }, + + # Bogus test for the third and fourth teardown, pre-run + { + name => 'test third and fourth teardown (pre-run)', + test => sub { 1 }, + }, + + # Test to be sure the first has now run once, the second twice, and the + # third and fourth once each. + { + name => 'test third and fourth teardown (1st run)', + test => sub { + assertEquals 2, $teardownRuns{first}; + assertEquals 2, $teardownRuns{second}; + assertEquals 1, $teardownRuns{third}; + assertEquals 1, $teardownRuns{fourth}; + }, + }, + + # Now make sure the third test has still only run once, but the fourth + # should have run a second time. + { + name => 'test third and fourth teardown (2nd run)', + test => sub { + assertEquals 2, $teardownRuns{first}; + assertEquals 2, $teardownRuns{second}; + assertEquals 1, $teardownRuns{third}; + assertEquals 2, $teardownRuns{fourth}; + }, + }, + +); + +runTests( @testSuite ); + diff --git a/t/20_emptysuite.t b/t/20_emptysuite.t new file mode 100644 index 0000000..3922c33 --- /dev/null +++ b/t/20_emptysuite.t @@ -0,0 +1,40 @@ +#!/usr/bin/perl +# +# Test script for Test::SimpleUnit +# $Id: 20_emptysuite.t,v 1.1 2002/04/23 22:01:34 deveiant Exp $ +# +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl 08_emptysuite.t' +# +# Please do not commit any changes you make to the module without a +# successful 'make test'! +# +package main; +use strict; + +BEGIN { $| = 1; } + +### Load up the test framework +use Test::SimpleUnit qw{:functions}; + + +### Test an empty test suite -- used to fail because the setup and teardown +### tests are spliced out. Should now just skip gracefully. +my @testSuite = ( + + { + name => 'setup', + func => sub { + }, + }, + + { + name => 'teardown', + func => sub { + }, + }, + +); + +runTests( @testSuite ); + diff --git a/t/30_bugs.t b/t/30_bugs.t new file mode 100644 index 0000000..6373822 --- /dev/null +++ b/t/30_bugs.t @@ -0,0 +1,60 @@ +#!/usr/bin/perl +# +# Test script for fixed bugs that don't need their own suite +# $Id: 30_bugs.t,v 1.1 2002/05/14 02:59:02 deveiant Exp $ +# +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl 09_bugs.t' +# +# Please do not commit any changes you make to the module without a +# successful 'make test'! +# +package main; +use strict; + +BEGIN { $| = 1; } + +### Load up the test framework +use Test::SimpleUnit qw{:functions}; +use IO::Handle; +use IO::File; + +#$Test::SimpleUnit::Debug = 1; + +# Get a reference to stdout so we can switch it off for recursive tests +my $Stdout = IO::Handle->new_from_fd( fileno STDOUT, 'w' ) + or die "Ack: STDOUT doesn't exist"; +my $DummyIO = new IO::File '/dev/null', 'w'; + +### Test suite (in the order they're run) +my @testSuite = ( + + # Can't use string ("") as a subroutine ref while "strict refs" in use at + # /usr/lib/perl5/site_perl/5.6.1/Test/SimpleUnit.pm line 665. + { + name => 'Missing "test" key-val pair', + test => sub { + assertNoException { + Test::SimpleUnit::OutputHandle( $DummyIO ); + runTests({ name => 'subtest' }); + Test::SimpleUnit::OutputHandle(); + }; + }, + }, + + # Error related to the above one: Test isn't a coderef. + { + name => 'non-coderef value in "test" key-val pair', + test => sub { + assertNoException { + Test::SimpleUnit::OutputHandle( $DummyIO ); + runTests({ name => 'subtest', test => {} }); + Test::SimpleUnit::OutputHandle(); + }; + }, + }, + +); + +runTests( @testSuite ); +