[svn-inject] Installing original source of libtest-inter-perl
Chris Butler
14 years ago
| 0 | use Module::Build; | |
| 1 | use strict; | |
| 2 | use warnings; | |
| 3 | ||
| 4 | my %requires = ( | |
| 5 | 'perl' => '5.004', | |
| 6 | 'File::Basename' => '0', | |
| 7 | 'IO::File' => '0', | |
| 8 | ); | |
| 9 | my %build_mods = ( | |
| 10 | 'Test::Pod' => '0', | |
| 11 | 'Test::Pod::Coverage' => '0', | |
| 12 | ); | |
| 13 | ||
| 14 | ||
| 15 | my $build = Module::Build->new( | |
| 16 | license => 'perl', | |
| 17 | dist_version => '1.01', | |
| 18 | dist_author => 'Sullivan Beck <sbeck@cpan.org>', | |
| 19 | module_name => 'Test::Inter', | |
| 20 | dist_abstract => 'framework for more readable interactive test scripts', | |
| 21 | requires => \%requires, | |
| 22 | build_requires => {}, | |
| 23 | build_recommends => \%build_mods, | |
| 24 | sign => 1, | |
| 25 | ); | |
| 26 | ||
| 27 | $build->create_build_script; |
| 0 | ||
| 1 | Version 1.00 2010-04-29 | |
| 2 | Initial release. | |
| 3 | ||
| 4 | Version 1.01 2010-04-29 | |
| 5 | Use File::Basename and IO::File to get rid of two unix dependencies. | |
| 6 |
| 0 | For instructions on installing this, or any other perl module in | |
| 1 | a UNIX environment, please refer to: | |
| 2 | ||
| 3 | http://faq.perl.org/perlfaq8.html#How_do_I_install_a_m | |
| 4 | ||
| 5 | For instructions in a Windows environment running ActivePerl, | |
| 6 | refer to one of the following (depending on your version of perl): | |
| 7 | ||
| 8 | http://docs.activestate.com/activeperl/5.6/faq/ActivePerl-faq2.html | |
| 9 | http://docs.activestate.com/activeperl/5.8/faq/ActivePerl-faq2.html | |
| 10 | http://docs.activestate.com/activeperl/5.10/faq/ActivePerl-faq2.html |
| 0 | This module is free software; you can redistribute it and/or | |
| 1 | modify it under the same terms as Perl itself. | |
| 2 |
| 0 | Build.PL | |
| 1 | ChangeLog | |
| 2 | examples/is | |
| 3 | examples/ok | |
| 4 | examples/plan | |
| 5 | examples/tests | |
| 6 | examples/use_ok | |
| 7 | INSTALL | |
| 8 | lib/Test/Inter.pm | |
| 9 | lib/Test/Inter.pod | |
| 10 | LICENSE | |
| 11 | Makefile.PL | |
| 12 | MANIFEST This list of files | |
| 13 | README | |
| 14 | t/file.1.exp | |
| 15 | t/file.2.exp | |
| 16 | t/file.2.in | |
| 17 | t/file.t | |
| 18 | t/is.t | |
| 19 | t/ok.t | |
| 20 | t/pod.t | |
| 21 | t/pod_coverage.t | |
| 22 | t/require_ok.t | |
| 23 | t/runtests | |
| 24 | t/runtests.bat | |
| 25 | t/skip_all.t | |
| 26 | t/tests.t | |
| 27 | t/use_ok.1.t | |
| 28 | t/use_ok.2.t | |
| 29 | t/use_ok.3.t | |
| 30 | TODO | |
| 31 | META.yml |
| 0 | --- | |
| 1 | abstract: 'framework for more readable interactive test scripts' | |
| 2 | author: | |
| 3 | - 'Sullivan Beck <sbeck@cpan.org>' | |
| 4 | configure_requires: | |
| 5 | Module::Build: 0.36 | |
| 6 | generated_by: 'Module::Build version 0.3603' | |
| 7 | license: perl | |
| 8 | meta-spec: | |
| 9 | url: http://module-build.sourceforge.net/META-spec-v1.4.html | |
| 10 | version: 1.4 | |
| 11 | name: Test-Inter | |
| 12 | provides: | |
| 13 | Test::Inter: | |
| 14 | file: lib/Test/Inter.pm | |
| 15 | version: 1.01 | |
| 16 | requires: | |
| 17 | File::Basename: 0 | |
| 18 | IO::File: 0 | |
| 19 | perl: 5.004 | |
| 20 | resources: | |
| 21 | license: http://dev.perl.org/licenses/ | |
| 22 | version: 1.01 |
| 0 | ||
| 1 | use ExtUtils::MakeMaker; | |
| 2 | use 5.004; | |
| 3 | use strict; | |
| 4 | use warnings; | |
| 5 | my %requires = ( | |
| 6 | 'File::Basename' => '0', | |
| 7 | 'IO::File' => '0', | |
| 8 | 'Test::Pod' => '0', | |
| 9 | 'Test::Pod::Coverage' => '0', | |
| 10 | ); | |
| 11 | ||
| 12 | ||
| 13 | WriteMakefile( | |
| 14 | NAME => 'Test::Inter', | |
| 15 | VERSION => '1.01', | |
| 16 | ($] >= 5.004 | |
| 17 | ? (ABSTRACT=>'framework for more readable interactive test scripts', | |
| 18 | AUTHOR =>'Sullivan Beck (sbeck@cpan.org)') | |
| 19 | : ()), | |
| 20 | 'dist' => {COMPRESS=>'gzip',SUFFIX=>'gz'}, | |
| 21 | PL_FILES => {}, | |
| 22 | PREREQ_PM => \%requires, | |
| 23 | ); |
| 0 | NAME | |
| 1 | Test::Inter - framework for more readable interactive test scripts | |
| 2 | ||
| 3 | DESCRIPTION | |
| 4 | This is another framework for writing test scripts. It is loosely | |
| 5 | inspired by Test::More, and has most of it's functionality, but it is | |
| 6 | not a drop-in replacement. | |
| 7 | ||
| 8 | Test::More (and other existing test frameworks) suffer from two | |
| 9 | weaknesses, both of which have prevented me from ever using them: | |
| 10 | ||
| 11 | None offer the ability to access specific tests in | |
| 12 | a reasonably interactive fashion | |
| 13 | ||
| 14 | None offer the ability to write the tests in | |
| 15 | whatever format would make the tests the most | |
| 16 | readable | |
| 17 | ||
| 18 | The way I write and use test scripts, existing Test::* modules are not | |
| 19 | nearly as useful as they could be. Test scripts written using Test::More | |
| 20 | work fine when running as part of the test suite, but debugging an | |
| 21 | individual test requires extra steps, and the tests themselves are not | |
| 22 | as readable as they should be. | |
| 23 | ||
| 24 | I do most of my debugging using test scripts. When I find a bug, I write | |
| 25 | a test case for it, debug it using the test script, and then leave the | |
| 26 | test there so the bug won't come back (hopefully). | |
| 27 | ||
| 28 | Since I use test scripts in two ways (part of a standard test suite and | |
| 29 | to run the scripts in some interactive way to debug problems), I want to | |
| 30 | be able to do the follwing trivially: | |
| 31 | ||
| 32 | Easy access to a specific test or tests | |
| 33 | If I'm running the test script interactively (perhaps in the | |
| 34 | debugger), there are several common functions that I want to have | |
| 35 | available, including: | |
| 36 | ||
| 37 | Run only a single test, or a subset of tests | |
| 38 | ||
| 39 | Set a breakpoint in the debugger to run | |
| 40 | up to the start of the Nth test | |
| 41 | ||
| 42 | Better diagnostics | |
| 43 | When running a test script as part of a test suite, the pass/fail | |
| 44 | status is really the only thing of interest. You just want to know | |
| 45 | if the module passes all the tests. | |
| 46 | ||
| 47 | When running interactively, additional information may allow me to | |
| 48 | quickly track down the problem without even resorting to a debugger. | |
| 49 | ||
| 50 | If a test fails, I almost always want to see why it failed if I'm | |
| 51 | running it interactively. If reasonable, I want to see a list of | |
| 52 | what was input, what was output, and what was expected. | |
| 53 | ||
| 54 | The other feature that I wanted in a test suite is the ability to define | |
| 55 | the tests in a readable format. In almost every case, it is best to | |
| 56 | think of a test script as consisting of two separate parts: a script | |
| 57 | part, and a test part, and the more you can keep the two separate, the | |
| 58 | better. | |
| 59 | ||
| 60 | The script part of a test script is the least important part! It's | |
| 61 | usually fairly trivial, rarely needs to be changed, and is quite simply | |
| 62 | not the focus of the test script. | |
| 63 | ||
| 64 | The tests part of the script IS the important part, and these should be | |
| 65 | expressed in a form that is easy to maintain, easy to read, and easy to | |
| 66 | modify, and none of these should involve modifying the script portion of | |
| 67 | the test script in general. As a general rule, if the script portion of | |
| 68 | the test script obscures the tests in any way, it's not written | |
| 69 | correctly! | |
| 70 | ||
| 71 | Compare this to any other systems where you are mixing two "languages". | |
| 72 | For example, a PHP script where you have a mixture of PHP and HTML or a | |
| 73 | templating system consisting of text and template commands. The more the | |
| 74 | two languages are interwoven, the less readable both are, and the harder | |
| 75 | it is to maintain. | |
| 76 | ||
| 77 | As often as possible, I want the tests to be written in some sort of | |
| 78 | text format which can be easily read as a table with no perl commands | |
| 79 | interspersed. I want to the freedom to define the tests in one big | |
| 80 | string (perhaps a DATA section, or even in a separate file) which is | |
| 81 | easily readable. This may introduce the necessity of parsing it, but it | |
| 82 | makes it significantly easier to maintain the tests. | |
| 83 | ||
| 84 | This flexibilty makes it much easier to read the tests (as opposed to | |
| 85 | the script) which is the fundamental content of a test script. | |
| 86 | ||
| 87 | To illustrate some of this, in Test::More, a series of tests might be | |
| 88 | specified as: | |
| 89 | ||
| 90 | # test 1 | |
| 91 | $result = func("apples","bushels"); | |
| 92 | is($result, "enough"); | |
| 93 | ||
| 94 | # test 2 | |
| 95 | $result = func("grapefruit","tons"); | |
| 96 | is($result, "enough"); | |
| 97 | ||
| 98 | # test 3 | |
| 99 | $result = func("oranges","boatloads"); | |
| 100 | is($result, "insufficient"); | |
| 101 | ||
| 102 | Thinking about the features I want that I listed above, there are | |
| 103 | several difficulties with this. | |
| 104 | ||
| 105 | Debugging the script is tedious | |
| 106 | To debug the 3rd test, I've got to do the following steps: | |
| 107 | ||
| 108 | get the line number of the 3rd func call | |
| 109 | set a breakpoint for it | |
| 110 | run the program | |
| 111 | wait for the first two tests to complete | |
| 112 | step into the function | |
| 113 | ||
| 114 | None of these steps are hard of course, but even so, getting to the | |
| 115 | first line of the test requires several steps which tend to break up | |
| 116 | your chain of thought when you want to be thinking exclusively about | |
| 117 | debugging the test. | |
| 118 | ||
| 119 | How much better to be able to say: | |
| 120 | ||
| 121 | break in func when testnum==3 | |
| 122 | ||
| 123 | Way too much perl interspersed with the tests | |
| 124 | It's difficult to read the tests individually in this script because | |
| 125 | there is too much perl code among them, and virtually impossible to | |
| 126 | look at them as a whole. | |
| 127 | ||
| 128 | It is true that looking at this as a perl script, it is very | |
| 129 | simple... but the script ISN'T the content you're interested in. The | |
| 130 | REAL content of this script are the tests, which consist of the | |
| 131 | function arguments and the expected result. Although it's not | |
| 132 | impossible to see each of these in the script above, it's not in a | |
| 133 | format that is conducive to studying the tests, and especially not | |
| 134 | for examing the list of tests as a whole. | |
| 135 | ||
| 136 | Now, look at an alternate way of specifying the tests using this module: | |
| 137 | ||
| 138 | $tests = " | |
| 139 | ||
| 140 | apples bushels => enough | |
| 141 | ||
| 142 | grapefruit tons => enough | |
| 143 | ||
| 144 | oranges boatloads => insufficient | |
| 145 | ||
| 146 | "; | |
| 147 | ||
| 148 | $o->tests(tests => $tests, | |
| 149 | func => \&func); | |
| 150 | ||
| 151 | Here, it's easy to see the list of tests, and adding additional tests is | |
| 152 | a breeze. | |
| 153 | ||
| 154 | This module supports a number of methods for defining tests, so you can | |
| 155 | use whichever one is most convenient (including methods that are | |
| 156 | identical to Test::More). | |
| 157 | ||
| 158 | In addition, the following debugger command works as desired: | |
| 159 | ||
| 160 | b func ($::TI_NUM==3) | |
| 161 | ||
| 162 | and you're ready to debug. | |
| 163 | ||
| 164 | CREATING A TEST | |
| 165 | Every test may have several pieces of information: | |
| 166 | ||
| 167 | A name | |
| 168 | Every test is automatically assigned a number, but it may be useful | |
| 169 | to specify a name of a test (which is actually a short description | |
| 170 | of the test). Whenever a test result is reported, the name will be | |
| 171 | given (if one was specified). | |
| 172 | ||
| 173 | The name may not have a '#' in it. | |
| 174 | ||
| 175 | The name is completely optional, but makes the results more | |
| 176 | readable. | |
| 177 | ||
| 178 | An expected result | |
| 179 | In order to test something, you need to know what result was | |
| 180 | expected (or in some cases, what result was NOT expected). | |
| 181 | ||
| 182 | A function and arguments OR a result | |
| 183 | You also need to know the results that you're comparing to the | |
| 184 | expected results. | |
| 185 | ||
| 186 | This can be obtained by simply working with a set of results, or a | |
| 187 | function name and a set of arguments to pass to it. | |
| 188 | ||
| 189 | Conditions | |
| 190 | It is useful to be able to specify state information at the start of | |
| 191 | the test suite (for example, to see if certain features are | |
| 192 | available), and some tests may only run if those conditions are met. | |
| 193 | ||
| 194 | If no conditions are set for a test, it will always run. | |
| 195 | ||
| 196 | Todo tests | |
| 197 | Some tests may be marked as 'todo' tests. These are test which are | |
| 198 | allowed to fail (meaning that they have been put in place for an | |
| 199 | as-yet unimplemented feature). Since it is expected that the test | |
| 200 | will fail, the test suite will still pass, even if these tests fail. | |
| 201 | ||
| 202 | The tests will still run and if they pass, a message is issued | |
| 203 | saying that the feature is now implemented, and the tests should be | |
| 204 | graduated to non-todo state. | |
| 205 | ||
| 206 | BASE METHODS | |
| 207 | new | |
| 208 | $o = new Test::Inter [$name] [%options]; | |
| 209 | ||
| 210 | This creates a new test framework. There are several options which | |
| 211 | may be used to specify which tests are run, how they are run, and | |
| 212 | what output is given. | |
| 213 | ||
| 214 | The entire test script can be named by passing in $name. Options can | |
| 215 | be passed in as a hash of ($opt,$val) pairs. | |
| 216 | ||
| 217 | Options can be set in four different ways. First, you can pass in an | |
| 218 | ($opt,$val) pair in the new method. Second, you can set an | |
| 219 | environment variable (which overrides any value passed to the new | |
| 220 | method). Third, you can set a global variable (which overrides both | |
| 221 | the environment variable and options passed to the new method). | |
| 222 | Fouth, you can call the appropriate method to set the option. This | |
| 223 | overrides all other methods. | |
| 224 | ||
| 225 | Each of the allowed options are described below in the following | |
| 226 | base methods: | |
| 227 | ||
| 228 | start | |
| 229 | end | |
| 230 | test | |
| 231 | plan | |
| 232 | abort | |
| 233 | quiet | |
| 234 | mode | |
| 235 | skip_all | |
| 236 | ||
| 237 | version | |
| 238 | $o->version(); | |
| 239 | ||
| 240 | Returns the version of the module. | |
| 241 | ||
| 242 | start | |
| 243 | $o = new Test::Inter 'start' => $N; | |
| 244 | $o->start($N) | |
| 245 | ||
| 246 | To define which test you want to start with, pass in an ($opt,$val) | |
| 247 | pair of ('start',N), set an environment variable TI_START=N, or a | |
| 248 | global variable $::TI_START=N. | |
| 249 | ||
| 250 | When the start test is defined, most tests numbered less than N are | |
| 251 | completely ignored. If the tests are being run quietly (see the | |
| 252 | quiet method below), nothing is printed out for these tests. | |
| 253 | Otherwise, a skip message is printed out. | |
| 254 | ||
| 255 | One class of tests IS still executed. Tests run using the require_ok | |
| 256 | or use_ok methods (to test the loading of modules) are still run. | |
| 257 | ||
| 258 | If no value (or a value of 0) is used, it defaults to the first | |
| 259 | test. | |
| 260 | ||
| 261 | end | |
| 262 | $o = new Test::Inter 'end' => $M; | |
| 263 | $o->end($M); | |
| 264 | ||
| 265 | To define which test you want to end with, pass in an ($opt,$val) | |
| 266 | pair of ('end',M), set an environment variable TI_END=M, or set a | |
| 267 | global variable $::TI_END=M. | |
| 268 | ||
| 269 | When the end test is defined, all tests numbered more than M are | |
| 270 | completely ignored. If the tests are being run quietly (see the | |
| 271 | quiet method below), nothing is printed out for these tests. | |
| 272 | Otherwise, a skip message is printed out. | |
| 273 | ||
| 274 | If no value is given, it defaults to 0 (which means that all | |
| 275 | reamining tests are run). | |
| 276 | ||
| 277 | testnum | |
| 278 | $o = new Test::Inter 'testnum' => $N; | |
| 279 | $o->testnum($N); | |
| 280 | ||
| 281 | This is used to run only a single test. It is equivalent to setting | |
| 282 | both the start and end tests to $N. | |
| 283 | ||
| 284 | plan | |
| 285 | done_testing | |
| 286 | $o = new Test::Inter 'plan' => $N; | |
| 287 | $o->plan($n); | |
| 288 | ||
| 289 | $o->done_testing(); | |
| 290 | $o->done_testing($n); | |
| 291 | ||
| 292 | The TAP API (the 'language' used to run a sequence of tests and see | |
| 293 | which ones failed and which ones passedd) requires a statement of | |
| 294 | the number of tests that are expected to run. | |
| 295 | ||
| 296 | This statement can appear at the start of the test suite, or at the | |
| 297 | end. | |
| 298 | ||
| 299 | If you know in advance how many tests should run in the test script, | |
| 300 | you can pass in a non-zero integer in a ('plan',N) pair to the new | |
| 301 | method, or set the TI_PLAN environment variable or the $::TI_PLAN | |
| 302 | global variable, or call the plan method. | |
| 303 | ||
| 304 | If you know how many tests should run at the end of the test script, | |
| 305 | you can pass in a non-zero integer to the done_testing method. | |
| 306 | ||
| 307 | Frequently, you don't really care how many tests are in the script | |
| 308 | (especially if new tests are added on a regular basis). In this | |
| 309 | case, you still need to include a statement that says that the | |
| 310 | number of tests expected is however many were run. To do this, call | |
| 311 | the done_testing method with no argument. | |
| 312 | ||
| 313 | NOTE: if the plan method is used, it MUST be used before any tests | |
| 314 | are run (including those that test the loading of modules). If the | |
| 315 | done_testing method is used, it MUST be called after all tests are | |
| 316 | run. You must specify a plan or use a done_testing statement, but | |
| 317 | you cannot do both. | |
| 318 | ||
| 319 | It is NOT strictly required to set a plan if the script is only run | |
| 320 | interactively, so if for some reason this module is used for test | |
| 321 | scritps which are not part of a standard perl test suite, the plan | |
| 322 | and done_testing statements are optional. As a matter of fact, the | |
| 323 | script will run just fine without them... but a perl installer will | |
| 324 | report a failure in the test suite. | |
| 325 | ||
| 326 | abort | |
| 327 | $o = new Test::Inter 'abort' => 0/1/2; | |
| 328 | $o->abort(0/1/2); | |
| 329 | ||
| 330 | The abort option can be set using an ('abort',0/1/2) option pair, or | |
| 331 | by setting the TI_ABORT environment variable, or the $::TI_ABORT | |
| 332 | global variable. | |
| 333 | ||
| 334 | If this is set to 1, the test script will run unmodified until a | |
| 335 | test fails. At that point, all remaining tests will be skipped. If | |
| 336 | it is set to 2, the test script will run until a test fails at which | |
| 337 | point it will exit with an error code of 1. | |
| 338 | ||
| 339 | In both cases, todo tests will NOT trigger the abort behavior. | |
| 340 | ||
| 341 | quiet | |
| 342 | $o = new Test::Inter 'quiet' => 0/1/2; | |
| 343 | $o->quiet(0/1/2); | |
| 344 | ||
| 345 | The quiet option can be set using an ('quiet',0/1/2) option pair, or | |
| 346 | by setting the TI_QUIET environment variable, or the $::TI_QUIET | |
| 347 | global variable. | |
| 348 | ||
| 349 | If this is set to 0 (the default), all information will be printed | |
| 350 | out. If it is set to 1, some optional information will not be | |
| 351 | printed. If it is set to 2, all optional information will not be | |
| 352 | printed. | |
| 353 | ||
| 354 | mode | |
| 355 | $o = new Test::Inter 'mode' => MODE; | |
| 356 | $o->mode(MODE); | |
| 357 | ||
| 358 | The mode option can be set using a ('mode',MODE) option pair, or by | |
| 359 | setting the TI_MODE environment variable, or the $::TI_MODE global | |
| 360 | variable. | |
| 361 | ||
| 362 | Currently, MODE can be 'test' or 'inter' meaning that the script is | |
| 363 | run as part of a test suite, or interactively. | |
| 364 | ||
| 365 | When run in test mode, it prints out the results using the TAP | |
| 366 | grammar (i.e. 'ok 1', 'not ok 3', etc.). | |
| 367 | ||
| 368 | When run in interactive mode, it prints out results in a more human | |
| 369 | readable format. | |
| 370 | ||
| 371 | skip_all | |
| 372 | $o = new Test::Inter 'skip_all' => REASON; | |
| 373 | $o->skip_all(REASON); | |
| 374 | ||
| 375 | The skip_all option can be set using an ('skip_all',REASON) option | |
| 376 | pair, or by setting the TI_SKIP_ALL environment variable, or the | |
| 377 | $::TI_SKIP_ALL global variable. | |
| 378 | ||
| 379 | If this is set, the entire test script will be skipped for the | |
| 380 | reason given. This must be done before any test is run, and before | |
| 381 | any plan number is set. | |
| 382 | ||
| 383 | The skip_all can also be called at any point during the script (i.e. | |
| 384 | after tests have been run). In this case, all remaining scripts will | |
| 385 | be skipped. | |
| 386 | ||
| 387 | $o->skip_all(REASON,FEATURE,FEATURE,...); | |
| 388 | $o->skip_all('',FEATURE,FEATURE,...); | |
| 389 | ||
| 390 | This will skip all tests (or all remaining tests) unless all | |
| 391 | features are available. REASON can be entered as an empty string and | |
| 392 | the reason the tests are skipped will be a message about the missing | |
| 393 | feature. | |
| 394 | ||
| 395 | feature | |
| 396 | $o->feature($feature,$val); | |
| 397 | ||
| 398 | This defines a feature. If $val is non-zero, the feature is | |
| 399 | available. Otherwise it is not. | |
| 400 | ||
| 401 | diag | |
| 402 | note | |
| 403 | $o->diag($message); | |
| 404 | $o->note($message); | |
| 405 | ||
| 406 | Both of these print an optional message. Messages printed with the | |
| 407 | note method are always optional and will be omitted if the quiet | |
| 408 | option is set to 1 or 2. Messages printed with the diag method are | |
| 409 | optional and will not be printed if the quiet option is set to 2, | |
| 410 | but they will be printed if the quiet method is set to 1. | |
| 411 | ||
| 412 | testdir | |
| 413 | Occasionally, it may be necessary to know the directory where the | |
| 414 | tests live (for example, there may be a config or data file in | |
| 415 | there). This method will return the directory. | |
| 416 | ||
| 417 | METHODS FOR LOADING MODULES | |
| 418 | Test scripts can load other modules (using either the perl 'use' or | |
| 419 | 'require' commands). There are three different modes for doing this | |
| 420 | which determine how this is done. | |
| 421 | ||
| 422 | required mode | |
| 423 | By default, this is used to test for a module that is required for | |
| 424 | all tests in the test script. | |
| 425 | ||
| 426 | Loading the module is treated as an actual test in the test suite. | |
| 427 | The test is to determine whether the module is available and can be | |
| 428 | loaded. If it can be loaded, it is, and it is reported as a | |
| 429 | successful test. If it cannot be loaded, it is reported as a failed | |
| 430 | test. | |
| 431 | ||
| 432 | In the result of a failed test, all remaining tests will be skipped | |
| 433 | automatically (except for other tests which load modules). | |
| 434 | ||
| 435 | feature mode | |
| 436 | In feature mode, loading the module is not treated as a test (i.e. | |
| 437 | it will not print out an 'ok' or 'not ok' line. Instead, it will set | |
| 438 | a feature (named the same as the module) which can be used to | |
| 439 | determine whether other tests should run or not. | |
| 440 | ||
| 441 | forbid mode | |
| 442 | In a few very rare cases, we may want to test for a module but | |
| 443 | expect that it not be present. This is the exact opposite of the | |
| 444 | 'required' mode. | |
| 445 | ||
| 446 | Successfully loading the module is treated as a test failure. In the | |
| 447 | event of a failure, all remaining tests will be skipped. | |
| 448 | ||
| 449 | The methods available are: | |
| 450 | ||
| 451 | require_ok | |
| 452 | $o->require_ok($module [,$mode]); | |
| 453 | ||
| 454 | This is used to load a module using the perl 'require' function. If | |
| 455 | $mode is not passed in, the default mode (required) is used to test | |
| 456 | the existance of the module. | |
| 457 | ||
| 458 | If $mode is passed in, it must be either the string 'forbid' or | |
| 459 | 'feature'. | |
| 460 | ||
| 461 | use_ok | |
| 462 | $o->use_ok(@args [,$mode]); | |
| 463 | ||
| 464 | This is used to load a module with 'use', or check a perl version. | |
| 465 | ||
| 466 | BEGIN { $o->use_ok('5.010'); } | |
| 467 | BEGIN { $o->use_ok('Some::Module'); } | |
| 468 | BEGIN { $o->use_ok('Some::Module',2.05); } | |
| 469 | BEGIN { $o->use_ok('Some::Module','foo','bar'); } | |
| 470 | BEGIN { $o->use_ok('Some::Module',2.05,'foo','bar'); } | |
| 471 | ||
| 472 | are the same as: | |
| 473 | ||
| 474 | use 5.010; | |
| 475 | use Some::Module; | |
| 476 | use Some::Module 2.05; | |
| 477 | use Some::Module qw(foo bar); | |
| 478 | use Some::Module 2.05 qw(foo bar); | |
| 479 | ||
| 480 | Putting the use_ok call in a BEGIN block allows the functions to be | |
| 481 | imported at compile-time and prototypes are properly honored. You'll | |
| 482 | also need to load the Test::Inter module, and create the object in a | |
| 483 | BEGIN block. | |
| 484 | ||
| 485 | $mode acts the same as in the require_ok method. | |
| 486 | ||
| 487 | METHODS FOR RUNNING TEST | |
| 488 | There are several methods for running tests. The ok, is, and isnt | |
| 489 | methods are included for those already comfortable with Test::More and | |
| 490 | wishing to stick with the same format of test script. The tests method | |
| 491 | is the suggested method though since it makes use of the full power of | |
| 492 | this module. | |
| 493 | ||
| 494 | ok | |
| 495 | $o->ok(TESTS); | |
| 496 | ||
| 497 | A test run with ok looks at a result, and if it evaluates to 0 (or | |
| 498 | false), it fails. If it evaluates to non-zero (or true), it passes. | |
| 499 | ||
| 500 | These tests do not require you to specify the expected results. If | |
| 501 | expected results are given, they will be compared against the result | |
| 502 | received, and if they differ, a diagnostic message will be printed, | |
| 503 | but the test will still succeed or fail based only on the actual | |
| 504 | result produced. | |
| 505 | ||
| 506 | These tests require a single result and either zero or one expected | |
| 507 | results. | |
| 508 | ||
| 509 | To run a single test, use any of the following: | |
| 510 | ||
| 511 | $o->ok(); # always succeeds | |
| 512 | ||
| 513 | $o->ok($result); | |
| 514 | $o->ok($result,$name); | |
| 515 | $o->ok($result,$expected,$name); | |
| 516 | ||
| 517 | $o->ok(\&func); | |
| 518 | $o->ok(\&func,$name); | |
| 519 | $o->ok(\&func,$expected,$name); | |
| 520 | ||
| 521 | $o->ok(\&func,\@args); | |
| 522 | $o->ok(\&func,\@args,$name); | |
| 523 | $o->ok(\&func,\@args,$expected,$name); | |
| 524 | ||
| 525 | If $result is a scalar, the test passes if $result is true. If | |
| 526 | $result is a list reference, and the list is either empty, or the | |
| 527 | first element is a scalar), the test succeeds if the list contains | |
| 528 | any values (except for undef). If $result is a hash reference, the | |
| 529 | test succeeds if the hash contains any key with a value that is not | |
| 530 | undef. | |
| 531 | ||
| 532 | If \&func and \@args are passed in, then $result is generated by | |
| 533 | passing @args to &func and behaves identically to the calls where | |
| 534 | $result is passed in. If \&func is passed in but no arguments, the | |
| 535 | function takes no arguments, but still produces a result. | |
| 536 | ||
| 537 | $result may be a scalar, list reference, or hash reference. If it is | |
| 538 | a list reference, the test passes is the list contains any defined | |
| 539 | values. If it is a hash reference, the test passes if any of the | |
| 540 | keys contain defined values. | |
| 541 | ||
| 542 | If an expected value is passed in and the result does not match it, | |
| 543 | a diagnostic warning will be printed, even if the test passes. | |
| 544 | ||
| 545 | is | |
| 546 | isnt | |
| 547 | $o->is(TESTS); | |
| 548 | $o->isnt(TESTS); | |
| 549 | ||
| 550 | A test run with is looks as a result and tests to see if it is | |
| 551 | identical to an expected result. If it is, the test passes. | |
| 552 | Otherwise it fails. In the case of a failure, a diagnostic message | |
| 553 | will show what result was actually obtained and what was expected. | |
| 554 | ||
| 555 | A test run with isnt looks at a result and tests to see if the | |
| 556 | result obtained is different than an expected result. If it is | |
| 557 | different, the test passes. Otherwise it fails. | |
| 558 | ||
| 559 | The is method can be called in any of the following ways: | |
| 560 | ||
| 561 | $o->is($result,$expected); | |
| 562 | $o->is($result,$expected,$name); | |
| 563 | ||
| 564 | $o->is(\&func,$expected); | |
| 565 | $o->is(\&func,$expected,$name); | |
| 566 | ||
| 567 | $o->is(\&func,\@args,$expected); | |
| 568 | $o->is(\&func,\@args,$expected,$name); | |
| 569 | ||
| 570 | The isnt method can be called in exactly the same way. | |
| 571 | ||
| 572 | As with the ok method, the result can be a scalar, hashref, or | |
| 573 | listref. If it is a hashref or listref, the entire structure must | |
| 574 | match the expected value. | |
| 575 | ||
| 576 | tests | |
| 577 | $o->tests($opt=>$val, $opt=>$val, ...) | |
| 578 | ||
| 579 | The options available are described in the following section. | |
| 580 | ||
| 581 | file | |
| 582 | $o->file($func,$input,$outputdir,$expected,$name [,@args]); | |
| 583 | ||
| 584 | Sometimes it may be easiest to store the input, output, and expected | |
| 585 | output from a series of tests in files. In this case, each line of | |
| 586 | output will be treated as a single test, so the output and expected | |
| 587 | output must match up exactly. | |
| 588 | ||
| 589 | $func is a reference to a function which will produce a temporary | |
| 590 | output file. If $input is specified, it is the name of the input | |
| 591 | file, and it will be passed to the function as the first argument. | |
| 592 | If $input is left blank, no input file will be used. The input file | |
| 593 | may be specified as a full path, or just the file name (in which | |
| 594 | case it will be looked for in the test directory and the current | |
| 595 | directory). | |
| 596 | ||
| 597 | $func also takes a arequired argument which is the output file. The | |
| 598 | tests method will create a tempoary file containing the output. If | |
| 599 | $outputdir is passed in, it is the directory where the output file | |
| 600 | will be written. If $outputdir is left blank, the temporary file | |
| 601 | will be written to the test directory. | |
| 602 | ||
| 603 | If @args is passed in, it is a list of additional arguments which | |
| 604 | will be passed to $func. | |
| 605 | ||
| 606 | $expected is the name of a file which contains the expeccted output. | |
| 607 | It can be fully specified, or it will be checked for in the test | |
| 608 | directory. | |
| 609 | ||
| 610 | USING THE TESTS METHOD | |
| 611 | It is expected that most tests (except for those that load a module) | |
| 612 | will be run using the tests method called as: | |
| 613 | ||
| 614 | $o->tests($opt => $val, $opt => $val, ...); | |
| 615 | ||
| 616 | The following options are available: | |
| 617 | ||
| 618 | name | |
| 619 | name => NAME | |
| 620 | ||
| 621 | This sets the name of this set of tests. All tests will be given the | |
| 622 | same name. | |
| 623 | ||
| 624 | tests | |
| 625 | func | |
| 626 | expected | |
| 627 | In order to specify a series of tests, you have to specify either a | |
| 628 | function and a list of arguments, or a list of results. | |
| 629 | ||
| 630 | Specifying the function and list of arguments can be done using the | |
| 631 | pair: | |
| 632 | ||
| 633 | func => \&FUNCTION | |
| 634 | tests => TESTS | |
| 635 | ||
| 636 | If the func option is not set, tests contains a list of results. | |
| 637 | ||
| 638 | A list of expected results may also be given. They can be included | |
| 639 | in the | |
| 640 | ||
| 641 | tests => TESTS | |
| 642 | ||
| 643 | option or included separately as: | |
| 644 | ||
| 645 | expected => RESULTS | |
| 646 | ||
| 647 | The way to specify these are covered in the next section SPECIFYING | |
| 648 | THE TESTS. | |
| 649 | ||
| 650 | feature | |
| 651 | disable | |
| 652 | feature => [FEATURE1, FEATURE2, ...] | |
| 653 | ||
| 654 | disable => [FEATURE1, FEATURE2, ...] | |
| 655 | ||
| 656 | The default set of tests to run is determined using the start, end, | |
| 657 | and skip_all methods discussed above. Using those methods, a list of | |
| 658 | tests is obtained, and it is expected that these will run. | |
| 659 | ||
| 660 | The feature and disable options modify the list. | |
| 661 | ||
| 662 | If the feature option is included, the tests given in this call will | |
| 663 | only run if ALL of the features listed are available. | |
| 664 | ||
| 665 | If the disable option is included, the tests will be run unless ANY | |
| 666 | of the features listed are available. | |
| 667 | ||
| 668 | skip | |
| 669 | skip => REASON | |
| 670 | ||
| 671 | Skip these tests for the reason given. | |
| 672 | ||
| 673 | todo | |
| 674 | todo => 0/1 | |
| 675 | ||
| 676 | Setting this to 1 says that these tests are allowed to fail. They | |
| 677 | represent a feature that is not yet implemented. | |
| 678 | ||
| 679 | If the tests succeed, a message will be printed notifying the | |
| 680 | developer that the tests are now ready to promote to actual use. | |
| 681 | ||
| 682 | SPECIFYING THE TESTS | |
| 683 | A series of tests can be specified in two different ways. The tests can | |
| 684 | be written in a very simple string format, or stored as a list. | |
| 685 | ||
| 686 | Demonstrating how this can be done is best done by example, so let's say | |
| 687 | that there is a function (func) which takes two arguments, and returns a | |
| 688 | single value. Let's say that the expected output (and the actual output) | |
| 689 | from 3 different sets of arguments is: | |
| 690 | ||
| 691 | Input Expected Output Actual Output | |
| 692 | ----- --------------- ------------- | |
| 693 | 1,2 a a | |
| 694 | 3,4 b x | |
| 695 | 5,6 c c | |
| 696 | ||
| 697 | (so in this case, the first and third tests pass, but the 2nd one will | |
| 698 | fail). | |
| 699 | ||
| 700 | Specifying these tests as lists could be done as: | |
| 701 | ||
| 702 | $o->tests( | |
| 703 | func => &func, | |
| 704 | tests => [ [1,2], [3,4], [5,6] ], | |
| 705 | expected => [ [a], [b], [c] ], | |
| 706 | ); | |
| 707 | ||
| 708 | Here, the tests are stored as a list, and each element in the list is a | |
| 709 | listref containing the set of arguments. | |
| 710 | ||
| 711 | If the func option is not passed in, the tests option is set to a list | |
| 712 | of results to compare with the expected results, so the following is | |
| 713 | equivalent to the above: | |
| 714 | ||
| 715 | $o->tests( | |
| 716 | tests => [ [a], [x], [c] ], | |
| 717 | expected => [ [a], [b], [c] ], | |
| 718 | ); | |
| 719 | ||
| 720 | If an argument (or actual result) or an expected result is only a single | |
| 721 | value, it can be entered as a scalar instead of a list ref, so the | |
| 722 | following is also equivalent: | |
| 723 | ||
| 724 | $o->tests( | |
| 725 | func => &func, | |
| 726 | tests => [ [1,2], [3,4], [5,6] ], | |
| 727 | expected => [ a, b, [c] ], | |
| 728 | ); | |
| 729 | ||
| 730 | The only exception to this is if the single value is itself a list | |
| 731 | reference. In this case it MUST be included as a reference. In other | |
| 732 | words, if you have a single test, and the expected value for this test | |
| 733 | is a list reference, it must be passed in as: | |
| 734 | ||
| 735 | expected => [ [ \@r ] ] | |
| 736 | ||
| 737 | NOT as: | |
| 738 | ||
| 739 | expected => [ \@r ] | |
| 740 | ||
| 741 | Passing in a set of expected results is optional. If none are passed in, | |
| 742 | the tests are treated as if they had been passed to the 'ok' method | |
| 743 | (i.e. if they return something true, they pass, otherwise they fail). | |
| 744 | ||
| 745 | The second way to specify tests is as a string. The string is a | |
| 746 | multi-line string with each tests being separate from the next test by a | |
| 747 | blank line. Comments (lines which begin with '#') are allowed, and are | |
| 748 | ignored. Whitespace at the start and end of the line is ignored. | |
| 749 | ||
| 750 | The string may contain the results directly, or results may be passed in | |
| 751 | separately. For example, the following all give the same sets of tests | |
| 752 | as the example above: | |
| 753 | ||
| 754 | $o->tests( | |
| 755 | func => &func, | |
| 756 | tests => " | |
| 757 | # Test 1 | |
| 758 | 1 2 => a | |
| 759 | ||
| 760 | # Test 2 | |
| 761 | 3 4 => b | |
| 762 | ||
| 763 | 5 6 => c | |
| 764 | ", | |
| 765 | ); | |
| 766 | ||
| 767 | $o->tests( | |
| 768 | func => &func, | |
| 769 | tests => " | |
| 770 | 1 2 | |
| 771 | ||
| 772 | 3 4 | |
| 773 | ||
| 774 | 5 6 | |
| 775 | ", | |
| 776 | expected => [ [a], [b], [c] ] | |
| 777 | ); | |
| 778 | ||
| 779 | $o->tests( | |
| 780 | func => &func, | |
| 781 | tests => [ [1,2], [3,4], [5,6] ], | |
| 782 | expected => " | |
| 783 | a | |
| 784 | ||
| 785 | b | |
| 786 | ||
| 787 | c | |
| 788 | ", | |
| 789 | ); | |
| 790 | ||
| 791 | $o->tests( | |
| 792 | func => &func, | |
| 793 | tests => " | |
| 794 | 1 2 | |
| 795 | ||
| 796 | 3 4 | |
| 797 | ||
| 798 | 5 6 | |
| 799 | ", | |
| 800 | expected => " | |
| 801 | a | |
| 802 | ||
| 803 | b | |
| 804 | ||
| 805 | c | |
| 806 | ", | |
| 807 | ); | |
| 808 | ||
| 809 | The expected results may also consist of only a single set of results | |
| 810 | (in this case, it must be passed in as a listref). In this case, all of | |
| 811 | the tests are expected to have the same results. | |
| 812 | ||
| 813 | So, the following are equivalent: | |
| 814 | ||
| 815 | $o->tests( | |
| 816 | func => &func, | |
| 817 | tests => " | |
| 818 | 1 2 => a b | |
| 819 | ||
| 820 | 3 4 => a b | |
| 821 | ||
| 822 | 5 6 => a b | |
| 823 | ", | |
| 824 | ); | |
| 825 | ||
| 826 | $o->tests( | |
| 827 | func => &func, | |
| 828 | tests => " | |
| 829 | 1 2 | |
| 830 | ||
| 831 | 3 4 | |
| 832 | ||
| 833 | 5 6 | |
| 834 | ", | |
| 835 | expected => [ [a, b] ], | |
| 836 | ); | |
| 837 | ||
| 838 | $o->tests( | |
| 839 | func => &func, | |
| 840 | tests => " | |
| 841 | 1 2 | |
| 842 | ||
| 843 | 3 4 | |
| 844 | ||
| 845 | 5 6 | |
| 846 | ", | |
| 847 | expected => "a b", | |
| 848 | ); | |
| 849 | ||
| 850 | The number of expected values must either be 1 (i.e. all of the tests | |
| 851 | are expected to produce the same value) or exactly the same number as | |
| 852 | the number of tests. | |
| 853 | ||
| 854 | The parser is actually quite powerful, and can handle multi-line tests, | |
| 855 | quoted strings, and nested data structures. | |
| 856 | ||
| 857 | The test may be split across any number of lines, provided there is not | |
| 858 | a completely blank line (which signals the end of the test), so the | |
| 859 | following are eqivalent: | |
| 860 | ||
| 861 | tests => "a b c", | |
| 862 | tests => "a b | |
| 863 | c", | |
| 864 | ||
| 865 | Arguments (or expected results) may include data structures. For | |
| 866 | example, the following are equivalent: | |
| 867 | ||
| 868 | tests => "[ a b ] { a 1 b 2 }" | |
| 869 | tests => [ [ [a,b], { a=>1, b=>2 } ] ] | |
| 870 | ||
| 871 | Whitespace is mostly optional, but there is one exception. An item must | |
| 872 | end with some kind of delimiter, so the following will fail: | |
| 873 | ||
| 874 | tests => "[a b][c d]" | |
| 875 | ||
| 876 | The first element (the list ref [a b]) must be separated from the second | |
| 877 | element by the delimiter (which is whitespace in this case), so it must | |
| 878 | be written as: | |
| 879 | ||
| 880 | tests => "[a b] [c d]" | |
| 881 | ||
| 882 | As already demonstrated, hashrefs and listrefs may be included and | |
| 883 | nested. Elements may also be included inside parens, but this is | |
| 884 | optional since all arguments and expected results are already treated as | |
| 885 | lists, so the following are equivalent: | |
| 886 | ||
| 887 | tests => "a b c" | |
| 888 | tests => "(a b) c" | |
| 889 | ||
| 890 | Although parens are optional, they may make things more readable, and | |
| 891 | allow you to use something other than whitespsace as the delimiter. | |
| 892 | ||
| 893 | If the character immediately following the opening paren, brace, or | |
| 894 | bracket is a punctuation mark, then it is used as the delimiter instead | |
| 895 | of whitespace. For example, the following are all equivalent: | |
| 896 | ||
| 897 | [ a b c ] | |
| 898 | [a b c] | |
| 899 | [, a,b,c ] | |
| 900 | [, a, b, c ] | |
| 901 | ||
| 902 | A delimiter is a single character, and the following may not be used as | |
| 903 | a delimiter: | |
| 904 | ||
| 905 | any opening/closing characters () [] {} | |
| 906 | single or double quotes | |
| 907 | alphanumeric characters | |
| 908 | underscore | |
| 909 | ||
| 910 | Whitespace (including newlines) around the delimiter is ignored, so the | |
| 911 | following is valid: | |
| 912 | ||
| 913 | [, a, | |
| 914 | b, | |
| 915 | c ] | |
| 916 | ||
| 917 | Two delimiters next to each other or a trailing delimiter produce an | |
| 918 | empty string. | |
| 919 | ||
| 920 | "(,a,b,)" => (a, b, '') | |
| 921 | "(,a,,b)" => (a, '', b) | |
| 922 | ||
| 923 | Hashrefs may be specified by braces and the following are equivalent: | |
| 924 | ||
| 925 | { a 1 b 2 } | |
| 926 | {, a,1,b,2 } | |
| 927 | {, a,1,b,2, } | |
| 928 | ||
| 929 | Note that a trailing delimiter is ignored if there are already an even | |
| 930 | number of elements, or an empty string otherwise. | |
| 931 | ||
| 932 | Nested structures are allowed: | |
| 933 | ||
| 934 | "[ [1 2] [3 4] ]" | |
| 935 | ||
| 936 | For example, | |
| 937 | ||
| 938 | $o->tests( | |
| 939 | func => &func, | |
| 940 | tests => "a [ b c ] { d 1 e 2 } => x y" | |
| 941 | ); | |
| 942 | ||
| 943 | is equivalent to: | |
| 944 | ||
| 945 | $o->tests( | |
| 946 | func => &func, | |
| 947 | tests => [ [a, [b,c], {d=>1,e=>2}] ], | |
| 948 | results => [ [x,y] ], | |
| 949 | ); | |
| 950 | ||
| 951 | Any single value can be surrounded by single or double quotes in order | |
| 952 | to include the delimiter. So: | |
| 953 | ||
| 954 | "(, a,'b,c',e )" | |
| 955 | ||
| 956 | is equivalent to: | |
| 957 | ||
| 958 | "( a b,c e )" | |
| 959 | ||
| 960 | Any single value can be the string '__undef__' which will be turned into | |
| 961 | an actual undef. If the value is '__blank__' it is turned into an empty | |
| 962 | string (''), though it can also be specified as '' directly. Any value | |
| 963 | can have an embedded newline by including a __nl__ in the value, but the | |
| 964 | value must be written on a single line. | |
| 965 | ||
| 966 | Expected results are separated from arguments by ' => '. | |
| 967 | ||
| 968 | HISTORY | |
| 969 | The history of this module dates back to 1996 when I needed to write a | |
| 970 | test suite for my Date::Manip module. At that time, none of the Test::* | |
| 971 | modules currently available in CPAN existed (the earliest ones didn't | |
| 972 | come along until 1998), so I was left completely on my own writing my | |
| 973 | test scripts. | |
| 974 | ||
| 975 | I wrote a very basic version of my test framework which allowed me to | |
| 976 | write all of the tests as a string, it would parse the string, count the | |
| 977 | tests, ad then run them. | |
| 978 | ||
| 979 | Over the years, the functionality I wanted grew, and periodically, I'd | |
| 980 | go back and reexamine other Test frameworks (primarily Test::More) to | |
| 981 | see if I could replace my framework with an existing module... and I've | |
| 982 | always found them wanting, and chosen to extend my existing framework | |
| 983 | instead. | |
| 984 | ||
| 985 | As I've written other modules, I've wanted to use the framework in them | |
| 986 | too, so I've always just copied it in, but this is obviously tedious and | |
| 987 | error prone. I'm not sure why it took me so long... but in 2010, I | |
| 988 | finally decided it was time to rework the framework in a module form. | |
| 989 | ||
| 990 | I loosely based my module on Test::More. I like the functionality of | |
| 991 | that module, and wanted most of it (and I plan on adding more in future | |
| 992 | versions). So this module uses some similar syntax to Test::More (though | |
| 993 | it allows a great deal more flexibility in how the tests are specified). | |
| 994 | ||
| 995 | One thing to note is that I may have been able to write this module as | |
| 996 | an extension to Test::More, but after looking into that possibility, I | |
| 997 | decided that it would be faster to not do that. I did "borrow" a couple | |
| 998 | of routines from it (though they've been modified quite heavily) as a | |
| 999 | starting point for a few of the functions in this module, and I thank | |
| 1000 | the authors of Test::More for their work. | |
| 1001 | ||
| 1002 | KNOWN BUGS AND LIMITATIONS | |
| 1003 | None known. | |
| 1004 | ||
| 1005 | SEE ALSO | |
| 1006 | Test::More - the 'industry standard' of perl test frameworks | |
| 1007 | ||
| 1008 | LICENSE | |
| 1009 | This script is free software; you can redistribute it and/or modify it | |
| 1010 | under the same terms as Perl itself. | |
| 1011 | ||
| 1012 | AUTHOR | |
| 1013 | Sullivan Beck (sbeck@cpan.org) | |
| 1014 |
| 0 | Consider adding the following from Test::More | |
| 1 | ||
| 2 | note | |
| 3 | explain | |
| 4 | can_ok | |
| 5 | isa_ok | |
| 6 | subtest | |
| 7 | cmp_ok | |
| 8 | ||
| 9 | like | |
| 10 | unlike | |
| 11 | handles strings match regexps | |
| 12 | lists contain certain element | |
| 13 | hashes contain certain keys | |
| 14 | ||
| 15 | Add support for input files | |
| 16 | ||
| 17 | Look at: | |
| 18 | Test::Group | |
| 19 | Test::Slow | |
| 20 | to see if there's anything I want to add. | |
| 21 |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use Test::Inter; | |
| 3 | $o = new Test::Inter; | |
| 4 | ||
| 5 | print "The following tests should all succeed\n\n"; | |
| 6 | ||
| 7 | $o->is ( [ a,b ], [ a,b ], "List test" ); | |
| 8 | $o->isnt( [ a,b ], [ a,c ], "List test" ); | |
| 9 | ||
| 10 | $o->is ( { a => 1, b => 2 }, { a => 1, b => 2 }, "Hash test" ); | |
| 11 | $o->isnt( { a => 1, b => 2 }, { a => 1, b => 3 }, "Hash test" ); | |
| 12 | ||
| 13 | print "\nThe following tests should all fail\n\n"; | |
| 14 | ||
| 15 | $o->isnt( [ a,b ], [ a,b ], "List test" ); | |
| 16 | $o->is ( [ a,b ], [ a,c ], "List test" ); | |
| 17 | ||
| 18 | $o->isnt( { a => 1, b => 2 }, { a => 1, b => 2 }, "Hash test" ); | |
| 19 | $o->is ( { a => 1, b => 2 }, { a => 1, b => 3 }, "Hash test" ); |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use Test::Inter; | |
| 3 | $o = new Test::Inter; | |
| 4 | ||
| 5 | print "The following tests should all succeed\n\n"; | |
| 6 | ||
| 7 | $o->ok(); | |
| 8 | $o->ok( 1 == 1 ); | |
| 9 | $o->ok( 1 == 1, "Basic test" ); | |
| 10 | $o->ok( 1 == 1, 1, "Basic test" ); | |
| 11 | $o->ok( 1 == 1, 2, "Basic test" ); | |
| 12 | ||
| 13 | sub func_false { | |
| 14 | return 0; | |
| 15 | } | |
| 16 | sub func_true { | |
| 17 | return 1; | |
| 18 | } | |
| 19 | ||
| 20 | sub func { | |
| 21 | my($a,$b) = @_; | |
| 22 | return $a == $b; | |
| 23 | } | |
| 24 | ||
| 25 | $o->ok( \&func_true ); | |
| 26 | $o->ok( \&func_true, "True test" ); | |
| 27 | $o->ok( \&func_true, 1, "True test" ); | |
| 28 | $o->ok( \&func_true, 2, "True test" ); | |
| 29 | ||
| 30 | $o->ok( \&func, [1,1]); | |
| 31 | $o->ok( \&func, [1,1], "Func test" ); | |
| 32 | $o->ok( \&func, [1,1], 1, "Func test" ); | |
| 33 | $o->ok( \&func, [1,1], 2, "Func test" ); | |
| 34 | ||
| 35 | $o->ok( [ a,b ], [ a,b ], "List test" ); | |
| 36 | $o->ok( [ a,b ], [ a,c ], "List test (non-identical)" ); | |
| 37 | ||
| 38 | $o->ok( { a => 1, b => 2 }, { a => 1, b => 2 }, "Hash test" ); | |
| 39 | $o->ok( { a => 1, b => 2 }, { a => 1, b => 3 }, "Hash test (non-identical)" ); | |
| 40 | ||
| 41 | print "\nThe following tests should all fail\n\n"; | |
| 42 | ||
| 43 | $o->ok( 1 == 2 ); | |
| 44 | $o->ok( 1 == 2, "Basic test" ); | |
| 45 | $o->ok( 1 == 2, 1, "Basic test" ); | |
| 46 | ||
| 47 | $o->ok( \&func_false ); | |
| 48 | $o->ok( \&func_false, "False test" ); | |
| 49 | $o->ok( \&func_false, 1, "False test" ); | |
| 50 | ||
| 51 | $o->ok( \&func, [1,2]); | |
| 52 | $o->ok( \&func, [1,2], "Func test" ); | |
| 53 | $o->ok( \&func, [1,2], 1, "Func test" ); | |
| 54 | ||
| 55 | $o->ok( [], [ a,b ], "List test" ); | |
| 56 | $o->ok( [undef], [ a,b ], "List test" ); | |
| 57 | ||
| 58 | $o->ok( { a => undef }, { a => 1 }, "Hash test" ); | |
| 59 |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use strict; | |
| 3 | use warnings; | |
| 4 | use Test::Inter; | |
| 5 | ||
| 6 | my $o = new Test::Inter; | |
| 7 | ||
| 8 | print "The following script will fail due to multiple plans\n\n"; | |
| 9 | ||
| 10 | $o->plan(2); | |
| 11 | $o->plan(5); | |
| 12 | $o->done_testing(); | |
| 13 |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use Test::Inter; | |
| 3 | $o = new Test::Inter; | |
| 4 | ||
| 5 | print "The following tests test some improperly formed tests\n\n"; | |
| 6 | ||
| 7 | sub func1 { | |
| 8 | my($a,$b) = @_; | |
| 9 | ||
| 10 | if ($a eq 'a' && $b eq 'b') { return 1; } | |
| 11 | elsif ($a eq 'c' && $b eq 'd') { return 2; } | |
| 12 | elsif ($a eq 'e' && $b eq 'f') { return 3; } | |
| 13 | } | |
| 14 | ||
| 15 | print "The 2nd one fails with 'expected results for some, not others\n\n"; | |
| 16 | $o->tests(func => \&func1, | |
| 17 | tests => "a b => 1 | |
| 18 | ||
| 19 | c d | |
| 20 | ||
| 21 | e f => 3"); | |
| 22 | ||
| 23 | print "\n\nFails with '=>' found twice\n\n"; | |
| 24 | $o->tests(func => \&func1, | |
| 25 | tests => "a b => 1 => 1"); | |
| 26 | ||
| 27 | print "\n\nFails with odd number of elements in hash\n\n"; | |
| 28 | $o->tests(func => \&func1, | |
| 29 | tests => "{ a b c } => 1"); | |
| 30 | ||
| 31 | print "\n\nFails with improper quoting\n\n"; | |
| 32 | $o->tests(func => \&func1, | |
| 33 | tests => "a 'b => 1"); | |
| 34 | ||
| 35 | print "\n\nFails with unable to parse\n\n"; | |
| 36 | $o->tests(func => \&func1, | |
| 37 | tests => "(a b c"); | |
| 38 | ||
| 39 | print "\n\nFails with unexpected token\n\n"; | |
| 40 | $o->tests(func => \&func1, | |
| 41 | tests => "(a b c)(d e) => 1"); |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use strict; | |
| 3 | use warnings; | |
| 4 | ||
| 5 | use vars qw($o); | |
| 6 | ||
| 7 | BEGIN { | |
| 8 | print "The first test will fail, all others will be skipped.\n\n"; | |
| 9 | use Test::Inter; | |
| 10 | $o = new Test::Inter; | |
| 11 | } | |
| 12 | ||
| 13 | BEGIN { $o->use_ok('Xxx::Yyy'); } | |
| 14 | ||
| 15 | $o->ok(); | |
| 16 | $o->ok( 1 == 1 ); | |
| 17 | $o->ok( 1 == 2 ); | |
| 18 | ||
| 19 | $o->done_testing(); | |
| 20 |
| 0 | package Test::Inter; | |
| 1 | # Copyright (c) 2010-2010 Sullivan Beck. All rights reserved. | |
| 2 | # This program is free software; you can redistribute it and/or modify it | |
| 3 | # under the same terms as Perl itself. | |
| 4 | ||
| 5 | ############################################################################### | |
| 6 | ||
| 7 | require 5.004; | |
| 8 | ||
| 9 | use warnings; | |
| 10 | use strict; | |
| 11 | use File::Basename; | |
| 12 | use IO::File; | |
| 13 | ||
| 14 | use vars qw($VERSION); | |
| 15 | $VERSION = '1.01'; | |
| 16 | ||
| 17 | ############################################################################### | |
| 18 | # BASE METHODS | |
| 19 | ############################################################################### | |
| 20 | ||
| 21 | sub version { | |
| 22 | my($self) = @_; | |
| 23 | ||
| 24 | return $VERSION; | |
| 25 | } | |
| 26 | ||
| 27 | sub new { | |
| 28 | my($class,@args) = @_; | |
| 29 | my($name,%opts); | |
| 30 | ||
| 31 | if (@args % 2) { | |
| 32 | ($name,%opts) = @args; | |
| 33 | } else { | |
| 34 | $name = $0; | |
| 35 | $name =~ s,^\./,,; | |
| 36 | %opts = @args; | |
| 37 | } | |
| 38 | ||
| 39 | # The basic structure | |
| 40 | ||
| 41 | my $self = { | |
| 42 | 'name' => $name, # the name of the test script | |
| 43 | 'start' => 1, # the first test to run | |
| 44 | 'end' => 0, # the last test to end | |
| 45 | 'plan' => 0, # the number of tests planned | |
| 46 | 'abort' => 0, # abort on the first failed test | |
| 47 | 'quiet' => 0, # if 1, no output on successes | |
| 48 | # (this should only be done when | |
| 49 | # running as an interactive script) | |
| 50 | 'mode' => 'test', # mode to run script in | |
| 51 | 'features' => {}, # a list of available features | |
| 52 | ||
| 53 | 'skipall' => '', # the reason for skipping all | |
| 54 | # remaining tests | |
| 55 | ||
| 56 | 'plandone' => 0, # 1 if a plan is done | |
| 57 | 'testsrun' => 0, # 1 if any tests have been run | |
| 58 | ||
| 59 | 'libdir' => '', # a directory to load modules from | |
| 60 | 'testdir' => '', # the test directory | |
| 61 | }; | |
| 62 | ||
| 63 | bless $self, $class; | |
| 64 | $main::TI_NUM = 0; | |
| 65 | ||
| 66 | # Handle options, environment variables, global variables | |
| 67 | ||
| 68 | my @opts = qw(start end testnum plan abort quiet mode skip_all); | |
| 69 | my %o = map { $_,1 } @opts; | |
| 70 | ||
| 71 | no strict 'refs'; | |
| 72 | foreach my $opt (@opts) { | |
| 73 | if (! exists $o{$opt}) { | |
| 74 | $self->_die("Invalid option to new method: $opt"); | |
| 75 | } | |
| 76 | ||
| 77 | my $OPT = uc("ti_$opt"); | |
| 78 | ||
| 79 | if (exists $opts{opt} || | |
| 80 | exists $ENV{$OPT} || | |
| 81 | defined ${ "main::$OPT" }) { | |
| 82 | ||
| 83 | my $val; | |
| 84 | if (defined ${ "main::$OPT" }) { | |
| 85 | $val = ${ "main::$OPT" }; | |
| 86 | } elsif (exists $ENV{$OPT}) { | |
| 87 | $val = $ENV{$OPT}; | |
| 88 | } else { | |
| 89 | $val = $opts{$opt}; | |
| 90 | } | |
| 91 | ||
| 92 | &{ "Test::Inter::$opt" }($self,$val); | |
| 93 | } | |
| 94 | } | |
| 95 | ||
| 96 | if ($$self{'mode'} ne 'test') { | |
| 97 | print "\nRunning $name...\n"; | |
| 98 | } | |
| 99 | ||
| 100 | # Find the test directory | |
| 101 | # | |
| 102 | # Scripts will either be run: | |
| 103 | # directly (look at $0) | |
| 104 | # as a test suite (look for ./t and ../t) | |
| 105 | ||
| 106 | my($TDIR,@LIBDIR); | |
| 107 | if (-f "$0") { | |
| 108 | my $COM = $0; | |
| 109 | $TDIR = dirname($COM); | |
| 110 | $TDIR = '.' if (! $TDIR); | |
| 111 | } elsif (-d 't') { | |
| 112 | $TDIR = 't'; | |
| 113 | } else { | |
| 114 | $TDIR = '.'; | |
| 115 | } | |
| 116 | ||
| 117 | @LIBDIR = ('.'); | |
| 118 | if (-d "$TDIR/lib") { | |
| 119 | push(@LIBDIR,"$TDIR/lib"); | |
| 120 | } | |
| 121 | if (-d "$TDIR/../lib") { | |
| 122 | push(@LIBDIR,"$TDIR/../lib"); | |
| 123 | } | |
| 124 | ||
| 125 | $$self{'testdir'} = $TDIR; | |
| 126 | $$self{'libdir'} = \@LIBDIR; | |
| 127 | ||
| 128 | return $self; | |
| 129 | } | |
| 130 | ||
| 131 | sub testdir { | |
| 132 | my($self) = @_; | |
| 133 | return $$self{'testdir'}; | |
| 134 | } | |
| 135 | ||
| 136 | sub start { | |
| 137 | my($self,$val) = @_; | |
| 138 | $val = 1 if (! defined($val)); | |
| 139 | $self->_die("start requires an integer value") if ($val !~ /^\d+$/); | |
| 140 | $$self{'start'} = $val; | |
| 141 | } | |
| 142 | ||
| 143 | sub end { | |
| 144 | my($self,$val) = @_; | |
| 145 | $val = 0 if (! $val); | |
| 146 | $self->_die("end requires an integer value") if ($val !~ /^\d+$/); | |
| 147 | $$self{'end'} = $val; | |
| 148 | } | |
| 149 | ||
| 150 | sub testnum { | |
| 151 | my($self,$val) = @_; | |
| 152 | if (! defined($val)) { | |
| 153 | $$self{'start'} = 1; | |
| 154 | $$self{'end'} = 0; | |
| 155 | } else { | |
| 156 | $self->_die("testnum requires an integer value") if ($val !~ /^\d+$/); | |
| 157 | $$self{'start'} = $$self{'end'} = $val; | |
| 158 | } | |
| 159 | } | |
| 160 | ||
| 161 | sub plan { | |
| 162 | my($self,$val) = @_; | |
| 163 | ||
| 164 | if ($$self{'plandone'}) { | |
| 165 | $self->_die('Plan/done_testing included twice'); | |
| 166 | } | |
| 167 | $$self{'plandone'} = 1; | |
| 168 | ||
| 169 | $val = 0 if (! defined($val)); | |
| 170 | $self->_die("plan requires an integer value") if ($val !~ /^\d+$/); | |
| 171 | $$self{'plan'} = $val; | |
| 172 | ||
| 173 | if ($val != 0) { | |
| 174 | $self->_plan($val); | |
| 175 | } | |
| 176 | } | |
| 177 | ||
| 178 | sub done_testing { | |
| 179 | my($self,$val) = @_; | |
| 180 | ||
| 181 | if ($$self{'plandone'}) { | |
| 182 | $self->_die('Plan/done_testing included twice'); | |
| 183 | } | |
| 184 | $$self{'plandone'} = 1; | |
| 185 | ||
| 186 | $val = $main::TI_NUM if (! $val); | |
| 187 | $self->_die("done_testing requires an integer value") if ($val !~ /^\d+$/); | |
| 188 | $self->_plan($val); | |
| 189 | ||
| 190 | if ($val != $main::TI_NUM) { | |
| 191 | $self->_die("Ran $main::TI_NUM tests, expected $val"); | |
| 192 | } | |
| 193 | } | |
| 194 | ||
| 195 | sub abort { | |
| 196 | my($self,$val) = @_; | |
| 197 | $val = 0 if (! $val); | |
| 198 | $$self{'abort'} = $val; | |
| 199 | } | |
| 200 | ||
| 201 | sub quiet { | |
| 202 | my($self,$val) = @_; | |
| 203 | $val = 0 if (! $val); | |
| 204 | $$self{'quiet'} = $val; | |
| 205 | } | |
| 206 | ||
| 207 | sub mode { | |
| 208 | my($self,$val) = @_; | |
| 209 | $val = 'test' if (! $val); | |
| 210 | $$self{'mode'} = $val; | |
| 211 | } | |
| 212 | ||
| 213 | sub skip_all { | |
| 214 | my($self,$reason,@features) = @_; | |
| 215 | ||
| 216 | if (@features) { | |
| 217 | my $skip = 0; | |
| 218 | foreach my $feature (@features) { | |
| 219 | if (! exists $$self{'features'}{$feature} || | |
| 220 | ! $$self{'features'}{$feature}) { | |
| 221 | $skip = 1; | |
| 222 | $reason = "Required feature ($feature) missing" | |
| 223 | if (! $reason); | |
| 224 | last; | |
| 225 | } | |
| 226 | } | |
| 227 | return if (! $skip); | |
| 228 | } | |
| 229 | ||
| 230 | if ($$self{'plandone'} || | |
| 231 | $$self{'testsrun'}) { | |
| 232 | $reason = 'Remaining tests skipped' if (! $reason); | |
| 233 | $$self{'skipall'} = $reason; | |
| 234 | ||
| 235 | } else { | |
| 236 | $reason = 'Test script skipped' if (! $reason); | |
| 237 | $self->_plan(0,$reason); | |
| 238 | exit 0; | |
| 239 | } | |
| 240 | } | |
| 241 | ||
| 242 | sub _die { | |
| 243 | my($self,$message) = @_; | |
| 244 | ||
| 245 | print "ERROR: $message\n"; | |
| 246 | exit 1; | |
| 247 | } | |
| 248 | ||
| 249 | sub feature { | |
| 250 | my($self,$feature,$val) = @_; | |
| 251 | $$self{'features'}{$feature} = $val; | |
| 252 | } | |
| 253 | ||
| 254 | sub diag { | |
| 255 | my($self,$message) = @_; | |
| 256 | return if ($$self{'quiet'} == 2); | |
| 257 | $self->_diag($message); | |
| 258 | } | |
| 259 | ||
| 260 | sub note { | |
| 261 | my($self,$message) = @_; | |
| 262 | return if ($$self{'quiet'}); | |
| 263 | $self->_diag($message); | |
| 264 | } | |
| 265 | ||
| 266 | ############################################################################### | |
| 267 | # LOAD METHODS | |
| 268 | ############################################################################### | |
| 269 | # The routines were originally from Test::More (though they have been | |
| 270 | # changed... some to a greater extent than others). | |
| 271 | ||
| 272 | sub require_ok { | |
| 273 | my($self,$module,$mode) = @_; | |
| 274 | $mode = '' if (! $mode); | |
| 275 | $main::TI_NUM++ unless ($mode eq 'feature'); | |
| 276 | ||
| 277 | my $pack = caller; | |
| 278 | my @inc = map { "unshift(\@INC,'$_');\n" } @{ $$self{'libdir'} }; | |
| 279 | ||
| 280 | my($desc,$code); | |
| 281 | ||
| 282 | if ( $module =~ /^\d+(?:\.\d+)?$/ ) { | |
| 283 | # A perl version check. | |
| 284 | $desc = "require perl $module"; | |
| 285 | $code = <<REQUIRE; | |
| 286 | require $module; | |
| 287 | 1; | |
| 288 | REQUIRE | |
| 289 | } else { | |
| 290 | $module = qq['$module'] unless $self->_is_module_name($module); | |
| 291 | $desc = "require $module"; | |
| 292 | $code = <<REQUIRE; | |
| 293 | package $pack; | |
| 294 | @inc | |
| 295 | require $module; | |
| 296 | 1; | |
| 297 | REQUIRE | |
| 298 | } | |
| 299 | ||
| 300 | $desc .= ' (should not load)' if ($mode eq 'forbid'); | |
| 301 | $desc .= ' (feature)' if ($mode eq 'feature'); | |
| 302 | ||
| 303 | my($eval_result,$eval_error) = $self->_eval($code); | |
| 304 | chomp($eval_error); | |
| 305 | my @eval_error = split(/\n/,$eval_error); | |
| 306 | foreach my $err (@eval_error) { | |
| 307 | $err =~ s/ \(\@INC contains.*//; # strip out the actual @INC values | |
| 308 | } | |
| 309 | ||
| 310 | my $ok = 1; | |
| 311 | if ($eval_result) { | |
| 312 | # Able to load the module | |
| 313 | if ($mode eq 'forbid') { | |
| 314 | $$self{'skipall'} = 'Loaded a module not supposed to be present'; | |
| 315 | $self->_not_ok($desc); | |
| 316 | $self->_diag('Test required that module not be loadable') | |
| 317 | unless ($$self{'quiet'} == 2); | |
| 318 | $ok = 0; | |
| 319 | } elsif ($mode eq 'feature') { | |
| 320 | $self->feature($module,1); | |
| 321 | if (! $$self{'quiet'}) { | |
| 322 | $self->_diag($desc); | |
| 323 | $self->_diag("Feature available: $module"); | |
| 324 | } | |
| 325 | } else { | |
| 326 | $self->_ok($desc); | |
| 327 | } | |
| 328 | ||
| 329 | } else { | |
| 330 | # Unable to load the module | |
| 331 | if ($mode eq 'forbid') { | |
| 332 | $self->_ok($desc); | |
| 333 | } elsif ($mode eq 'feature') { | |
| 334 | $self->feature($module,0); | |
| 335 | if (! $$self{'quiet'}) { | |
| 336 | $self->_diag($desc); | |
| 337 | $self->_diag("Feature unavailable: $module"); | |
| 338 | } | |
| 339 | } else { | |
| 340 | $$self{'skipall'} = 'Unable to load a required module'; | |
| 341 | $self->_not_ok($desc); | |
| 342 | $ok = 0; | |
| 343 | } | |
| 344 | } | |
| 345 | ||
| 346 | return | |
| 347 | if ( ($ok && $$self{'quiet'}) || | |
| 348 | (! $ok && $$self{'quiet'} == 2) ); | |
| 349 | ||
| 350 | foreach my $err (@eval_error) { | |
| 351 | $self->_diag($err); | |
| 352 | } | |
| 353 | } | |
| 354 | ||
| 355 | sub use_ok { | |
| 356 | my($self,@args) = @_; | |
| 357 | ||
| 358 | my $mode = ''; | |
| 359 | if ($args[$#args] eq 'forbid' || | |
| 360 | $args[$#args] eq 'feature') { | |
| 361 | $mode = pop(@args); | |
| 362 | } | |
| 363 | $main::TI_NUM++ unless ($mode eq 'feature'); | |
| 364 | ||
| 365 | my $pack = caller; | |
| 366 | ||
| 367 | my($code,$desc,$module); | |
| 368 | if ( @args == 1 and $args[0] =~ /^\d+(?:\.\d+)?$/ ) { | |
| 369 | # A perl version check. | |
| 370 | $desc = "require perl $args[0]"; | |
| 371 | $module = 'perl'; | |
| 372 | $code = <<USE; | |
| 373 | use $args[0]; | |
| 374 | 1; | |
| 375 | USE | |
| 376 | ||
| 377 | } elsif (@args) { | |
| 378 | $module = shift(@args); | |
| 379 | ||
| 380 | if (! $self->_is_module_name($module)) { | |
| 381 | $self->_not_ok("use module: invalid module name: $module"); | |
| 382 | return; | |
| 383 | } | |
| 384 | ||
| 385 | my $vers = ''; | |
| 386 | if ( @args and $args[0] =~ /^\d+(?:\.\d+)?$/ ) { | |
| 387 | $vers = shift(@args); | |
| 388 | } | |
| 389 | ||
| 390 | my $imports = (@args ? 'qw(' . join(' ',@args) . ')' : ''); | |
| 391 | $desc = "use $module $vers $imports"; | |
| 392 | ||
| 393 | my @inc = map { "unshift(\@INC,'$_');\n" } @{ $$self{'libdir'} }; | |
| 394 | ||
| 395 | $code = <<USE; | |
| 396 | package $pack; | |
| 397 | @inc | |
| 398 | use $module $vers $imports; | |
| 399 | 1; | |
| 400 | USE | |
| 401 | ||
| 402 | } else { | |
| 403 | $self->_not_ok('use module: no module specified'); | |
| 404 | return; | |
| 405 | } | |
| 406 | ||
| 407 | $desc .= ' (should not load)' if ($mode eq 'forbid'); | |
| 408 | $desc .= ' (feature)' if ($mode eq 'feature'); | |
| 409 | ||
| 410 | my($eval_result,$eval_error) = $self->_eval($code); | |
| 411 | chomp($eval_error); | |
| 412 | my @eval_error = split(/\n/,$eval_error); | |
| 413 | @eval_error = grep(!/^BEGIN failed--compilation aborted/,@eval_error); | |
| 414 | foreach my $err (@eval_error) { | |
| 415 | $err =~ s/ \(\@INC contains.*//; # strip out the actual @INC values | |
| 416 | } | |
| 417 | ||
| 418 | my $ok = 1; | |
| 419 | if ($eval_result) { | |
| 420 | # Able to load the module | |
| 421 | if ($mode eq 'forbid') { | |
| 422 | $$self{'skipall'} = 'Loaded a module not supposed to be present'; | |
| 423 | $self->_not_ok($desc); | |
| 424 | $self->_diag('Test required that module not be usable') | |
| 425 | unless ($$self{'quiet'} == 2); | |
| 426 | $ok = 0; | |
| 427 | } elsif ($mode eq 'feature') { | |
| 428 | $self->feature($module,1); | |
| 429 | if (! $$self{'quiet'}) { | |
| 430 | $self->_diag($desc); | |
| 431 | $self->_diag("Feature available: $module"); | |
| 432 | } | |
| 433 | } else { | |
| 434 | $self->_ok($desc); | |
| 435 | } | |
| 436 | ||
| 437 | } else { | |
| 438 | # Unable to load the module | |
| 439 | if ($mode eq 'forbid') { | |
| 440 | $self->_ok($desc); | |
| 441 | } elsif ($mode eq 'feature') { | |
| 442 | $self->feature($module,0); | |
| 443 | if (! $$self{'quiet'}) { | |
| 444 | $self->_diag($desc); | |
| 445 | $self->_diag("Feature unavailable: $module"); | |
| 446 | } | |
| 447 | } else { | |
| 448 | $$self{'skipall'} = 'Unable to load a required module'; | |
| 449 | $self->_not_ok($desc); | |
| 450 | $ok = 0; | |
| 451 | } | |
| 452 | } | |
| 453 | ||
| 454 | return | |
| 455 | if ( ($ok && $$self{'quiet'}) || | |
| 456 | (! $ok && $$self{'quiet'} == 2) ); | |
| 457 | ||
| 458 | foreach my $err (@eval_error) { | |
| 459 | $self->_diag($err); | |
| 460 | } | |
| 461 | } | |
| 462 | ||
| 463 | sub _is_module_name { | |
| 464 | my($self,$module) = @_; | |
| 465 | ||
| 466 | # Module names start with a letter. | |
| 467 | # End with an alphanumeric. | |
| 468 | # The rest is an alphanumeric or :: | |
| 469 | $module =~ s/\b::\b//g; | |
| 470 | ||
| 471 | return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0; | |
| 472 | } | |
| 473 | ||
| 474 | sub _eval { | |
| 475 | my($self,$code) = @_; | |
| 476 | ||
| 477 | my( $sigdie, $eval_result, $eval_error ); | |
| 478 | { | |
| 479 | local( $@, $!, $SIG{__DIE__} ); # isolate eval | |
| 480 | $eval_result = eval $code; | |
| 481 | $eval_error = $@; | |
| 482 | $sigdie = $SIG{__DIE__} || undef; | |
| 483 | } | |
| 484 | # make sure that $code got a chance to set $SIG{__DIE__} | |
| 485 | $SIG{__DIE__} = $sigdie if defined $sigdie; | |
| 486 | ||
| 487 | return( $eval_result, $eval_error ); | |
| 488 | } | |
| 489 | ||
| 490 | ############################################################################### | |
| 491 | # OK/IS/ISNT METHODS | |
| 492 | ############################################################################### | |
| 493 | ||
| 494 | sub ok { | |
| 495 | my($self,@args) = @_; | |
| 496 | $main::TI_NUM++; | |
| 497 | ||
| 498 | my($op,@ret) = $self->_ok_result(@args); | |
| 499 | my($name,@diag); | |
| 500 | my $ok = 1; | |
| 501 | ||
| 502 | if ($op eq 'skip') { | |
| 503 | my $reason = shift(@ret); | |
| 504 | $self->_skip($reason); | |
| 505 | ||
| 506 | } elsif ($op eq 'pass') { | |
| 507 | ($name,@diag) = @ret; | |
| 508 | $self->_ok($name); | |
| 509 | ||
| 510 | } else { | |
| 511 | ($name,@diag) = @ret; | |
| 512 | $self->_not_ok($name); | |
| 513 | $ok = 0; | |
| 514 | } | |
| 515 | ||
| 516 | return | |
| 517 | if ( ($ok && $$self{'quiet'}) || | |
| 518 | (! $ok && $$self{'quiet'} == 2) ); | |
| 519 | ||
| 520 | foreach my $diag (@diag) { | |
| 521 | $self->_diag($diag); | |
| 522 | } | |
| 523 | } | |
| 524 | ||
| 525 | sub _ok_result { | |
| 526 | my($self,@args) = @_; | |
| 527 | ||
| 528 | # Test if we're skipping this test | |
| 529 | ||
| 530 | my($skip,$reason) = $self->_skip_test(); | |
| 531 | return ('skip',$reason) if ($skip); | |
| 532 | ||
| 533 | # No args == always pass | |
| 534 | ||
| 535 | if (@args == 0) { | |
| 536 | return ('pass','Empty test'); | |
| 537 | } | |
| 538 | ||
| 539 | # Get the result | |
| 540 | ||
| 541 | my($func,$funcargs,$result) = $self->_get_result(\@args); | |
| 542 | ||
| 543 | # Get name/expected | |
| 544 | ||
| 545 | my($name,$expected); | |
| 546 | if (@args == 1) { | |
| 547 | $name = $args[0]; | |
| 548 | } elsif (@args == 2) { | |
| 549 | ($expected,$name) = @args; | |
| 550 | } elsif (@args > 2) { | |
| 551 | return(0,'','Improperly formed test: too many arguments'); | |
| 552 | } | |
| 553 | ||
| 554 | # Check the result | |
| 555 | ||
| 556 | my($pass,@diag) = $self->_cmp_result('ok',$func,$funcargs,$result,$expected); | |
| 557 | return($pass,$name,@diag); | |
| 558 | } | |
| 559 | ||
| 560 | sub is { | |
| 561 | my($self,@args) = @_; | |
| 562 | $self->_is("is",@args); | |
| 563 | } | |
| 564 | ||
| 565 | sub isnt { | |
| 566 | my($self,@args) = @_; | |
| 567 | $self->_is("isnt",@args); | |
| 568 | } | |
| 569 | ||
| 570 | sub _is { | |
| 571 | my($self,$is,@args) = @_; | |
| 572 | $main::TI_NUM++; | |
| 573 | ||
| 574 | my($op,@ret) = $self->_is_result($is,@args); | |
| 575 | my($name,@diag); | |
| 576 | my $ok = 1; | |
| 577 | ||
| 578 | if ($op eq 'skip') { | |
| 579 | my $reason = shift(@ret); | |
| 580 | $self->_skip($reason); | |
| 581 | ||
| 582 | } elsif ($op eq 'pass') { | |
| 583 | ($name,@diag) = @ret; | |
| 584 | $self->_ok($name); | |
| 585 | ||
| 586 | } else { | |
| 587 | ($name,@diag) = @ret; | |
| 588 | $self->_not_ok($name); | |
| 589 | $ok = 0; | |
| 590 | } | |
| 591 | ||
| 592 | return | |
| 593 | if ( ($ok && $$self{'quiet'}) || | |
| 594 | (! $ok && $$self{'quiet'} == 2) ); | |
| 595 | ||
| 596 | foreach my $diag (@diag) { | |
| 597 | $self->_diag($diag); | |
| 598 | } | |
| 599 | } | |
| 600 | ||
| 601 | sub _is_result { | |
| 602 | my($self,$is,@args) = @_; | |
| 603 | ||
| 604 | # Test if we're skipping this test | |
| 605 | ||
| 606 | my($skip,$reason) = $self->_skip_test(); | |
| 607 | return ('skip',$reason) if ($skip); | |
| 608 | ||
| 609 | # Test args | |
| 610 | ||
| 611 | if (@args < 2) { | |
| 612 | return ('fail','','Improperly formed test: too few arguments'); | |
| 613 | } | |
| 614 | ||
| 615 | my($func,$funcargs,$result) = $self->_get_result(\@args); | |
| 616 | ||
| 617 | my($name,$expected); | |
| 618 | if (@args == 1) { | |
| 619 | ($expected) = @args; | |
| 620 | } elsif (@args == 2) { | |
| 621 | ($expected,$name) = @args; | |
| 622 | } else { | |
| 623 | return(0,'','Improperly formed test: too many arguments'); | |
| 624 | } | |
| 625 | ||
| 626 | # Check the result | |
| 627 | ||
| 628 | my($pass,@diag) = $self->_cmp_result($is,$func,$funcargs,$result,$expected); | |
| 629 | return($pass,$name,@diag); | |
| 630 | } | |
| 631 | ||
| 632 | # Returns $func,$args and $results. The first two are returned only if | |
| 633 | # there is a function. | |
| 634 | # | |
| 635 | sub _get_result { | |
| 636 | my($self,$args) = @_; | |
| 637 | my($func,@funcargs,@result,$result); | |
| 638 | ||
| 639 | if (ref($$args[0]) eq 'CODE') { | |
| 640 | $func = shift(@$args); | |
| 641 | ||
| 642 | if (ref($$args[0]) eq 'ARRAY') { | |
| 643 | @funcargs = @{ $$args[0] }; | |
| 644 | shift(@$args); | |
| 645 | } | |
| 646 | ||
| 647 | @result = &$func(@funcargs); | |
| 648 | return ($func,\@funcargs,\@result); | |
| 649 | ||
| 650 | } elsif (ref($$args[0]) eq 'ARRAY') { | |
| 651 | @result = @{ $$args[0] }; | |
| 652 | shift(@$args); | |
| 653 | return ('','',\@result); | |
| 654 | ||
| 655 | } else { | |
| 656 | $result = shift(@$args); | |
| 657 | return ('','',$result); | |
| 658 | } | |
| 659 | } | |
| 660 | ||
| 661 | sub _cmp_result { | |
| 662 | my($self,$type,$func,$funcargs,$result,$expected) = @_; | |
| 663 | my $pass = 0; | |
| 664 | my $identical = 0; | |
| 665 | my @diag; | |
| 666 | ||
| 667 | if ($type eq 'ok') { | |
| 668 | if (ref($result) eq 'ARRAY') { | |
| 669 | foreach my $ele (@$result) { | |
| 670 | $pass = 1 if (defined($ele)); | |
| 671 | } | |
| 672 | ||
| 673 | } elsif (ref($result) eq 'HASH') { | |
| 674 | foreach my $key (keys %$result) { | |
| 675 | my $val = $$result{$key}; | |
| 676 | $pass = 1 if (defined($val)); | |
| 677 | } | |
| 678 | ||
| 679 | } else { | |
| 680 | $pass = ($result ? 1 : 0); | |
| 681 | } | |
| 682 | ||
| 683 | if (! defined($expected)) { | |
| 684 | # If no expected result passed in, we don't test the results | |
| 685 | $identical = 1; | |
| 686 | } else { | |
| 687 | # Results/expected must be the same structure | |
| 688 | $identical = $self->_cmp_structure($result,$expected); | |
| 689 | } | |
| 690 | ||
| 691 | } else { | |
| 692 | $identical = $self->_cmp_structure($result,$expected); | |
| 693 | if ($type eq 'is') { | |
| 694 | $pass = $identical; | |
| 695 | } else { | |
| 696 | $pass = 1 - $identical; | |
| 697 | } | |
| 698 | } | |
| 699 | ||
| 700 | if (! $identical && $type ne 'isnt') { | |
| 701 | if ($func) { | |
| 702 | push(@diag,"Arguments: " . $self->_stringify($funcargs)); | |
| 703 | } | |
| 704 | push(@diag, "Results : " . $self->_stringify($result)); | |
| 705 | push(@diag, "Expected : " . $self->_stringify($expected)) unless ($type eq 'ok' && | |
| 706 | ! defined($result)); | |
| 707 | } | |
| 708 | ||
| 709 | return (($pass ? 'pass' : 'fail'),@diag); | |
| 710 | } | |
| 711 | ||
| 712 | # Turn a data structure into a string (poor-man's Data::Dumper) | |
| 713 | sub _stringify { | |
| 714 | my($self,$s) = @_; | |
| 715 | ||
| 716 | my($str) = $self->__stringify($s); | |
| 717 | $str = substr($str,0,60) if (length($str)>60); | |
| 718 | return $str; | |
| 719 | } | |
| 720 | sub __stringify { | |
| 721 | my($self,$s) = @_; | |
| 722 | ||
| 723 | if (! defined($s)) { | |
| 724 | return '__undef__'; | |
| 725 | ||
| 726 | } elsif (ref($s) eq 'ARRAY') { | |
| 727 | my $str = '[ '; | |
| 728 | foreach my $val (@$s) { | |
| 729 | $str .= $self->__stringify($val) . ' '; | |
| 730 | } | |
| 731 | $str .= ']'; | |
| 732 | return $str; | |
| 733 | ||
| 734 | } elsif (ref($s) eq 'HASH') { | |
| 735 | my $str = '{ '; | |
| 736 | foreach my $key (sort keys %$s) { | |
| 737 | my $key = $self->__stringify($key); | |
| 738 | my $val = $self->__stringify($$s{$key}); | |
| 739 | $str .= "$key=>$val "; | |
| 740 | } | |
| 741 | $str .= '}'; | |
| 742 | return $str; | |
| 743 | ||
| 744 | } elsif (ref($s)) { | |
| 745 | return '<' . ref($s) . '>'; | |
| 746 | ||
| 747 | } elsif ($s eq '') { | |
| 748 | return "''"; | |
| 749 | ||
| 750 | } else { | |
| 751 | if ($s =~ /\s/) { | |
| 752 | my $q = qr/\'/; # single quote | |
| 753 | my $qq = qr/\"/; # double quote | |
| 754 | if ($s !~ $q) { | |
| 755 | return "'$s'"; | |
| 756 | } | |
| 757 | if ($s !~ $qq) { | |
| 758 | return '"' . $s . '"'; | |
| 759 | } | |
| 760 | return "<$s>"; | |
| 761 | ||
| 762 | } else { | |
| 763 | return $s; | |
| 764 | } | |
| 765 | } | |
| 766 | } | |
| 767 | ||
| 768 | sub _cmp_structure { | |
| 769 | my($self,$s1,$s2) = @_; | |
| 770 | ||
| 771 | return 1 if (! defined($s1) && ! defined($s2)); # undef = undef | |
| 772 | return 0 if (! defined($s1) || ! defined($s2)); # undef != def | |
| 773 | return 0 if (ref($s1) ne ref($s2)); # must be same type | |
| 774 | ||
| 775 | if (ref($s1) eq 'ARRAY') { | |
| 776 | return 0 if ($#$s1 != $#$s2); # two lists must be the same length | |
| 777 | foreach (my $i=0; $i<=$#$s1; $i++) { | |
| 778 | return 0 unless $self->_cmp_structure($$s1[$i],$$s2[$i]); | |
| 779 | } | |
| 780 | return 1; | |
| 781 | ||
| 782 | } elsif (ref($s1) eq 'HASH') { | |
| 783 | my @k1 = keys %$s1; | |
| 784 | my @k2 = keys %$s2; | |
| 785 | return 0 if ($#k1 != $#k2); # two hashes must be the same length | |
| 786 | foreach my $key (@k1) { | |
| 787 | return 0 if (! exists $$s2{$key}); # keys must be the same | |
| 788 | return 0 unless $self->_cmp_structure($$s1{$key},$$s2{$key}); | |
| 789 | } | |
| 790 | return 1; | |
| 791 | ||
| 792 | } elsif (ref($s1)) { | |
| 793 | # Two references (other than ARRAY and HASH are assumed equal. | |
| 794 | return 1; | |
| 795 | ||
| 796 | } else { | |
| 797 | # Two scalars are compared stringwise | |
| 798 | return ($s1 eq $s2); | |
| 799 | } | |
| 800 | } | |
| 801 | ||
| 802 | sub _skip_test { | |
| 803 | my($self) = @_; | |
| 804 | ||
| 805 | if ($$self{'skipall'}) { | |
| 806 | return (1,$$self{'skipall'}); | |
| 807 | } elsif ( $main::TI_NUM < $$self{'start'} || | |
| 808 | ($$self{'end'} && $main::TI_NUM > $$self{'end'}) ) { | |
| 809 | return (1,'Test not in list of tests specified to run'); | |
| 810 | } | |
| 811 | return 0; | |
| 812 | } | |
| 813 | ||
| 814 | ############################################################################### | |
| 815 | # FILE METHOD | |
| 816 | ############################################################################### | |
| 817 | ||
| 818 | sub file { | |
| 819 | my($self,$func,$input,$outputdir,$expected,$name,@args) = @_; | |
| 820 | $name = "" if (! $name); | |
| 821 | ||
| 822 | if (! ref($func) eq 'CODE') { | |
| 823 | $self->_die("file method required a coderef"); | |
| 824 | } | |
| 825 | ||
| 826 | my @funcargs; | |
| 827 | my $testdir = $$self{'testdir'}; | |
| 828 | ||
| 829 | # Input file | |
| 830 | ||
| 831 | if ($input) { | |
| 832 | if (-r $input) { | |
| 833 | # Nothing | |
| 834 | ||
| 835 | } elsif (-r "$testdir/$input") { | |
| 836 | $input = "$testdir/$input"; | |
| 837 | ||
| 838 | } else { | |
| 839 | $self->_die("Input file not readable: $input"); | |
| 840 | } | |
| 841 | push(@funcargs,$input); | |
| 842 | } | |
| 843 | ||
| 844 | # Output file and directory | |
| 845 | ||
| 846 | $outputdir = $testdir if (! $outputdir); | |
| 847 | if ($outputdir) { | |
| 848 | if (! -d $outputdir || | |
| 849 | ! -w $outputdir) { | |
| 850 | $self->_die("Output directory not writable: $outputdir"); | |
| 851 | } | |
| 852 | } | |
| 853 | my $output = "$outputdir/tmp_test_inter"; | |
| 854 | push(@funcargs,$output); | |
| 855 | ||
| 856 | # Expected output | |
| 857 | ||
| 858 | if (! $expected) { | |
| 859 | $self->_die("Expected output file not specified"); | |
| 860 | ||
| 861 | } elsif (-r $expected) { | |
| 862 | # Nothing | |
| 863 | ||
| 864 | } elsif (-r "$testdir/$expected") { | |
| 865 | $expected = "$testdir/$expected"; | |
| 866 | ||
| 867 | } else { | |
| 868 | $self->_die("Expected output file not readable: $expected"); | |
| 869 | } | |
| 870 | ||
| 871 | # Create the temporary output file. | |
| 872 | ||
| 873 | &$func(@funcargs,@args); | |
| 874 | if (! -r "$output") { | |
| 875 | $self->_die("Output file not created"); | |
| 876 | } | |
| 877 | ||
| 878 | # Test each line | |
| 879 | ||
| 880 | my $in = new IO::File; | |
| 881 | $in->open($output); | |
| 882 | my @out = <$in>; | |
| 883 | $in->close(); | |
| 884 | chomp(@out); | |
| 885 | ||
| 886 | $in->open($expected); | |
| 887 | my @exp = <$in>; | |
| 888 | $in->close(); | |
| 889 | chomp(@exp); | |
| 890 | unlink($output); | |
| 891 | ||
| 892 | while (@out < @exp) { | |
| 893 | push(@out,''); | |
| 894 | } | |
| 895 | while (@exp < @out) { | |
| 896 | push(@exp,''); | |
| 897 | } | |
| 898 | ||
| 899 | for (my $i=0; $i<@out; $i++) { | |
| 900 | my $line = $i+1; | |
| 901 | my $n = ($name ? "$name : Line $line" : "Line $line"); | |
| 902 | $self->_is('is',$out[$i],$exp[$i],$n); | |
| 903 | } | |
| 904 | } | |
| 905 | ||
| 906 | ############################################################################### | |
| 907 | # TESTS METHOD | |
| 908 | ############################################################################### | |
| 909 | ||
| 910 | sub tests { | |
| 911 | my($self,%opts) = @_; | |
| 912 | ||
| 913 | # | |
| 914 | # feature => [ FEATURE, FEATURE, ... ] | |
| 915 | # disable => [ FEATURE, FEATURE, ... ] | |
| 916 | # | |
| 917 | ||
| 918 | my $skip = ''; | |
| 919 | if (exists $opts{'feature'}) { | |
| 920 | foreach my $feature (@{ $opts{'feature'} }) { | |
| 921 | $skip = "Required feature unavailable: $feature", last | |
| 922 | if (! exists $$self{'features'}{$feature}); | |
| 923 | } | |
| 924 | } | |
| 925 | if (exists $opts{'disable'} && ! $skip) { | |
| 926 | foreach my $feature (@{ $opts{'disable'} }) { | |
| 927 | $skip = "Disabled due to feature being available: $feature", last | |
| 928 | if (exists $$self{'features'}{$feature}); | |
| 929 | } | |
| 930 | } | |
| 931 | ||
| 932 | # | |
| 933 | # name => NAME | |
| 934 | # skip => REASON | |
| 935 | # todo => 0/1 | |
| 936 | # | |
| 937 | ||
| 938 | my $name = ''; | |
| 939 | if (exists $opts{'name'}) { | |
| 940 | $name = $opts{'name'}; | |
| 941 | } | |
| 942 | ||
| 943 | if (exists $opts{'skip'}) { | |
| 944 | $skip = $opts{'skip'}; | |
| 945 | } | |
| 946 | ||
| 947 | my $todo = 0; | |
| 948 | if (exists $opts{'todo'}) { | |
| 949 | $todo = $opts{'todo'}; | |
| 950 | } | |
| 951 | ||
| 952 | # | |
| 953 | # tests => STRING OR LISTREF | |
| 954 | # func => CODEREF | |
| 955 | # expected => STRING OR LISTREF | |
| 956 | # | |
| 957 | ||
| 958 | # tests | |
| 959 | if (! exists $opts{'tests'}) { | |
| 960 | $self->_die("invalid test format: tests required"); | |
| 961 | } | |
| 962 | my $tests = $opts{'tests'}; | |
| 963 | my(%tests,$gotexpected); | |
| 964 | ||
| 965 | my($ntest,$nexp); | |
| 966 | if (ref($tests) eq 'ARRAY') { | |
| 967 | my @results = @$tests; | |
| 968 | $ntest = 0; | |
| 969 | foreach my $result (@results) { | |
| 970 | $ntest++; | |
| 971 | $tests{$ntest}{'err'} = 0; | |
| 972 | if (ref($result) eq 'ARRAY') { | |
| 973 | $tests{$ntest}{'args'} = $result; | |
| 974 | } else { | |
| 975 | $tests{$ntest}{'args'} = [$result]; | |
| 976 | } | |
| 977 | } | |
| 978 | $gotexpected = 0; | |
| 979 | ||
| 980 | } else { | |
| 981 | ($ntest,$gotexpected,%tests) = $self->_parse($tests); | |
| 982 | $nexp = $ntest if ($gotexpected); | |
| 983 | } | |
| 984 | ||
| 985 | # expected | |
| 986 | if (exists $opts{'expected'}) { | |
| 987 | if ($gotexpected) { | |
| 988 | $self->_die("invalid test format: expected results included twice"); | |
| 989 | } | |
| 990 | my $expected = $opts{'expected'}; | |
| 991 | ||
| 992 | if (ref($expected) eq 'ARRAY') { | |
| 993 | my @exp = @$expected; | |
| 994 | $nexp = 0; | |
| 995 | foreach my $exp (@exp) { | |
| 996 | $nexp++; | |
| 997 | if (ref($exp) eq 'ARRAY') { | |
| 998 | $tests{$nexp}{'expected'} = $exp; | |
| 999 | } else { | |
| 1000 | $tests{$nexp}{'expected'} = [$exp]; | |
| 1001 | } | |
| 1002 | } | |
| 1003 | ||
| 1004 | } else { | |
| 1005 | my($g,%t); | |
| 1006 | ($nexp,$g,%t) = $self->_parse($expected); | |
| 1007 | if ($g) { | |
| 1008 | $self->_die("invalid test format: expected results contain '=>'"); | |
| 1009 | } | |
| 1010 | foreach my $t (1..$nexp) { | |
| 1011 | $tests{$t}{'expected'} = $t{$t}{'args'}; | |
| 1012 | } | |
| 1013 | } | |
| 1014 | $gotexpected = 1; | |
| 1015 | } | |
| 1016 | ||
| 1017 | if ($gotexpected && | |
| 1018 | ($nexp != 1 && $nexp != $ntest)) { | |
| 1019 | $self->_die("invalid test format: number expected results differs from number of tests"); | |
| 1020 | } | |
| 1021 | ||
| 1022 | # func | |
| 1023 | my $func; | |
| 1024 | if (exists $opts{'func'}) { | |
| 1025 | $func = $opts{'func'}; | |
| 1026 | if (ref($func) ne 'CODE') { | |
| 1027 | $self->_die("invalid test format: func must be a code reference"); | |
| 1028 | } | |
| 1029 | } | |
| 1030 | ||
| 1031 | # | |
| 1032 | # Compare results | |
| 1033 | # | |
| 1034 | ||
| 1035 | foreach my $t (1..$ntest) { | |
| 1036 | $main::TI_NUM++; | |
| 1037 | ||
| 1038 | if ($skip) { | |
| 1039 | $self->_skip($skip,$name); | |
| 1040 | next; | |
| 1041 | } | |
| 1042 | ||
| 1043 | if ($tests{$t}{'err'}) { | |
| 1044 | $self->_not_ok($name); | |
| 1045 | $self->diag($tests{$t}{'err'}); | |
| 1046 | next; | |
| 1047 | } | |
| 1048 | ||
| 1049 | my($op,@ret); | |
| 1050 | ||
| 1051 | # Test results | |
| 1052 | ||
| 1053 | if ($gotexpected) { | |
| 1054 | # Do an 'is' test | |
| 1055 | ||
| 1056 | my @a = ('is'); | |
| 1057 | push(@a,$func) if ($func); | |
| 1058 | push(@a,$tests{$t}{'args'}); | |
| 1059 | push(@a,($nexp == 1 ? $tests{'1'}{'expected'} | |
| 1060 | : $tests{$t}{'expected'})); | |
| 1061 | push(@a,$name); | |
| 1062 | ||
| 1063 | ($op,@ret) = $self->_is_result(@a); | |
| 1064 | ||
| 1065 | } else { | |
| 1066 | # Do an 'ok' test | |
| 1067 | ||
| 1068 | my $result = $tests{$t}{'args'}; | |
| 1069 | if (@$result == 1) { | |
| 1070 | $result = $$result[0]; | |
| 1071 | } | |
| 1072 | ($op,@ret) = $self->_ok_result($result,$name); | |
| 1073 | } | |
| 1074 | ||
| 1075 | # Print it out | |
| 1076 | ||
| 1077 | my($name,@diag); | |
| 1078 | my $ok = 1; | |
| 1079 | ||
| 1080 | if ($op eq 'skip') { | |
| 1081 | my $reason = shift(@ret); | |
| 1082 | $self->_skip($reason); | |
| 1083 | ||
| 1084 | } elsif ($op eq 'pass') { | |
| 1085 | ($name,@diag) = @ret; | |
| 1086 | $self->_ok($name); | |
| 1087 | ||
| 1088 | } else { | |
| 1089 | ($name,@diag) = @ret; | |
| 1090 | $self->_not_ok($name); | |
| 1091 | $ok = 0; | |
| 1092 | } | |
| 1093 | ||
| 1094 | next | |
| 1095 | if ( ($ok && $$self{'quiet'}) || | |
| 1096 | (! $ok && $$self{'quiet'} == 2) ); | |
| 1097 | ||
| 1098 | foreach my $diag (@diag) { | |
| 1099 | $self->_diag($diag); | |
| 1100 | } | |
| 1101 | } | |
| 1102 | } | |
| 1103 | ||
| 1104 | ############################################################################### | |
| 1105 | # TAP METHODS | |
| 1106 | ############################################################################### | |
| 1107 | ||
| 1108 | sub _diag { | |
| 1109 | my($self,$message) = @_; | |
| 1110 | print '#' . ' 'x10 . "$message\n"; | |
| 1111 | } | |
| 1112 | ||
| 1113 | sub _plan { | |
| 1114 | my($self,$n,$reason) = @_; | |
| 1115 | $reason = '' if (! $reason); | |
| 1116 | ||
| 1117 | if ($$self{'mode'} eq 'test') { | |
| 1118 | ||
| 1119 | # Test mode | |
| 1120 | ||
| 1121 | if (! $n) { | |
| 1122 | $reason = '' if (! $reason); | |
| 1123 | print "1..0 # Skipped $reason\n"; | |
| 1124 | return; | |
| 1125 | } | |
| 1126 | ||
| 1127 | print "1..$n\n"; | |
| 1128 | ||
| 1129 | } else { | |
| 1130 | ||
| 1131 | if (! $n) { | |
| 1132 | print " All tests skipped: $reason\n"; | |
| 1133 | } else { | |
| 1134 | print " Epected number of tests: $n\n" | |
| 1135 | unless ($$self{'quiet'}); | |
| 1136 | } | |
| 1137 | } | |
| 1138 | } | |
| 1139 | ||
| 1140 | sub _ok { | |
| 1141 | my($self,$name) = @_; | |
| 1142 | ||
| 1143 | $name = '' if (! $name); | |
| 1144 | $name =~ s/\#//; | |
| 1145 | ||
| 1146 | $$self{'testsrun'} = 1; | |
| 1147 | ||
| 1148 | return if ($$self{'mode'} ne 'test' && | |
| 1149 | $$self{'quiet'}); | |
| 1150 | ||
| 1151 | print "ok $main::TI_NUM" . ' 'x(8-length($main::TI_NUM)) . "$name\n"; | |
| 1152 | ||
| 1153 | if ($name =~ /^\d/ && $$self{'quiet'} != 2) { | |
| 1154 | $self->_diag('It is strongly recommended that the name of a test not'); | |
| 1155 | $self->_diag('begin with a digit so it will not be confused with the'); | |
| 1156 | $self->_diag('test number.'); | |
| 1157 | } | |
| 1158 | } | |
| 1159 | ||
| 1160 | sub _not_ok { | |
| 1161 | my($self,$name) = @_; | |
| 1162 | $name = '' if (! $name); | |
| 1163 | $name =~ s/\#//; | |
| 1164 | ||
| 1165 | $$self{'testsrun'} = 1; | |
| 1166 | ||
| 1167 | print "not ok $main::TI_NUM" . ' 'x(4-length($main::TI_NUM)) . "$name\n"; | |
| 1168 | ||
| 1169 | if ($$self{'abort'} == 2) { | |
| 1170 | exit 1; | |
| 1171 | } elsif ($$self{'abort'}) { | |
| 1172 | $$self{'skipall'} = 'Tests aborted due to failed test'; | |
| 1173 | } | |
| 1174 | } | |
| 1175 | ||
| 1176 | sub _skip { | |
| 1177 | my($self,$reason,$name) = @_; | |
| 1178 | $name = '' if (! $name); | |
| 1179 | $name =~ s/\#//; | |
| 1180 | ||
| 1181 | $$self{'testsrun'} = 1; | |
| 1182 | ||
| 1183 | return if ($$self{'mode'} ne 'test' && | |
| 1184 | $$self{'quiet'}); | |
| 1185 | ||
| 1186 | print "ok $main::TI_NUM" . ' 'x(8-length($main::TI_NUM)) . | |
| 1187 | ($name ? "$name " : "") . "# SKIPPED $reason\n"; | |
| 1188 | } | |
| 1189 | ||
| 1190 | ############################################################################### | |
| 1191 | # TEST PARSING METHODS | |
| 1192 | ############################################################################### | |
| 1193 | ||
| 1194 | { | |
| 1195 | my $l; # current line number | |
| 1196 | my $sp_opt = qr/\s*/; # optional whitespace | |
| 1197 | my $sp = qr/\s+/; # required whitespace | |
| 1198 | my $lparen = qr/\(/; # opening paren | |
| 1199 | my $lbrack = qr/\[/; # opening brack | |
| 1200 | my $lbrace = qr/\{/; # opening brace | |
| 1201 | my $q = qr/\'/; # single quote | |
| 1202 | my $qq = qr/\"/; # double quote | |
| 1203 | my $token = qr/\S+/; # a token of non-whitespace characters | |
| 1204 | my $min_str = qr/.*?/; # a minimum length string | |
| 1205 | my $results = qr/=>/; # the string to switch to results | |
| 1206 | ||
| 1207 | # We'll also need to match delimiters and other special characters that | |
| 1208 | # signal the end of a token. The default delimiter is just whitespace, | |
| 1209 | # both other end-of-token regular expressions will include closing | |
| 1210 | # parens, delimiters, etc. | |
| 1211 | # | |
| 1212 | # The end-of-token regexp will return a match for a special character (if | |
| 1213 | # any) that terminates the token. If a token ends a whitespace or EOL, | |
| 1214 | # nothing is matched. | |
| 1215 | # | |
| 1216 | my $eot = qr/()(?:\s+|$)/; | |
| 1217 | ||
| 1218 | # Allowed delimiters is anything except () [] {} alphanumeric, | |
| 1219 | # underscore, and whitespace. | |
| 1220 | # | |
| 1221 | my $delim = qr/[^\'\"\(\)\[\]\{\}a-zA-Z0-9_ \t]/; | |
| 1222 | ||
| 1223 | # This takes a string which may contain a partial or complete | |
| 1224 | # descritpion of any number of tests, and parses it. | |
| 1225 | # | |
| 1226 | # The string is multiline, and tests must be separated from each other | |
| 1227 | # by one or more blank lines. Lines starting with a pound sign (#) | |
| 1228 | # are comments. | |
| 1229 | # | |
| 1230 | # A test may include arguments (or obtained results), expected results, | |
| 1231 | # or both. | |
| 1232 | # | |
| 1233 | # Returns | |
| 1234 | # ($n,$gotboth,%tests) | |
| 1235 | # where | |
| 1236 | # $n is the number of tests | |
| 1237 | # $gotboth is 1 if both arguments and expected results are obtained | |
| 1238 | # $tests{$i} is the i'th test. | |
| 1239 | # | |
| 1240 | sub _parse { | |
| 1241 | my($self,$string) = @_; | |
| 1242 | my $t = 0; | |
| 1243 | my $gotboth = -1; | |
| 1244 | my %tests = (); | |
| 1245 | ||
| 1246 | # Split on newlines | |
| 1247 | $string = [ split(/\n/s,$string) ]; | |
| 1248 | ||
| 1249 | $t = 0; | |
| 1250 | while (@$string) { | |
| 1251 | my $test = $self->_next_test($string); | |
| 1252 | last if (! @$test); | |
| 1253 | ||
| 1254 | # All tests must contain both args/results OR only one of them. | |
| 1255 | my ($err,$both,$args,$results) = $self->_parse_test($test); | |
| 1256 | if ($gotboth == -1) { | |
| 1257 | $gotboth = $both; | |
| 1258 | } elsif ($gotboth != $both) { | |
| 1259 | $err = "Malformed test [$l]: expected results for some tests, not others"; | |
| 1260 | } | |
| 1261 | ||
| 1262 | $t++; | |
| 1263 | $tests{$t}{'err'} = $err; | |
| 1264 | $tests{$t}{'args'} = $args; | |
| 1265 | $tests{$t}{'expected'} = $results if ($gotboth); | |
| 1266 | } | |
| 1267 | ||
| 1268 | return ($t,$gotboth,%tests); | |
| 1269 | } | |
| 1270 | ||
| 1271 | # Get all lines up to the end of lines or a blank line. Both | |
| 1272 | # signal the end of a test. | |
| 1273 | # | |
| 1274 | sub _next_test { | |
| 1275 | my($self,$list) = @_; | |
| 1276 | my @test; | |
| 1277 | my $started = 0; | |
| 1278 | ||
| 1279 | while (1) { | |
| 1280 | last if (! @$list); | |
| 1281 | my $line = shift(@$list); | |
| 1282 | ||
| 1283 | $line =~ s/^\s*//; | |
| 1284 | $line =~ s/\s*$//; | |
| 1285 | ||
| 1286 | # If it's a blank line, add it to the test. If we've | |
| 1287 | # already done test lines, then this signals the end | |
| 1288 | # of the test. Otherwise, this is before the test, | |
| 1289 | # so keep looking. | |
| 1290 | if ($line eq '') { | |
| 1291 | push(@test,$line); | |
| 1292 | next if (! $started); | |
| 1293 | last; | |
| 1294 | } | |
| 1295 | ||
| 1296 | # Comments are added to the test as a blank line. | |
| 1297 | if ($line =~ /^#/) { | |
| 1298 | push(@test,''); | |
| 1299 | next; | |
| 1300 | } | |
| 1301 | ||
| 1302 | push(@test,$line); | |
| 1303 | $started = 1; | |
| 1304 | } | |
| 1305 | ||
| 1306 | return [] if (! $started); | |
| 1307 | return \@test; | |
| 1308 | } | |
| 1309 | ||
| 1310 | # Parse an entire test. Look for arguments, =>, and expected results. | |
| 1311 | # | |
| 1312 | sub _parse_test { | |
| 1313 | my($self,$test) = @_; | |
| 1314 | my($err,$both,@args,@results); | |
| 1315 | ||
| 1316 | my $curr = 'args'; | |
| 1317 | ||
| 1318 | while (@$test) { | |
| 1319 | ||
| 1320 | last if (! $self->_test_line($test)); | |
| 1321 | ||
| 1322 | # Check for '=>' | |
| 1323 | ||
| 1324 | if ($self->_parse_begin_results($test)) { | |
| 1325 | if ($curr eq 'args') { | |
| 1326 | $curr = 'results'; | |
| 1327 | } else { | |
| 1328 | return ("Malformed test [$l]: '=>' found twice"); | |
| 1329 | } | |
| 1330 | next; | |
| 1331 | } | |
| 1332 | ||
| 1333 | # Get the next item(s) to add. | |
| 1334 | ||
| 1335 | my($err,$match,@val) = $self->_parse_token($test,$eot); | |
| 1336 | return ($err) if ($err); | |
| 1337 | ||
| 1338 | if ($curr eq 'args') { | |
| 1339 | push(@args,@val); | |
| 1340 | } else { | |
| 1341 | push(@results,@val); | |
| 1342 | } | |
| 1343 | } | |
| 1344 | ||
| 1345 | $both = ($curr eq 'results' ? 1 : 0); | |
| 1346 | return ("",$both,\@args,\@results); | |
| 1347 | } | |
| 1348 | ||
| 1349 | # Makes sure that the first line in the test contains | |
| 1350 | # something. Blank lines are ignored. | |
| 1351 | # | |
| 1352 | sub _test_line { | |
| 1353 | my($self,$test) = @_; | |
| 1354 | ||
| 1355 | while (@$test && | |
| 1356 | (! defined($$test[0]) || | |
| 1357 | $$test[0] eq '')) { | |
| 1358 | shift(@$test); | |
| 1359 | $l++; | |
| 1360 | next; | |
| 1361 | } | |
| 1362 | return 1 if (@$test); | |
| 1363 | return 0; | |
| 1364 | } | |
| 1365 | ||
| 1366 | # Check for '=>'. | |
| 1367 | # | |
| 1368 | # Return 1 if found, 0 otherwise. | |
| 1369 | # | |
| 1370 | sub _parse_begin_results { | |
| 1371 | my($self,$test) = @_; | |
| 1372 | ||
| 1373 | return 1 if ($$test[0] =~ s/^ $sp_opt $results $eot //x); | |
| 1374 | return 0; | |
| 1375 | } | |
| 1376 | ||
| 1377 | # Gets the next item to add to the current list. | |
| 1378 | # | |
| 1379 | # Returns ($err,$match,@val) where $match is the character that | |
| 1380 | # matched the end of the current element (either a delimiter, | |
| 1381 | # closing character, or nothing if the element ends on | |
| 1382 | # whitespace/newline). | |
| 1383 | # | |
| 1384 | sub _parse_token { | |
| 1385 | my($self,$test,$EOT) = @_; | |
| 1386 | ||
| 1387 | my($err,$found,$match,@val); | |
| 1388 | ||
| 1389 | { | |
| 1390 | last if (! $self->_test_line($test)); | |
| 1391 | ||
| 1392 | # Check for quoted | |
| 1393 | ||
| 1394 | ($err,$found,$match,@val) = $self->_parse_quoted($test,$EOT); | |
| 1395 | last if ($found || $err); | |
| 1396 | ||
| 1397 | # Check for open | |
| 1398 | ||
| 1399 | ($err,$found,$match,@val) = $self->_parse_open_close($test,$EOT,$lparen,')'); | |
| 1400 | last if ($found || $err); | |
| 1401 | ||
| 1402 | ($err,$found,$match,@val) = $self->_parse_open_close($test,$EOT,$lbrack,']'); | |
| 1403 | last if ($err); | |
| 1404 | if ($found) { | |
| 1405 | @val = ( [@val] ); | |
| 1406 | last; | |
| 1407 | } | |
| 1408 | ||
| 1409 | ($err,$found,$match,@val) = $self->_parse_open_close($test,$EOT,$lbrace,'}'); | |
| 1410 | last if ($err); | |
| 1411 | if ($found) { | |
| 1412 | if (@val % 2 == 0) { | |
| 1413 | # Even number of elements | |
| 1414 | @val = ( {@val} ); | |
| 1415 | } elsif (! defined $val[$#val] || | |
| 1416 | $val[$#val] eq '') { | |
| 1417 | # Odd number of elements with nothing as the | |
| 1418 | # last element. | |
| 1419 | pop(@val); | |
| 1420 | @val = ( {@val} ); | |
| 1421 | } else { | |
| 1422 | # Odd number of elements not supported for a hash | |
| 1423 | $err = "Malformed test [$l]: hash with odd number of elements"; | |
| 1424 | } | |
| 1425 | last; | |
| 1426 | } | |
| 1427 | ||
| 1428 | # Check for some other token | |
| 1429 | ||
| 1430 | ($err,$found,$match,@val) = $self->_parse_simple_token($test,$EOT); | |
| 1431 | last if ($err); | |
| 1432 | ||
| 1433 | last; | |
| 1434 | } | |
| 1435 | ||
| 1436 | return ($err) if ($err); | |
| 1437 | return ("Malformed test: unable to parse") if (! $found); | |
| 1438 | ||
| 1439 | foreach my $v (@val) { | |
| 1440 | $v = '' if ($v eq '__blank__'); | |
| 1441 | $v = undef if ($v eq '__undef__'); | |
| 1442 | } | |
| 1443 | return (0,$match,@val) if ($found); | |
| 1444 | return (0,0); | |
| 1445 | } | |
| 1446 | ||
| 1447 | ### | |
| 1448 | ### The next few routines parse parts of the test. Each of them | |
| 1449 | ### take as arguments: | |
| 1450 | ### | |
| 1451 | ### $test : the listref containing the unparsed portion of | |
| 1452 | ### the test | |
| 1453 | ### $EOT : the end of a token | |
| 1454 | ### | |
| 1455 | ### + other args as needed. | |
| 1456 | ### | |
| 1457 | ### They all return: | |
| 1458 | ### | |
| 1459 | ### $err : a string containing the error (if any) | |
| 1460 | ### $found : 1 if something matched | |
| 1461 | ### $match : the character which terminates the current | |
| 1462 | ### token signaling the start of the next token | |
| 1463 | ### (this will either be a delimiter, a closing | |
| 1464 | ### character, or nothing if the string ended on | |
| 1465 | ### whitespace or a newline) | |
| 1466 | ### @val : the value (or values) of the token | |
| 1467 | ### | |
| 1468 | ||
| 1469 | # Check for a quoted string | |
| 1470 | # 'STRING' | |
| 1471 | # "STRING" | |
| 1472 | # The string must be on one line, and everything up to the | |
| 1473 | # closing quote is included (the quotes themselves are | |
| 1474 | # stripped). | |
| 1475 | # | |
| 1476 | sub _parse_quoted { | |
| 1477 | my($self,$test,$EOT) = @_; | |
| 1478 | ||
| 1479 | if ($$test[0] =~ s/^ $sp_opt $q ($min_str) $q $EOT//x || | |
| 1480 | $$test[0] =~ s/^ $sp_opt $qq ($min_str) $qq $EOT//x) { | |
| 1481 | return (0,1,$2,$1); | |
| 1482 | ||
| 1483 | } elsif ($$test[0] =~ /^ $sp_opt $q/x || | |
| 1484 | $$test[0] =~ /^ $sp_opt $qq/x) { | |
| 1485 | return ("Malformed test [$l]: improper quoting"); | |
| 1486 | } | |
| 1487 | return (0,0); | |
| 1488 | } | |
| 1489 | ||
| 1490 | # Parses an open/close section. | |
| 1491 | # | |
| 1492 | # ( TOKEN TOKEN ... ) | |
| 1493 | # (, TOKEN, TOKEN, ... ) | |
| 1494 | # | |
| 1495 | # $open is a regular expression matching the open, $close is the | |
| 1496 | # actual closing character. | |
| 1497 | # | |
| 1498 | # After the closing character must be an $EOT. | |
| 1499 | # | |
| 1500 | sub _parse_open_close { | |
| 1501 | my($self,$test,$EOT,$open,$close) = @_; | |
| 1502 | ||
| 1503 | # See if there is an open | |
| 1504 | ||
| 1505 | my($del,$newEOT); | |
| 1506 | if ($$test[0] =~ s/^ $sp_opt $open ($delim) $sp_opt //x) { | |
| 1507 | $del = $1; | |
| 1508 | $newEOT = qr/ $sp_opt ($|\Q$del\E|\Q$close\E) /x; | |
| 1509 | ||
| 1510 | } elsif ($$test[0] =~ s/^ $sp_opt $open $sp_opt //x) { | |
| 1511 | $del = ''; | |
| 1512 | $newEOT = qr/ ($sp_opt $|$sp_opt \Q$close\E|$sp) /x; | |
| 1513 | ||
| 1514 | } else { | |
| 1515 | return (0,0); | |
| 1516 | } | |
| 1517 | ||
| 1518 | # If there was, then we need to read tokens until either: | |
| 1519 | # the string is all used up => error | |
| 1520 | # $close is found | |
| 1521 | ||
| 1522 | my($match,@val); | |
| 1523 | while (1) { | |
| 1524 | ||
| 1525 | # Get a token. We MUST find something valid even if it is | |
| 1526 | # an empty list followed by the closing character. | |
| 1527 | my($e,$m,@v) = $self->_parse_token($test,$newEOT); | |
| 1528 | return ($e) if ($e); | |
| 1529 | $m =~ s/^$sp//; | |
| 1530 | ||
| 1531 | # If we ended on nothing, and $del is something, then we | |
| 1532 | # ended on a newline with no delimiter. The next line MUST | |
| 1533 | # start with a delimiter or close character or the test is | |
| 1534 | # invalid. | |
| 1535 | ||
| 1536 | if (! $m && $del) { | |
| 1537 | ||
| 1538 | if (! $self->_test_line($test)) { | |
| 1539 | return ("Malformed test [$l]: premature end of test"); | |
| 1540 | } | |
| 1541 | ||
| 1542 | if ($$test[0] =~ s/^ $sp_opt $newEOT //x) { | |
| 1543 | $m = $1; | |
| 1544 | } else { | |
| 1545 | return ("Malformed test [$l]: unexpected token (expected '$close' or '$del')"); | |
| 1546 | } | |
| 1547 | } | |
| 1548 | ||
| 1549 | # Figure out what value(s) were returned | |
| 1550 | if ($m eq $close && ! @v) { | |
| 1551 | push(@val,''); | |
| 1552 | } else { | |
| 1553 | push(@val,@v); | |
| 1554 | } | |
| 1555 | ||
| 1556 | last if ($m eq $close); | |
| 1557 | ||
| 1558 | } | |
| 1559 | ||
| 1560 | # Now we need to find out what character ends this token: | |
| 1561 | ||
| 1562 | if ($$test[0] eq '') { | |
| 1563 | # Ended at EOL | |
| 1564 | return (0,1,'',@val); | |
| 1565 | } | |
| 1566 | if ($$test[0] =~ s/^ $sp_opt $EOT //x) { | |
| 1567 | return (0,1,$1,@val); | |
| 1568 | } else { | |
| 1569 | return ("Malformed test [$l]: unexpected token"); | |
| 1570 | } | |
| 1571 | } | |
| 1572 | ||
| 1573 | # Checks for a simple token. | |
| 1574 | # | |
| 1575 | sub _parse_simple_token { | |
| 1576 | my($self,$test,$EOT) = @_; | |
| 1577 | ||
| 1578 | $$test[0] =~ s/^ $sp_opt (.*?) $EOT//x; | |
| 1579 | return (0,1,$2,$1); | |
| 1580 | } | |
| 1581 | } | |
| 1582 | ||
| 1583 | 1; | |
| 1584 | # Local Variables: | |
| 1585 | # mode: cperl | |
| 1586 | # indent-tabs-mode: nil | |
| 1587 | # cperl-indent-level: 3 | |
| 1588 | # cperl-continued-statement-offset: 2 | |
| 1589 | # cperl-continued-brace-offset: 0 | |
| 1590 | # cperl-brace-offset: 0 | |
| 1591 | # cperl-brace-imaginary-offset: 0 | |
| 1592 | # cperl-label-offset: -2 | |
| 1593 | # End: |
| 0 | # Copyright (c) 2010-2010 Sullivan Beck. All rights reserved. | |
| 1 | # This program is free software; you can redistribute it and/or modify it | |
| 2 | # under the same terms as Perl itself. | |
| 3 | ||
| 4 | =pod | |
| 5 | ||
| 6 | =head1 NAME | |
| 7 | ||
| 8 | Test::Inter - framework for more readable interactive test scripts | |
| 9 | ||
| 10 | =head1 DESCRIPTION | |
| 11 | ||
| 12 | This is another framework for writing test scripts. It is loosely | |
| 13 | inspired by Test::More, and has most of it's functionality, but it is | |
| 14 | not a drop-in replacement. | |
| 15 | ||
| 16 | Test::More (and other existing test frameworks) suffer from two | |
| 17 | weaknesses, both of which have prevented me from ever using them: | |
| 18 | ||
| 19 | None offer the ability to access specific tests in | |
| 20 | a reasonably interactive fashion | |
| 21 | ||
| 22 | None offer the ability to write the tests in | |
| 23 | whatever format would make the tests the most | |
| 24 | readable | |
| 25 | ||
| 26 | The way I write and use test scripts, existing Test::* modules are not | |
| 27 | nearly as useful as they could be. Test scripts written using | |
| 28 | Test::More work fine when running as part of the test suite, but | |
| 29 | debugging an individual test requires extra steps, and the tests | |
| 30 | themselves are not as readable as they should be. | |
| 31 | ||
| 32 | I do most of my debugging using test scripts. When I find a bug, I | |
| 33 | write a test case for it, debug it using the test script, and then | |
| 34 | leave the test there so the bug won't come back (hopefully). | |
| 35 | ||
| 36 | Since I use test scripts in two ways (part of a standard test suite | |
| 37 | and to run the scripts in some interactive way to debug problems), | |
| 38 | I want to be able to do the follwing trivially: | |
| 39 | ||
| 40 | =over 4 | |
| 41 | ||
| 42 | =item B<Easy access to a specific test or tests> | |
| 43 | ||
| 44 | If I'm running the test script interactively (perhaps in the debugger), | |
| 45 | there are several common functions that I want to have available, | |
| 46 | including: | |
| 47 | ||
| 48 | Run only a single test, or a subset of tests | |
| 49 | ||
| 50 | Set a breakpoint in the debugger to run | |
| 51 | up to the start of the Nth test | |
| 52 | ||
| 53 | =item B<Better diagnostics> | |
| 54 | ||
| 55 | When running a test script as part of a test suite, the pass/fail | |
| 56 | status is really the only thing of interest. You just want to know if | |
| 57 | the module passes all the tests. | |
| 58 | ||
| 59 | When running interactively, additional information may allow me to | |
| 60 | quickly track down the problem without even resorting to a debugger. | |
| 61 | ||
| 62 | If a test fails, I almost always want to see why it failed if I'm | |
| 63 | running it interactively. If reasonable, I want to see a list of what | |
| 64 | was input, what was output, and what was expected. | |
| 65 | ||
| 66 | =back | |
| 67 | ||
| 68 | The other feature that I wanted in a test suite is the ability to | |
| 69 | define the tests in a readable format. In almost every case, it | |
| 70 | is best to think of a test script as consisting of two separate | |
| 71 | parts: a script part, and a test part, and the more you can | |
| 72 | keep the two separate, the better. | |
| 73 | ||
| 74 | The script part of a test script is the least important part! It's | |
| 75 | usually fairly trivial, rarely needs to be changed, and is quite | |
| 76 | simply not the focus of the test script. | |
| 77 | ||
| 78 | The tests part of the script IS the important part, and these should | |
| 79 | be expressed in a form that is easy to maintain, easy to read, and | |
| 80 | easy to modify, and none of these should involve modifying the | |
| 81 | script portion of the test script in general. As a general rule, | |
| 82 | if the script portion of the test script obscures the tests in any | |
| 83 | way, it's not written correctly! | |
| 84 | ||
| 85 | Compare this to any other systems where you are mixing two | |
| 86 | "languages". For example, a PHP script where you have a mixture of PHP | |
| 87 | and HTML or a templating system consisting of text and template | |
| 88 | commands. The more the two languages are interwoven, the less readable | |
| 89 | both are, and the harder it is to maintain. | |
| 90 | ||
| 91 | As often as possible, I want the tests to be written in some sort of | |
| 92 | text format which can be easily read as a table with no perl commands | |
| 93 | interspersed. I want to the freedom to define the tests in one big | |
| 94 | string (perhaps a DATA section, or even in a separate file) which is | |
| 95 | easily readable. This may introduce the necessity of parsing it, but | |
| 96 | it makes it significantly easier to maintain the tests. | |
| 97 | ||
| 98 | This flexibilty makes it much easier to read the tests (as opposed to | |
| 99 | the script) which is the fundamental content of a test script. | |
| 100 | ||
| 101 | To illustrate some of this, in Test::More, a series of tests might be | |
| 102 | specified as: | |
| 103 | ||
| 104 | # test 1 | |
| 105 | $result = func("apples","bushels"); | |
| 106 | is($result, "enough"); | |
| 107 | ||
| 108 | # test 2 | |
| 109 | $result = func("grapefruit","tons"); | |
| 110 | is($result, "enough"); | |
| 111 | ||
| 112 | # test 3 | |
| 113 | $result = func("oranges","boatloads"); | |
| 114 | is($result, "insufficient"); | |
| 115 | ||
| 116 | Thinking about the features I want that I listed above, there are | |
| 117 | several difficulties with this. | |
| 118 | ||
| 119 | =over 4 | |
| 120 | ||
| 121 | =item B<Debugging the script is tedious> | |
| 122 | ||
| 123 | To debug the 3rd test, I've got to do the following steps: | |
| 124 | ||
| 125 | get the line number of the 3rd func call | |
| 126 | set a breakpoint for it | |
| 127 | run the program | |
| 128 | wait for the first two tests to complete | |
| 129 | step into the function | |
| 130 | ||
| 131 | None of these steps are hard of course, but even so, getting to the | |
| 132 | first line of the test requires several steps which tend to break up | |
| 133 | your chain of thought when you want to be thinking exclusively about | |
| 134 | debugging the test. | |
| 135 | ||
| 136 | How much better to be able to say: | |
| 137 | ||
| 138 | break in func when testnum==3 | |
| 139 | ||
| 140 | =item B<Way too much perl interspersed with the tests> | |
| 141 | ||
| 142 | It's difficult to read the tests individually in this script because | |
| 143 | there is too much perl code among them, and virtually impossible to | |
| 144 | look at them as a whole. | |
| 145 | ||
| 146 | It is true that looking at this as a perl script, it is very | |
| 147 | simple... but the script ISN'T the content you're interested in. The | |
| 148 | REAL content of this script are the tests, which consist of the | |
| 149 | function arguments and the expected result. Although it's not | |
| 150 | impossible to see each of these in the script above, it's not in a | |
| 151 | format that is conducive to studying the tests, and especially not for | |
| 152 | examing the list of tests as a whole. | |
| 153 | ||
| 154 | =back | |
| 155 | ||
| 156 | Now, look at an alternate way of specifying the tests using this module: | |
| 157 | ||
| 158 | $tests = " | |
| 159 | ||
| 160 | apples bushels => enough | |
| 161 | ||
| 162 | grapefruit tons => enough | |
| 163 | ||
| 164 | oranges boatloads => insufficient | |
| 165 | ||
| 166 | "; | |
| 167 | ||
| 168 | $o->tests(tests => $tests, | |
| 169 | func => \&func); | |
| 170 | ||
| 171 | Here, it's easy to see the list of tests, and adding additional | |
| 172 | tests is a breeze. | |
| 173 | ||
| 174 | This module supports a number of methods for defining tests, so you | |
| 175 | can use whichever one is most convenient (including methods that are | |
| 176 | identical to Test::More). | |
| 177 | ||
| 178 | In addition, the following debugger command works as desired: | |
| 179 | ||
| 180 | b func ($::TI_NUM==3) | |
| 181 | ||
| 182 | and you're ready to debug. | |
| 183 | ||
| 184 | =head1 CREATING A TEST | |
| 185 | ||
| 186 | Every test may have several pieces of information: | |
| 187 | ||
| 188 | =over 4 | |
| 189 | ||
| 190 | =item B<A name> | |
| 191 | ||
| 192 | Every test is automatically assigned a number, but it may be useful to | |
| 193 | specify a name of a test (which is actually a short description of the | |
| 194 | test). Whenever a test result is reported, the name will be given (if | |
| 195 | one was specified). | |
| 196 | ||
| 197 | The name may not have a '#' in it. | |
| 198 | ||
| 199 | The name is completely optional, but makes the results more readable. | |
| 200 | ||
| 201 | =item B<An expected result> | |
| 202 | ||
| 203 | In order to test something, you need to know what result was | |
| 204 | expected (or in some cases, what result was NOT expected). | |
| 205 | ||
| 206 | =item B<A function and arguments OR a result> | |
| 207 | ||
| 208 | You also need to know the results that you're comparing to | |
| 209 | the expected results. | |
| 210 | ||
| 211 | This can be obtained by simply working with a set of results, | |
| 212 | or a function name and a set of arguments to pass to it. | |
| 213 | ||
| 214 | =item B<Conditions> | |
| 215 | ||
| 216 | It is useful to be able to specify state information at the start | |
| 217 | of the test suite (for example, to see if certain features are | |
| 218 | available), and some tests may only run if those conditions are | |
| 219 | met. | |
| 220 | ||
| 221 | If no conditions are set for a test, it will always run. | |
| 222 | ||
| 223 | =item B<Todo tests> | |
| 224 | ||
| 225 | Some tests may be marked as 'todo' tests. These are test which are | |
| 226 | allowed to fail (meaning that they have been put in place for an | |
| 227 | as-yet unimplemented feature). Since it is expected that the test | |
| 228 | will fail, the test suite will still pass, even if these tests | |
| 229 | fail. | |
| 230 | ||
| 231 | The tests will still run and if they pass, a message is issued | |
| 232 | saying that the feature is now implemented, and the tests should | |
| 233 | be graduated to non-todo state. | |
| 234 | ||
| 235 | =back | |
| 236 | ||
| 237 | =head1 BASE METHODS | |
| 238 | ||
| 239 | =over 4 | |
| 240 | ||
| 241 | =item B<new> | |
| 242 | ||
| 243 | $o = new Test::Inter [$name] [%options]; | |
| 244 | ||
| 245 | This creates a new test framework. There are several options which may | |
| 246 | be used to specify which tests are run, how they are run, and | |
| 247 | what output is given. | |
| 248 | ||
| 249 | The entire test script can be named by passing in $name. Options | |
| 250 | can be passed in as a hash of ($opt,$val) pairs. | |
| 251 | ||
| 252 | Options can be set in four different ways. First, you can pass | |
| 253 | in an ($opt,$val) pair in the new method. Second, you can set an | |
| 254 | environment variable (which overrides any value passed to the | |
| 255 | new method). Third, you can set a global variable (which overrides | |
| 256 | both the environment variable and options passed to the new method). | |
| 257 | Fouth, you can call the appropriate method to set the option. This | |
| 258 | overrides all other methods. | |
| 259 | ||
| 260 | Each of the allowed options are described below in the following base | |
| 261 | methods: | |
| 262 | ||
| 263 | start | |
| 264 | end | |
| 265 | test | |
| 266 | plan | |
| 267 | abort | |
| 268 | quiet | |
| 269 | mode | |
| 270 | skip_all | |
| 271 | ||
| 272 | =item B<version> | |
| 273 | ||
| 274 | $o->version(); | |
| 275 | ||
| 276 | Returns the version of the module. | |
| 277 | ||
| 278 | =item B<start> | |
| 279 | ||
| 280 | $o = new Test::Inter 'start' => $N; | |
| 281 | $o->start($N) | |
| 282 | ||
| 283 | To define which test you want to start with, pass in an ($opt,$val) | |
| 284 | pair of ('start',N), set an environment variable TI_START=N, or a | |
| 285 | global variable $::TI_START=N. | |
| 286 | ||
| 287 | When the start test is defined, most tests numbered less than N are | |
| 288 | completely ignored. If the tests are being run quietly (see the quiet | |
| 289 | method below), nothing is printed out for these tests. Otherwise, a | |
| 290 | skip message is printed out. | |
| 291 | ||
| 292 | One class of tests IS still executed. Tests run using the require_ok | |
| 293 | or use_ok methods (to test the loading of modules) are still run. | |
| 294 | ||
| 295 | If no value (or a value of 0) is used, it defaults to the first | |
| 296 | test. | |
| 297 | ||
| 298 | =item B<end> | |
| 299 | ||
| 300 | $o = new Test::Inter 'end' => $M; | |
| 301 | $o->end($M); | |
| 302 | ||
| 303 | To define which test you want to end with, pass in an ($opt,$val) | |
| 304 | pair of ('end',M), set an environment variable TI_END=M, or set | |
| 305 | a global variable $::TI_END=M. | |
| 306 | ||
| 307 | When the end test is defined, all tests numbered more than M are | |
| 308 | completely ignored. If the tests are being run quietly (see the quiet | |
| 309 | method below), nothing is printed out for these tests. Otherwise, a | |
| 310 | skip message is printed out. | |
| 311 | ||
| 312 | If no value is given, it defaults to 0 (which means that all reamining | |
| 313 | tests are run). | |
| 314 | ||
| 315 | =item B<testnum> | |
| 316 | ||
| 317 | $o = new Test::Inter 'testnum' => $N; | |
| 318 | $o->testnum($N); | |
| 319 | ||
| 320 | This is used to run only a single test. It is equivalent to | |
| 321 | setting both the start and end tests to $N. | |
| 322 | ||
| 323 | =item B<plan> | |
| 324 | ||
| 325 | =item B<done_testing> | |
| 326 | ||
| 327 | $o = new Test::Inter 'plan' => $N; | |
| 328 | $o->plan($n); | |
| 329 | ||
| 330 | $o->done_testing(); | |
| 331 | $o->done_testing($n); | |
| 332 | ||
| 333 | The TAP API (the 'language' used to run a sequence of tests and see | |
| 334 | which ones failed and which ones passedd) requires a statement of the | |
| 335 | number of tests that are expected to run. | |
| 336 | ||
| 337 | This statement can appear at the start of the test suite, or at | |
| 338 | the end. | |
| 339 | ||
| 340 | If you know in advance how many tests should run in the test script, | |
| 341 | you can pass in a non-zero integer in a ('plan',N) pair to the new | |
| 342 | method, or set the TI_PLAN environment variable or the $::TI_PLAN | |
| 343 | global variable, or call the plan method. | |
| 344 | ||
| 345 | If you know how many tests should run at the end of the test script, | |
| 346 | you can pass in a non-zero integer to the done_testing method. | |
| 347 | ||
| 348 | Frequently, you don't really care how many tests are in the script | |
| 349 | (especially if new tests are added on a regular basis). In this case, | |
| 350 | you still need to include a statement that says that the number of | |
| 351 | tests expected is however many were run. To do this, call the | |
| 352 | done_testing method with no argument. | |
| 353 | ||
| 354 | NOTE: if the plan method is used, it MUST be used before any tests are | |
| 355 | run (including those that test the loading of modules). If the | |
| 356 | done_testing method is used, it MUST be called after all tests are | |
| 357 | run. You must specify a plan or use a done_testing statement, but you | |
| 358 | cannot do both. | |
| 359 | ||
| 360 | It is NOT strictly required to set a plan if the script is only run | |
| 361 | interactively, so if for some reason this module is used for test | |
| 362 | scritps which are not part of a standard perl test suite, the plan | |
| 363 | and done_testing statements are optional. As a matter of fact, the | |
| 364 | script will run just fine without them... but a perl installer will | |
| 365 | report a failure in the test suite. | |
| 366 | ||
| 367 | =item B<abort> | |
| 368 | ||
| 369 | $o = new Test::Inter 'abort' => 0/1/2; | |
| 370 | $o->abort(0/1/2); | |
| 371 | ||
| 372 | The abort option can be set using an ('abort',0/1/2) option pair, or | |
| 373 | by setting the TI_ABORT environment variable, or the $::TI_ABORT | |
| 374 | global variable. | |
| 375 | ||
| 376 | If this is set to 1, the test script will run unmodified until | |
| 377 | a test fails. At that point, all remaining tests will be skipped. | |
| 378 | If it is set to 2, the test script will run until a test fails | |
| 379 | at which point it will exit with an error code of 1. | |
| 380 | ||
| 381 | In both cases, todo tests will NOT trigger the abort behavior. | |
| 382 | ||
| 383 | =item B<quiet> | |
| 384 | ||
| 385 | $o = new Test::Inter 'quiet' => 0/1/2; | |
| 386 | $o->quiet(0/1/2); | |
| 387 | ||
| 388 | The quiet option can be set using an ('quiet',0/1/2) option pair, or | |
| 389 | by setting the TI_QUIET environment variable, or the $::TI_QUIET | |
| 390 | global variable. | |
| 391 | ||
| 392 | If this is set to 0 (the default), all information will be printed | |
| 393 | out. If it is set to 1, some optional information will not be printed. | |
| 394 | If it is set to 2, all optional information will not be printed. | |
| 395 | ||
| 396 | =item B<mode> | |
| 397 | ||
| 398 | $o = new Test::Inter 'mode' => MODE; | |
| 399 | $o->mode(MODE); | |
| 400 | ||
| 401 | The mode option can be set using a ('mode',MODE) option pair, or | |
| 402 | by setting the TI_MODE environment variable, or the $::TI_MODE | |
| 403 | global variable. | |
| 404 | ||
| 405 | Currently, MODE can be 'test' or 'inter' meaning that the script | |
| 406 | is run as part of a test suite, or interactively. | |
| 407 | ||
| 408 | When run in test mode, it prints out the results using the | |
| 409 | TAP grammar (i.e. 'ok 1', 'not ok 3', etc.). | |
| 410 | ||
| 411 | When run in interactive mode, it prints out results in a more | |
| 412 | human readable format. | |
| 413 | ||
| 414 | =item B<skip_all> | |
| 415 | ||
| 416 | $o = new Test::Inter 'skip_all' => REASON; | |
| 417 | $o->skip_all(REASON); | |
| 418 | ||
| 419 | The skip_all option can be set using an ('skip_all',REASON) option | |
| 420 | pair, or by setting the TI_SKIP_ALL environment variable, or the | |
| 421 | $::TI_SKIP_ALL global variable. | |
| 422 | ||
| 423 | If this is set, the entire test script will be skipped for the reason | |
| 424 | given. This must be done before any test is run, and before any plan | |
| 425 | number is set. | |
| 426 | ||
| 427 | The skip_all can also be called at any point during the script (i.e. | |
| 428 | after tests have been run). In this case, all remaining scripts will | |
| 429 | be skipped. | |
| 430 | ||
| 431 | $o->skip_all(REASON,FEATURE,FEATURE,...); | |
| 432 | $o->skip_all('',FEATURE,FEATURE,...); | |
| 433 | ||
| 434 | This will skip all tests (or all remaining tests) unless all features | |
| 435 | are available. REASON can be entered as an empty string and the | |
| 436 | reason the tests are skipped will be a message about the missing | |
| 437 | feature. | |
| 438 | ||
| 439 | =item B<feature> | |
| 440 | ||
| 441 | $o->feature($feature,$val); | |
| 442 | ||
| 443 | This defines a feature. If $val is non-zero, the feature is available. | |
| 444 | Otherwise it is not. | |
| 445 | ||
| 446 | =item B<diag> | |
| 447 | ||
| 448 | =item B<note> | |
| 449 | ||
| 450 | $o->diag($message); | |
| 451 | $o->note($message); | |
| 452 | ||
| 453 | Both of these print an optional message. Messages printed with the | |
| 454 | note method are always optional and will be omitted if the quiet | |
| 455 | option is set to 1 or 2. Messages printed with the diag method are | |
| 456 | optional and will not be printed if the quiet option is set to 2, | |
| 457 | but they will be printed if the quiet method is set to 1. | |
| 458 | ||
| 459 | =item B<testdir> | |
| 460 | ||
| 461 | Occasionally, it may be necessary to know the directory where the | |
| 462 | tests live (for example, there may be a config or data file in there). | |
| 463 | This method will return the directory. | |
| 464 | ||
| 465 | =back | |
| 466 | ||
| 467 | =head1 METHODS FOR LOADING MODULES | |
| 468 | ||
| 469 | Test scripts can load other modules (using either the perl 'use' or | |
| 470 | 'require' commands). There are three different modes for doing this | |
| 471 | which determine how this is done. | |
| 472 | ||
| 473 | =over 4 | |
| 474 | ||
| 475 | =item B<required mode> | |
| 476 | ||
| 477 | By default, this is used to test for a module that is required for | |
| 478 | all tests in the test script. | |
| 479 | ||
| 480 | Loading the module is treated as an actual test in the test suite. The | |
| 481 | test is to determine whether the module is available and can be | |
| 482 | loaded. If it can be loaded, it is, and it is reported as a successful | |
| 483 | test. If it cannot be loaded, it is reported as a failed test. | |
| 484 | ||
| 485 | In the result of a failed test, all remaining tests will be skipped | |
| 486 | automatically (except for other tests which load modules). | |
| 487 | ||
| 488 | =item B<feature mode> | |
| 489 | ||
| 490 | In feature mode, loading the module is not treated as a test (i.e. it | |
| 491 | will not print out an 'ok' or 'not ok' line. Instead, it will set a | |
| 492 | feature (named the same as the module) which can be used to determine | |
| 493 | whether other tests should run or not. | |
| 494 | ||
| 495 | =item B<forbid mode> | |
| 496 | ||
| 497 | In a few very rare cases, we may want to test for a module but expect | |
| 498 | that it not be present. This is the exact opposite of the 'required' | |
| 499 | mode. | |
| 500 | ||
| 501 | Successfully loading the module is treated as a test failure. In the | |
| 502 | event of a failure, all remaining tests will be skipped. | |
| 503 | ||
| 504 | =back | |
| 505 | ||
| 506 | The methods available are: | |
| 507 | ||
| 508 | =over 4 | |
| 509 | ||
| 510 | =item B<require_ok> | |
| 511 | ||
| 512 | $o->require_ok($module [,$mode]); | |
| 513 | ||
| 514 | This is used to load a module using the perl 'require' function. If | |
| 515 | $mode is not passed in, the default mode (required) is used to test | |
| 516 | the existance of the module. | |
| 517 | ||
| 518 | If $mode is passed in, it must be either the string 'forbid' or | |
| 519 | 'feature'. | |
| 520 | ||
| 521 | =item B<use_ok> | |
| 522 | ||
| 523 | $o->use_ok(@args [,$mode]); | |
| 524 | ||
| 525 | This is used to load a module with 'use', or check a perl version. | |
| 526 | ||
| 527 | BEGIN { $o->use_ok('5.010'); } | |
| 528 | BEGIN { $o->use_ok('Some::Module'); } | |
| 529 | BEGIN { $o->use_ok('Some::Module',2.05); } | |
| 530 | BEGIN { $o->use_ok('Some::Module','foo','bar'); } | |
| 531 | BEGIN { $o->use_ok('Some::Module',2.05,'foo','bar'); } | |
| 532 | ||
| 533 | are the same as: | |
| 534 | ||
| 535 | use 5.010; | |
| 536 | use Some::Module; | |
| 537 | use Some::Module 2.05; | |
| 538 | use Some::Module qw(foo bar); | |
| 539 | use Some::Module 2.05 qw(foo bar); | |
| 540 | ||
| 541 | Putting the use_ok call in a BEGIN block allows the functions to | |
| 542 | be imported at compile-time and prototypes are properly honored. | |
| 543 | You'll also need to load the Test::Inter module, and create the | |
| 544 | object in a BEGIN block. | |
| 545 | ||
| 546 | $mode acts the same as in the require_ok method. | |
| 547 | ||
| 548 | =back | |
| 549 | ||
| 550 | =head1 METHODS FOR RUNNING TEST | |
| 551 | ||
| 552 | There are several methods for running tests. The ok, is, and isnt | |
| 553 | methods are included for those already comfortable with Test::More | |
| 554 | and wishing to stick with the same format of test script. The | |
| 555 | tests method is the suggested method though since it makes use | |
| 556 | of the full power of this module. | |
| 557 | ||
| 558 | =over 4 | |
| 559 | ||
| 560 | =item B<ok> | |
| 561 | ||
| 562 | $o->ok(TESTS); | |
| 563 | ||
| 564 | A test run with ok looks at a result, and if it evaluates to 0 (or | |
| 565 | false), it fails. If it evaluates to non-zero (or true), it | |
| 566 | passes. | |
| 567 | ||
| 568 | These tests do not require you to specify the expected results. If | |
| 569 | expected results are given, they will be compared against the result | |
| 570 | received, and if they differ, a diagnostic message will be printed, | |
| 571 | but the test will still succeed or fail based only on the actual | |
| 572 | result produced. | |
| 573 | ||
| 574 | These tests require a single result and either zero or one expected | |
| 575 | results. | |
| 576 | ||
| 577 | To run a single test, use any of the following: | |
| 578 | ||
| 579 | $o->ok(); # always succeeds | |
| 580 | ||
| 581 | $o->ok($result); | |
| 582 | $o->ok($result,$name); | |
| 583 | $o->ok($result,$expected,$name); | |
| 584 | ||
| 585 | $o->ok(\&func); | |
| 586 | $o->ok(\&func,$name); | |
| 587 | $o->ok(\&func,$expected,$name); | |
| 588 | ||
| 589 | $o->ok(\&func,\@args); | |
| 590 | $o->ok(\&func,\@args,$name); | |
| 591 | $o->ok(\&func,\@args,$expected,$name); | |
| 592 | ||
| 593 | If $result is a scalar, the test passes if $result is true. If $result | |
| 594 | is a list reference, and the list is either empty, or the first | |
| 595 | element is a scalar), the test succeeds if the list contains any | |
| 596 | values (except for undef). If $result is a hash reference, the test | |
| 597 | succeeds if the hash contains any key with a value that is not undef. | |
| 598 | ||
| 599 | If \&func and \@args are passed in, then $result is generated by | |
| 600 | passing @args to &func and behaves identically to the calls where | |
| 601 | $result is passed in. If \&func is passed in but no arguments, the | |
| 602 | function takes no arguments, but still produces a result. | |
| 603 | ||
| 604 | $result may be a scalar, list reference, or hash reference. If it is a | |
| 605 | list reference, the test passes is the list contains any defined | |
| 606 | values. If it is a hash reference, the test passes if any of the keys | |
| 607 | contain defined values. | |
| 608 | ||
| 609 | If an expected value is passed in and the result does not match it, | |
| 610 | a diagnostic warning will be printed, even if the test passes. | |
| 611 | ||
| 612 | =item B<is> | |
| 613 | ||
| 614 | =item B<isnt> | |
| 615 | ||
| 616 | $o->is(TESTS); | |
| 617 | $o->isnt(TESTS); | |
| 618 | ||
| 619 | A test run with is looks as a result and tests to see if it is identical to | |
| 620 | an expected result. If it is, the test passes. Otherwise it fails. In the | |
| 621 | case of a failure, a diagnostic message will show what result was actually | |
| 622 | obtained and what was expected. | |
| 623 | ||
| 624 | A test run with isnt looks at a result and tests to see if the result obtained | |
| 625 | is different than an expected result. If it is different, the test passes. | |
| 626 | Otherwise it fails. | |
| 627 | ||
| 628 | The is method can be called in any of the following ways: | |
| 629 | ||
| 630 | $o->is($result,$expected); | |
| 631 | $o->is($result,$expected,$name); | |
| 632 | ||
| 633 | $o->is(\&func,$expected); | |
| 634 | $o->is(\&func,$expected,$name); | |
| 635 | ||
| 636 | $o->is(\&func,\@args,$expected); | |
| 637 | $o->is(\&func,\@args,$expected,$name); | |
| 638 | ||
| 639 | The isnt method can be called in exactly the same way. | |
| 640 | ||
| 641 | As with the ok method, the result can be a scalar, hashref, or listref. If it is | |
| 642 | a hashref or listref, the entire structure must match the expected value. | |
| 643 | ||
| 644 | =item B<tests> | |
| 645 | ||
| 646 | $o->tests($opt=>$val, $opt=>$val, ...) | |
| 647 | ||
| 648 | The options available are described in the following section. | |
| 649 | ||
| 650 | =item B<file> | |
| 651 | ||
| 652 | $o->file($func,$input,$outputdir,$expected,$name [,@args]); | |
| 653 | ||
| 654 | Sometimes it may be easiest to store the input, output, and expected | |
| 655 | output from a series of tests in files. In this case, each line of | |
| 656 | output will be treated as a single test, so the output and expected | |
| 657 | output must match up exactly. | |
| 658 | ||
| 659 | $func is a reference to a function which will produce a temporary | |
| 660 | output file. If $input is specified, it is the name of the input | |
| 661 | file, and it will be passed to the function as the first argument. | |
| 662 | If $input is left blank, no input file will be used. The input | |
| 663 | file may be specified as a full path, or just the file name (in | |
| 664 | which case it will be looked for in the test directory and the | |
| 665 | current directory). | |
| 666 | ||
| 667 | $func also takes a arequired argument which is the output file. | |
| 668 | The tests method will create a tempoary file containing the output. | |
| 669 | If $outputdir is passed in, it is the directory where the output | |
| 670 | file will be written. If $outputdir is left blank, the temporary | |
| 671 | file will be written to the test directory. | |
| 672 | ||
| 673 | If @args is passed in, it is a list of additional arguments which | |
| 674 | will be passed to $func. | |
| 675 | ||
| 676 | $expected is the name of a file which contains the expeccted output. | |
| 677 | It can be fully specified, or it will be checked for in the test | |
| 678 | directory. | |
| 679 | ||
| 680 | =back | |
| 681 | ||
| 682 | =head1 USING THE TESTS METHOD | |
| 683 | ||
| 684 | It is expected that most tests (except for those that load a module) | |
| 685 | will be run using the tests method called as: | |
| 686 | ||
| 687 | $o->tests($opt => $val, $opt => $val, ...); | |
| 688 | ||
| 689 | The following options are available: | |
| 690 | ||
| 691 | =over 4 | |
| 692 | ||
| 693 | =item name | |
| 694 | ||
| 695 | name => NAME | |
| 696 | ||
| 697 | This sets the name of this set of tests. All tests will be given the | |
| 698 | same name. | |
| 699 | ||
| 700 | =item tests | |
| 701 | ||
| 702 | =item func | |
| 703 | ||
| 704 | =item expected | |
| 705 | ||
| 706 | In order to specify a series of tests, you have to specify either | |
| 707 | a function and a list of arguments, or a list of results. | |
| 708 | ||
| 709 | Specifying the function and list of arguments can be done using | |
| 710 | the pair: | |
| 711 | ||
| 712 | func => \&FUNCTION | |
| 713 | tests => TESTS | |
| 714 | ||
| 715 | If the func option is not set, tests contains a list of results. | |
| 716 | ||
| 717 | A list of expected results may also be given. They can be included | |
| 718 | in the | |
| 719 | ||
| 720 | tests => TESTS | |
| 721 | ||
| 722 | option or included separately as: | |
| 723 | ||
| 724 | expected => RESULTS | |
| 725 | ||
| 726 | The way to specify these are covered in the next section SPECIFYING THE TESTS. | |
| 727 | ||
| 728 | =item feature | |
| 729 | ||
| 730 | =item disable | |
| 731 | ||
| 732 | feature => [FEATURE1, FEATURE2, ...] | |
| 733 | ||
| 734 | disable => [FEATURE1, FEATURE2, ...] | |
| 735 | ||
| 736 | The default set of tests to run is determined using the start, end, and skip_all | |
| 737 | methods discussed above. Using those methods, a list of tests is obtained, and | |
| 738 | it is expected that these will run. | |
| 739 | ||
| 740 | The feature and disable options modify the list. | |
| 741 | ||
| 742 | If the feature option is included, the tests given in this call will only run | |
| 743 | if ALL of the features listed are available. | |
| 744 | ||
| 745 | If the disable option is included, the tests will be run unless ANY of the features | |
| 746 | listed are available. | |
| 747 | ||
| 748 | =item skip | |
| 749 | ||
| 750 | skip => REASON | |
| 751 | ||
| 752 | Skip these tests for the reason given. | |
| 753 | ||
| 754 | =item todo | |
| 755 | ||
| 756 | todo => 0/1 | |
| 757 | ||
| 758 | Setting this to 1 says that these tests are allowed to fail. They represent | |
| 759 | a feature that is not yet implemented. | |
| 760 | ||
| 761 | If the tests succeed, a message will be printed notifying the developer that | |
| 762 | the tests are now ready to promote to actual use. | |
| 763 | ||
| 764 | =back | |
| 765 | ||
| 766 | =head1 SPECIFYING THE TESTS | |
| 767 | ||
| 768 | A series of tests can be specified in two different ways. The tests | |
| 769 | can be written in a very simple string format, or stored as a list. | |
| 770 | ||
| 771 | Demonstrating how this can be done is best done by example, so let's | |
| 772 | say that there is a function (func) which takes two arguments, and | |
| 773 | returns a single value. Let's say that the expected output (and the | |
| 774 | actual output) from 3 different sets of arguments is: | |
| 775 | ||
| 776 | Input Expected Output Actual Output | |
| 777 | ----- --------------- ------------- | |
| 778 | 1,2 a a | |
| 779 | 3,4 b x | |
| 780 | 5,6 c c | |
| 781 | ||
| 782 | (so in this case, the first and third tests pass, but the 2nd | |
| 783 | one will fail). | |
| 784 | ||
| 785 | Specifying these tests as lists could be done as: | |
| 786 | ||
| 787 | $o->tests( | |
| 788 | func => &func, | |
| 789 | tests => [ [1,2], [3,4], [5,6] ], | |
| 790 | expected => [ [a], [b], [c] ], | |
| 791 | ); | |
| 792 | ||
| 793 | Here, the tests are stored as a list, and each element in the list is a | |
| 794 | listref containing the set of arguments. | |
| 795 | ||
| 796 | If the func option is not passed in, the tests option is set to a list | |
| 797 | of results to compare with the expected results, so the following is | |
| 798 | equivalent to the above: | |
| 799 | ||
| 800 | $o->tests( | |
| 801 | tests => [ [a], [x], [c] ], | |
| 802 | expected => [ [a], [b], [c] ], | |
| 803 | ); | |
| 804 | ||
| 805 | If an argument (or actual result) or an expected result is only a | |
| 806 | single value, it can be entered as a scalar instead of a list ref, so | |
| 807 | the following is also equivalent: | |
| 808 | ||
| 809 | $o->tests( | |
| 810 | func => &func, | |
| 811 | tests => [ [1,2], [3,4], [5,6] ], | |
| 812 | expected => [ a, b, [c] ], | |
| 813 | ); | |
| 814 | ||
| 815 | The only exception to this is if the single value is itself a list | |
| 816 | reference. In this case it MUST be included as a reference. In other | |
| 817 | words, if you have a single test, and the expected value for this test | |
| 818 | is a list reference, it must be passed in as: | |
| 819 | ||
| 820 | expected => [ [ \@r ] ] | |
| 821 | ||
| 822 | NOT as: | |
| 823 | ||
| 824 | expected => [ \@r ] | |
| 825 | ||
| 826 | Passing in a set of expected results is optional. If none are passed | |
| 827 | in, the tests are treated as if they had been passed to the 'ok' | |
| 828 | method (i.e. if they return something true, they pass, otherwise they | |
| 829 | fail). | |
| 830 | ||
| 831 | The second way to specify tests is as a string. The string is a | |
| 832 | multi-line string with each tests being separate from the next test by | |
| 833 | a blank line. Comments (lines which begin with '#') are allowed, and | |
| 834 | are ignored. Whitespace at the start and end of the line is ignored. | |
| 835 | ||
| 836 | The string may contain the results directly, or results may be passed | |
| 837 | in separately. For example, the following all give the same sets of | |
| 838 | tests as the example above: | |
| 839 | ||
| 840 | $o->tests( | |
| 841 | func => &func, | |
| 842 | tests => " | |
| 843 | # Test 1 | |
| 844 | 1 2 => a | |
| 845 | ||
| 846 | # Test 2 | |
| 847 | 3 4 => b | |
| 848 | ||
| 849 | 5 6 => c | |
| 850 | ", | |
| 851 | ); | |
| 852 | ||
| 853 | $o->tests( | |
| 854 | func => &func, | |
| 855 | tests => " | |
| 856 | 1 2 | |
| 857 | ||
| 858 | 3 4 | |
| 859 | ||
| 860 | 5 6 | |
| 861 | ", | |
| 862 | expected => [ [a], [b], [c] ] | |
| 863 | ); | |
| 864 | ||
| 865 | $o->tests( | |
| 866 | func => &func, | |
| 867 | tests => [ [1,2], [3,4], [5,6] ], | |
| 868 | expected => " | |
| 869 | a | |
| 870 | ||
| 871 | b | |
| 872 | ||
| 873 | c | |
| 874 | ", | |
| 875 | ); | |
| 876 | ||
| 877 | $o->tests( | |
| 878 | func => &func, | |
| 879 | tests => " | |
| 880 | 1 2 | |
| 881 | ||
| 882 | 3 4 | |
| 883 | ||
| 884 | 5 6 | |
| 885 | ", | |
| 886 | expected => " | |
| 887 | a | |
| 888 | ||
| 889 | b | |
| 890 | ||
| 891 | c | |
| 892 | ", | |
| 893 | ); | |
| 894 | ||
| 895 | The expected results may also consist of only a single set of results (in this | |
| 896 | case, it must be passed in as a listref). In this case, all of the tests are | |
| 897 | expected to have the same results. | |
| 898 | ||
| 899 | So, the following are equivalent: | |
| 900 | ||
| 901 | $o->tests( | |
| 902 | func => &func, | |
| 903 | tests => " | |
| 904 | 1 2 => a b | |
| 905 | ||
| 906 | 3 4 => a b | |
| 907 | ||
| 908 | 5 6 => a b | |
| 909 | ", | |
| 910 | ); | |
| 911 | ||
| 912 | $o->tests( | |
| 913 | func => &func, | |
| 914 | tests => " | |
| 915 | 1 2 | |
| 916 | ||
| 917 | 3 4 | |
| 918 | ||
| 919 | 5 6 | |
| 920 | ", | |
| 921 | expected => [ [a, b] ], | |
| 922 | ); | |
| 923 | ||
| 924 | $o->tests( | |
| 925 | func => &func, | |
| 926 | tests => " | |
| 927 | 1 2 | |
| 928 | ||
| 929 | 3 4 | |
| 930 | ||
| 931 | 5 6 | |
| 932 | ", | |
| 933 | expected => "a b", | |
| 934 | ); | |
| 935 | ||
| 936 | The number of expected values must either be 1 (i.e. all of the tests | |
| 937 | are expected to produce the same value) or exactly the same number as | |
| 938 | the number of tests. | |
| 939 | ||
| 940 | The parser is actually quite powerful, and can handle multi-line | |
| 941 | tests, quoted strings, and nested data structures. | |
| 942 | ||
| 943 | The test may be split across any number of lines, provided there is | |
| 944 | not a completely blank line (which signals the end of the test), so | |
| 945 | the following are eqivalent: | |
| 946 | ||
| 947 | tests => "a b c", | |
| 948 | tests => "a b | |
| 949 | c", | |
| 950 | ||
| 951 | Arguments (or expected results) may include data structures. For | |
| 952 | example, the following are equivalent: | |
| 953 | ||
| 954 | tests => "[ a b ] { a 1 b 2 }" | |
| 955 | tests => [ [ [a,b], { a=>1, b=>2 } ] ] | |
| 956 | ||
| 957 | Whitespace is mostly optional, but there is one exception. An item must | |
| 958 | end with some kind of delimiter, so the following will fail: | |
| 959 | ||
| 960 | tests => "[a b][c d]" | |
| 961 | ||
| 962 | The first element (the list ref [a b]) must be separated from the second | |
| 963 | element by the delimiter (which is whitespace in this case), so it must | |
| 964 | be written as: | |
| 965 | ||
| 966 | tests => "[a b] [c d]" | |
| 967 | ||
| 968 | As already demonstrated, hashrefs and listrefs may be included and | |
| 969 | nested. Elements may also be included inside parens, but this is optional | |
| 970 | since all arguments and expected results are already treated as lists, | |
| 971 | so the following are equivalent: | |
| 972 | ||
| 973 | tests => "a b c" | |
| 974 | tests => "(a b) c" | |
| 975 | ||
| 976 | Although parens are optional, they may make things more readable, and allow | |
| 977 | you to use something other than whitespsace as the delimiter. | |
| 978 | ||
| 979 | If the character immediately following the opening paren, brace, or | |
| 980 | bracket is a punctuation mark, then it is used as the delimiter | |
| 981 | instead of whitespace. For example, the following are all equivalent: | |
| 982 | ||
| 983 | [ a b c ] | |
| 984 | [a b c] | |
| 985 | [, a,b,c ] | |
| 986 | [, a, b, c ] | |
| 987 | ||
| 988 | A delimiter is a single character, and the following may not be used | |
| 989 | as a delimiter: | |
| 990 | ||
| 991 | any opening/closing characters () [] {} | |
| 992 | single or double quotes | |
| 993 | alphanumeric characters | |
| 994 | underscore | |
| 995 | ||
| 996 | Whitespace (including newlines) around the delimiter is ignored, so | |
| 997 | the following is valid: | |
| 998 | ||
| 999 | [, a, | |
| 1000 | b, | |
| 1001 | c ] | |
| 1002 | ||
| 1003 | Two delimiters next to each other or a trailing delimiter produce an | |
| 1004 | empty string. | |
| 1005 | ||
| 1006 | "(,a,b,)" => (a, b, '') | |
| 1007 | "(,a,,b)" => (a, '', b) | |
| 1008 | ||
| 1009 | Hashrefs may be specified by braces and the following are equivalent: | |
| 1010 | ||
| 1011 | { a 1 b 2 } | |
| 1012 | {, a,1,b,2 } | |
| 1013 | {, a,1,b,2, } | |
| 1014 | ||
| 1015 | Note that a trailing delimiter is ignored if there are already an even | |
| 1016 | number of elements, or an empty string otherwise. | |
| 1017 | ||
| 1018 | Nested structures are allowed: | |
| 1019 | ||
| 1020 | "[ [1 2] [3 4] ]" | |
| 1021 | ||
| 1022 | For example, | |
| 1023 | ||
| 1024 | $o->tests( | |
| 1025 | func => &func, | |
| 1026 | tests => "a [ b c ] { d 1 e 2 } => x y" | |
| 1027 | ); | |
| 1028 | ||
| 1029 | is equivalent to: | |
| 1030 | ||
| 1031 | $o->tests( | |
| 1032 | func => &func, | |
| 1033 | tests => [ [a, [b,c], {d=>1,e=>2}] ], | |
| 1034 | results => [ [x,y] ], | |
| 1035 | ); | |
| 1036 | ||
| 1037 | Any single value can be surrounded by single or double quotes in order | |
| 1038 | to include the delimiter. So: | |
| 1039 | ||
| 1040 | "(, a,'b,c',e )" | |
| 1041 | ||
| 1042 | is equivalent to: | |
| 1043 | ||
| 1044 | "( a b,c e )" | |
| 1045 | ||
| 1046 | Any single value can be the string '__undef__' which will be turned | |
| 1047 | into an actual undef. If the value is '__blank__' it is turned into an | |
| 1048 | empty string (''), though it can also be specified as '' directly. Any | |
| 1049 | value can have an embedded newline by including a __nl__ in the value, | |
| 1050 | but the value must be written on a single line. | |
| 1051 | ||
| 1052 | Expected results are separated from arguments by ' => '. | |
| 1053 | ||
| 1054 | =head1 HISTORY | |
| 1055 | ||
| 1056 | The history of this module dates back to 1996 when I needed to write a | |
| 1057 | test suite for my Date::Manip module. At that time, none of the | |
| 1058 | Test::* modules currently available in CPAN existed (the earliest ones | |
| 1059 | didn't come along until 1998), so I was left completely on my own | |
| 1060 | writing my test scripts. | |
| 1061 | ||
| 1062 | I wrote a very basic version of my test framework which allowed me to | |
| 1063 | write all of the tests as a string, it would parse the string, count | |
| 1064 | the tests, ad then run them. | |
| 1065 | ||
| 1066 | Over the years, the functionality I wanted grew, and periodically, I'd | |
| 1067 | go back and reexamine other Test frameworks (primarily Test::More) to | |
| 1068 | see if I could replace my framework with an existing module... and I've | |
| 1069 | always found them wanting, and chosen to extend my existing framework | |
| 1070 | instead. | |
| 1071 | ||
| 1072 | As I've written other modules, I've wanted to use the framework in | |
| 1073 | them too, so I've always just copied it in, but this is obviously | |
| 1074 | tedious and error prone. I'm not sure why it took me so long... but in | |
| 1075 | 2010, I finally decided it was time to rework the framework in a | |
| 1076 | module form. | |
| 1077 | ||
| 1078 | I loosely based my module on Test::More. I like the functionality of | |
| 1079 | that module, and wanted most of it (and I plan on adding more in | |
| 1080 | future versions). So this module uses some similar syntax to | |
| 1081 | Test::More (though it allows a great deal more flexibility in how the | |
| 1082 | tests are specified). | |
| 1083 | ||
| 1084 | One thing to note is that I may have been able to write this module | |
| 1085 | as an extension to Test::More, but after looking into that possibility, | |
| 1086 | I decided that it would be faster to not do that. I did "borrow" a couple | |
| 1087 | of routines from it (though they've been modified quite heavily) as a | |
| 1088 | starting point for a few of the functions in this module, and I thank | |
| 1089 | the authors of Test::More for their work. | |
| 1090 | ||
| 1091 | =head1 KNOWN BUGS AND LIMITATIONS | |
| 1092 | ||
| 1093 | None known. | |
| 1094 | ||
| 1095 | =head1 SEE ALSO | |
| 1096 | ||
| 1097 | Test::More - the 'industry standard' of perl test frameworks | |
| 1098 | ||
| 1099 | =head1 LICENSE | |
| 1100 | ||
| 1101 | This script is free software; you can redistribute it and/or modify it under the same | |
| 1102 | terms as Perl itself. | |
| 1103 | ||
| 1104 | =head1 AUTHOR | |
| 1105 | ||
| 1106 | Sullivan Beck (sbeck@cpan.org) | |
| 1107 | ||
| 1108 | =cut |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use Test::Inter; | |
| 3 | $o = new Test::Inter; | |
| 4 | ||
| 5 | sub func1 { | |
| 6 | my($output) = @_; | |
| 7 | ||
| 8 | my @lines = ("First line", | |
| 9 | "Second line", | |
| 10 | "Third line"); | |
| 11 | open(OUT,">$output"); | |
| 12 | foreach my $line (@lines) { | |
| 13 | print OUT "$line\n"; | |
| 14 | } | |
| 15 | close(OUT); | |
| 16 | } | |
| 17 | ||
| 18 | sub func2 { | |
| 19 | my($input,$output) = @_; | |
| 20 | open(IN,$input); | |
| 21 | open(OUT,">$output"); | |
| 22 | my @lines = <IN>; | |
| 23 | print OUT @lines; | |
| 24 | close(IN); | |
| 25 | close(OUT); | |
| 26 | } | |
| 27 | ||
| 28 | $o->file(\&func1,'', '','file.1.exp','No input'); | |
| 29 | ||
| 30 | $o->file(\&func2,'file.2.in','','file.2.exp','File copy'); | |
| 31 | ||
| 32 | $o->done_testing(); | |
| 33 |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use Test::Inter; | |
| 3 | $o = new Test::Inter; | |
| 4 | ||
| 5 | $o->is ( [ 'a','b' ], [ 'a','b' ], "List test" ); | |
| 6 | $o->isnt( [ 'a','b' ], [ 'a','c' ], "List test" ); | |
| 7 | ||
| 8 | $o->is ( { 'a' => 1, 'b' => 2 }, { 'a' => 1, 'b' => 2 }, "Hash test" ); | |
| 9 | $o->isnt( { 'a' => 1, 'b' => 2 }, { 'a' => 1, 'b' => 3 }, "Hash test" ); | |
| 10 | ||
| 11 | $o->done_testing(); | |
| 12 |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use Test::Inter; | |
| 3 | $o = new Test::Inter; | |
| 4 | ||
| 5 | $o->ok(); | |
| 6 | $o->ok( 1 == 1 ); | |
| 7 | $o->ok( 1 == 1, "Basic test" ); | |
| 8 | $o->ok( 1 == 1, 1, "Basic test" ); | |
| 9 | $o->ok( 1 == 1, 2, "Basic test" ); | |
| 10 | ||
| 11 | sub func_false { | |
| 12 | return 0; | |
| 13 | } | |
| 14 | sub func_true { | |
| 15 | return 1; | |
| 16 | } | |
| 17 | ||
| 18 | sub func { | |
| 19 | my($a,$b) = @_; | |
| 20 | return $a == $b; | |
| 21 | } | |
| 22 | ||
| 23 | $o->ok( \&func_true ); | |
| 24 | $o->ok( \&func_true, "True test" ); | |
| 25 | $o->ok( \&func_true, 1, "True test" ); | |
| 26 | $o->ok( \&func_true, 2, "True test" ); | |
| 27 | ||
| 28 | $o->ok( \&func, [1,1]); | |
| 29 | $o->ok( \&func, [1,1], "Func test" ); | |
| 30 | $o->ok( \&func, [1,1], 1, "Func test" ); | |
| 31 | $o->ok( \&func, [1,1], 2, "Func test" ); | |
| 32 | ||
| 33 | $o->ok( [ 'a','b' ], [ 'a','b' ], "List test" ); | |
| 34 | $o->ok( [ 'a','b' ], [ 'a','c' ], "List test (non-identical)" ); | |
| 35 | ||
| 36 | $o->ok( { 'a' => 1, 'b' => 2 }, { 'a' => 1, 'b' => 2 }, "Hash test" ); | |
| 37 | $o->ok( { 'a' => 1, 'b' => 2 }, { 'a' => 1, 'b' => 3 }, "Hash test (non-identical)" ); | |
| 38 | ||
| 39 | $o->done_testing(); | |
| 40 |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use Test::Inter; | |
| 3 | my $t = new Test::Inter; | |
| 4 | ||
| 5 | eval "use Test::Pod 1.00"; | |
| 6 | $t->feature('Test::Pod',1) unless ($@); | |
| 7 | $t->feature('DoPOD',1) unless ($ENV{'TI_SKIPPOD'}); | |
| 8 | ||
| 9 | $t->skip_all('','Test::Pod','DoPOD'); | |
| 10 | all_pod_files_ok(); |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use Test::Inter; | |
| 3 | my $t = new Test::Inter; | |
| 4 | ||
| 5 | eval "use Test::Pod::Coverage 1.00"; | |
| 6 | $t->feature('Test::Pod::Coverage',1) unless ($@); | |
| 7 | $t->feature('DoPOD',1) unless ($ENV{'TI_SKIPPOD'}); | |
| 8 | ||
| 9 | $t->skip_all('','Test::Pod::Coverage','DoPOD'); | |
| 10 | all_pod_coverage_ok(); |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use strict; | |
| 3 | use warnings; | |
| 4 | use Test::Inter; | |
| 5 | ||
| 6 | my $o = new Test::Inter; | |
| 7 | ||
| 8 | $o->require_ok('5.001'); | |
| 9 | $o->require_ok('5.015','forbid'); | |
| 10 | $o->require_ok('Config'); | |
| 11 | $o->require_ok('Xxx::Yyy','forbid'); | |
| 12 | $o->require_ok('Symbol','feature'); | |
| 13 | $o->require_ok('Xxx::Zzz','feature'); | |
| 14 | ||
| 15 | $o->done_testing(); | |
| 16 |
| 0 | #!/bin/sh | |
| 1 | ||
| 2 | # Usage: | |
| 3 | # runtests [-T] [prefix] | |
| 4 | # | |
| 5 | # Runs all tests (or those starting with prefix),optionally in taint mode | |
| 6 | ||
| 7 | TI_MODE='inter' | |
| 8 | export TI_MODE | |
| 9 | ||
| 10 | TI_QUIET=2 | |
| 11 | export TI_QUIET | |
| 12 | ||
| 13 | TI_SKIPPOD=1 | |
| 14 | export TI_SKIPPOD | |
| 15 | ||
| 16 | if [ "$1" = "-T" ]; then | |
| 17 | taint="-T -I../lib -I." | |
| 18 | shift | |
| 19 | else | |
| 20 | taint= | |
| 21 | fi | |
| 22 | ||
| 23 | subset=$1 | |
| 24 | ||
| 25 | for test in ${subset}*.t ;do | |
| 26 | perl $taint ./$test | |
| 27 | done |
| 0 | perl -I../lib file.t 1 | |
| 1 | perl -I../lib is.t 1 | |
| 2 | perl -I../lib ok.t 1 | |
| 3 | perl -I../lib require_ok.t 1 | |
| 4 | perl -I../lib skip_all.t 1 | |
| 5 | perl -I../lib tests.t 1 | |
| 6 | perl -I../lib use_ok.1.t 1 | |
| 7 | perl -I../lib use_ok.2.t 1 | |
| 8 | perl -I../lib use_ok.3.t 1 |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use strict; | |
| 3 | use warnings; | |
| 4 | use Test::Inter; | |
| 5 | ||
| 6 | my $o = new Test::Inter; | |
| 7 | ||
| 8 | $o->skip_all("testing skip_all"); | |
| 9 | $o->plan(3); | |
| 10 | $o->_ok("Test 1"); | |
| 11 | $o->diag("Test 1 diagnostic message"); | |
| 12 | $o->_ok("Test 2"); | |
| 13 | $o->_ok("Test 3"); |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use Test::Inter; | |
| 3 | $o = new Test::Inter; | |
| 4 | ||
| 5 | sub func { | |
| 6 | my(@args) = @_; | |
| 7 | my @ret; | |
| 8 | foreach my $arg (@args) { | |
| 9 | push(@ret,length($arg)); | |
| 10 | } | |
| 11 | return @ret; | |
| 12 | } | |
| 13 | ||
| 14 | $o->tests(func => \&func, | |
| 15 | tests => "foo => 3 | |
| 16 | ||
| 17 | a ab => 1 2 | |
| 18 | ||
| 19 | (x xy xyz) => 1 2 3 | |
| 20 | ||
| 21 | (a) (bc) => 1 2 | |
| 22 | ||
| 23 | (a (b cd)) => 1 1 2 | |
| 24 | ||
| 25 | (,a,bc) => 1 2 | |
| 26 | ||
| 27 | (,a,b c) => 1 3 | |
| 28 | "); | |
| 29 | ||
| 30 | $o->tests(func => \&func, | |
| 31 | expected => [ [1,2] ], | |
| 32 | tests => "a ab | |
| 33 | ||
| 34 | c cd | |
| 35 | ||
| 36 | e ef | |
| 37 | "); | |
| 38 | ||
| 39 | $o->tests(func => \&func, | |
| 40 | expected => "1 2", | |
| 41 | tests => "a ab | |
| 42 | ||
| 43 | c cd | |
| 44 | ||
| 45 | e ef | |
| 46 | "); | |
| 47 | ||
| 48 | $o->tests(tests => "1 | |
| 49 | ||
| 50 | '' '' | |
| 51 | "); | |
| 52 | ||
| 53 | $o->done_testing(); |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use strict; | |
| 3 | use warnings; | |
| 4 | ||
| 5 | use vars qw($o); | |
| 6 | ||
| 7 | BEGIN { | |
| 8 | use Test::Inter; | |
| 9 | $o = new Test::Inter; | |
| 10 | } | |
| 11 | ||
| 12 | BEGIN { $o->use_ok('5.004'); } | |
| 13 | BEGIN { $o->use_ok('Config'); } | |
| 14 | BEGIN { $o->use_ok('Xxx::Yyy','forbid'); } | |
| 15 | BEGIN { $o->use_ok('Symbol','feature'); } | |
| 16 | BEGIN { $o->use_ok('Xxx::Zzz','feature'); } | |
| 17 | BEGIN { $o->use_ok('Storable',1.01); } | |
| 18 | ||
| 19 | $o->done_testing(); | |
| 20 |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use strict; | |
| 3 | use warnings; | |
| 4 | ||
| 5 | use vars qw($o); | |
| 6 | ||
| 7 | BEGIN { | |
| 8 | use Test::Inter; | |
| 9 | $o = new Test::Inter; | |
| 10 | } | |
| 11 | ||
| 12 | BEGIN { $o->use_ok('5.015','forbid'); } | |
| 13 | BEGIN { $o->use_ok('Config','myconfig'); } | |
| 14 | BEGIN { $o->use_ok('Storable',1.01,'dclone'); } | |
| 15 | ||
| 16 | $o->done_testing(); | |
| 17 |
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | use strict; | |
| 3 | use warnings; | |
| 4 | ||
| 5 | use vars qw($o); | |
| 6 | ||
| 7 | BEGIN { | |
| 8 | use Test::Inter; | |
| 9 | $o = new Test::Inter; | |
| 10 | } | |
| 11 | ||
| 12 | BEGIN { $o->use_ok('5.015','forbid'); } | |
| 13 | BEGIN { $o->use_ok('Config','xxxx','forbid'); } | |
| 14 | BEGIN { $o->use_ok('Storable',7.01,'dclone','forbid'); } | |
| 15 | ||
| 16 | $o->done_testing(); | |
| 17 |