1#============================================================= -*-Perl-*- 2# 3# Template::Test 4# 5# DESCRIPTION 6# Module defining a test harness which processes template input and 7# then compares the output against pre-define expected output. 8# Generates test output compatible with Test::Harness. This was 9# originally the t/texpect.pl script. 10# 11# AUTHOR 12# Andy Wardley <abw@wardley.org> 13# 14# COPYRIGHT 15# Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved. 16# 17# This module is free software; you can redistribute it and/or 18# modify it under the same terms as Perl itself. 19# 20#============================================================================ 21 22package Template::Test; 23 24use strict; 25use warnings; 26use Template qw( :template ); 27use Exporter; 28 29our $VERSION = 2.75; 30our $DEBUG = 0; 31our @ISA = qw( Exporter ); 32our @EXPORT = qw( ntests ok is match flush skip_all test_expect callsign banner ); 33our @EXPORT_OK = ( 'assert' ); 34our %EXPORT_TAGS = ( all => [ @EXPORT_OK, @EXPORT ] ); 35$| = 1; 36 37our $REASON = 'not applicable on this platform'; 38our $NO_FLUSH = 0; 39our $EXTRA = 0; # any extra tests to come after test_expect() 40our $PRESERVE = 0 # don't mangle newlines in output/expect 41 unless defined $PRESERVE; 42 43our ($loaded, %callsign); 44 45# always set binmode on Win32 machines so that any output generated 46# is true to what we expect 47$Template::BINMODE = ($^O eq 'MSWin32') ? 1 : 0; 48 49my @results = (); 50my ($ntests, $ok_count); 51*is = \&match; 52 53END { 54 # ensure flush() is called to print any cached results 55 flush(); 56} 57 58 59#------------------------------------------------------------------------ 60# ntests($n) 61# 62# Declare how many (more) tests are expected to come. If ok() is called 63# before ntests() then the results are cached instead of being printed 64# to STDOUT. When ntests() is called, the total number of tests 65# (including any cached) is known and the "1..$ntests" line can be 66# printed along with the cached results. After that, calls to ok() 67# generated printed output immediately. 68#------------------------------------------------------------------------ 69 70sub ntests { 71 $ntests = shift; 72 # add any pre-declared extra tests, or pre-stored test @results, to 73 # the grand total of tests 74 $ntests += $EXTRA + scalar @results; 75 $ok_count = 1; 76 print $ntests ? "1..$ntests\n" : "1..$ntests # skip $REASON\n"; 77 # flush cached results 78 foreach my $pre_test (@results) { 79 ok(@$pre_test); 80 } 81} 82 83 84#------------------------------------------------------------------------ 85# ok($truth, $msg) 86# 87# Tests the value passed for truth and generates an "ok $n" or "not ok $n" 88# line accordingly. If ntests() hasn't been called then we cached 89# results for later, instead. 90#------------------------------------------------------------------------ 91 92sub ok { 93 my ($ok, $msg) = @_; 94 95 # cache results if ntests() not yet called 96 unless ($ok_count) { 97 push(@results, [ $ok, $msg ]); 98 return $ok; 99 } 100 101 $msg = defined $msg ? " - $msg" : ''; 102 if ($ok) { 103 print "ok ", $ok_count++, "$msg\n"; 104 } 105 else { 106 print STDERR "FAILED $ok_count: $msg\n" if defined $msg; 107 print "not ok ", $ok_count++, "$msg\n"; 108 } 109} 110 111 112 113#------------------------------------------------------------------------ 114# assert($truth, $error) 115# 116# Test value for truth, die if false. 117#------------------------------------------------------------------------ 118 119sub assert { 120 my ($ok, $err) = @_; 121 return ok(1) if $ok; 122 123 # failed 124 my ($pkg, $file, $line) = caller(); 125 $err ||= "assert failed"; 126 $err .= " at $file line $line\n"; 127 ok(0); 128 die $err; 129} 130 131#------------------------------------------------------------------------ 132# match( $result, $expect ) 133#------------------------------------------------------------------------ 134 135sub match { 136 my ($result, $expect, $msg) = @_; 137 my $count = $ok_count ? $ok_count : scalar @results + 1; 138 139 # force stringification of $result to avoid 'no eq method' overload errors 140 $result = "$result" if ref $result; 141 142 if ($result eq $expect) { 143 return ok(1, $msg); 144 } 145 else { 146 print STDERR "FAILED $count:\n expect: [$expect]\n result: [$result]\n"; 147 return ok(0, $msg); 148 } 149} 150 151 152#------------------------------------------------------------------------ 153# flush() 154# 155# Flush any tests results. 156#------------------------------------------------------------------------ 157 158sub flush { 159 ntests(0) 160 unless $ok_count || $NO_FLUSH; 161} 162 163 164#------------------------------------------------------------------------ 165# skip_all($reason) 166# 167# Skip all tests, setting $REASON to contain any message passed. Calls 168# exit(0) which triggers flush() which generates a "1..0 # $REASON" 169# string to keep to test harness happy. 170#------------------------------------------------------------------------ 171 172sub skip_all { 173 $REASON = join('', @_); 174 exit(0); 175} 176 177 178#------------------------------------------------------------------------ 179# test_expect($input, $template, \%replace) 180# 181# This is the main testing sub-routine. The $input parameter should be a 182# text string or a filehandle reference (e.g. GLOB or IO::Handle) from 183# which the input text can be read. The input should contain a number 184# of tests which are split up and processed individually, comparing the 185# generated output against the expected output. Tests should be defined 186# as follows: 187# 188# -- test -- 189# test input 190# -- expect -- 191# expected output 192# 193# -- test -- 194# etc... 195# 196# The number of tests is determined and ntests() is called to generate 197# the "0..$n" line compatible with Test::Harness. Each test input is 198# then processed by the Template object passed as the second parameter, 199# $template. This may also be a hash reference containing configuration 200# which are used to instantiate a Template object, or may be left 201# undefined in which case a default Template object will be instantiated. 202# The third parameter, also optional, may be a reference to a hash array 203# defining template variables. This is passed to the template process() 204# method. 205#------------------------------------------------------------------------ 206 207sub test_expect { 208 my ($src, $tproc, $params) = @_; 209 my ($input, @tests); 210 my ($output, $expect, $match); 211 my $count = 0; 212 my $ttprocs; 213 214 # read input text 215 eval { 216 local $/ = undef; 217 $input = ref $src ? <$src> : $src; 218 }; 219 if ($@) { 220 ntests(1); ok(0); 221 warn "Cannot read input text from $src\n"; 222 return undef; 223 } 224 225 # remove any comment lines 226 $input =~ s/^#.*?\n//gm; 227 228 # remove anything before '-- start --' and/or after '-- stop --' 229 $input = $' if $input =~ /\s*--\s*start\s*--\s*/; 230 $input = $` if $input =~ /\s*--\s*stop\s*--\s*/; 231 232 @tests = split(/^\s*--\s*test\s*--\s*\n/im, $input); 233 234 # if the first line of the file was '--test--' (optional) then the 235 # first test will be empty and can be discarded 236 shift(@tests) if $tests[0] =~ /^\s*$/; 237 238 ntests(3 + scalar(@tests) * 2); 239 240 # first test is that Template loaded OK, which it did 241 ok(1, 'running test_expect()'); 242 243 # optional second param may contain a Template reference or a HASH ref 244 # of constructor options, or may be undefined 245 if (ref($tproc) eq 'HASH') { 246 # create Template object using hash of config items 247 $tproc = Template->new($tproc) 248 || die Template->error(), "\n"; 249 } 250 elsif (ref($tproc) eq 'ARRAY') { 251 # list of [ name => $tproc, name => $tproc ], use first $tproc 252 $ttprocs = { @$tproc }; 253 $tproc = $tproc->[1]; 254 } 255 elsif (! ref $tproc) { 256 $tproc = Template->new() 257 || die Template->error(), "\n"; 258 } 259 # otherwise, we assume it's a Template reference 260 261 # test: template processor created OK 262 ok($tproc, 'template processor is engaged'); 263 264 # third test is that the input read ok, which it did 265 ok(1, 'input read and split into ' . scalar @tests . ' tests'); 266 267 # the remaining tests are defined in @tests... 268 foreach $input (@tests) { 269 $count++; 270 my $name = ''; 271 272 if ($input =~ s/^\s*-- name:? (.*?) --\s*\n//im) { 273 $name = $1; 274 } 275 else { 276 $name = "template text $count"; 277 } 278 279 # Configure a test as TODO 280 my $todo = ''; 281 if ($input =~ s/^\s*-- todo:? (.*?) --\s*\n//im) { 282 $todo = ( $1 eq '' ) ? 'No reason given' : $1; 283 } 284 285 # split input by a line like "-- expect --" 286 ($input, $expect) = 287 split(/^\s*--\s*expect\s*--\s*\n/im, $input); 288 $expect = '' 289 unless defined $expect; 290 291 $output = ''; 292 293 # input text may be prefixed with "-- use name --" to indicate a 294 # Template object in the $ttproc hash which we should use 295 if ($input =~ s/^\s*--\s*use\s+(\S+)\s*--\s*\n//im) { 296 my $ttname = $1; 297 my $ttlookup; 298 if ($ttlookup = $ttprocs->{ $ttname }) { 299 $tproc = $ttlookup; 300 } 301 else { 302 warn "no such template object to use: $ttname\n"; 303 } 304 } 305 306 # process input text 307 $tproc->process(\$input, $params, \$output) || do { 308 warn "Template process failed: ", $tproc->error(), "\n"; 309 # report failure and automatically fail the expect match 310 ok(0, "$name process FAILED: " . subtext($input)); 311 ok(0, '(obviously did not match expected)'); 312 next; 313 }; 314 315 # processed OK 316 ok(1, "$name processed OK: " . subtext($input)); 317 318 # another hack: if the '-- expect --' section starts with 319 # '-- process --' then we process the expected output 320 # before comparing it with the generated output. This is 321 # slightly twisted but it makes it possible to run tests 322 # where the expected output isn't static. See t/date.t for 323 # an example. 324 325 if ($expect =~ s/^\s*--+\s*process\s*--+\s*\n//im) { 326 my $out; 327 $tproc->process(\$expect, $params, \$out) || do { 328 warn("Template process failed (expect): ", 329 $tproc->error(), "\n"); 330 # report failure and automatically fail the expect match 331 ok(0, "failed to process expected output [" 332 . subtext($expect) . ']'); 333 next; 334 }; 335 $expect = $out; 336 }; 337 338 # strip any trailing blank lines from expected and real output 339 foreach ($expect, $output) { 340 s/[\n\r]*\Z//mg; 341 } 342 343 $match = ($expect eq $output) ? 1 : 0; 344 if (! $match || $DEBUG) { 345 print "MATCH FAILED\n" 346 unless $match; 347 348 my ($copyi, $copye, $copyo) = ($input, $expect, $output); 349 unless ($PRESERVE) { 350 foreach ($copyi, $copye, $copyo) { 351 s/\n/\\n/g; 352 } 353 } 354 printf(" input: [%s]\nexpect: [%s]\noutput: [%s]\n", 355 $copyi, $copye, $copyo); 356 } 357 358 my $testprefix = $name; 359 if ( $todo ) { 360 $testprefix = "# TODO $todo - $name"; 361 } 362 363 ok($match, $match ? "$testprefix matched expected" : "$testprefix did not match expected"); 364 }; 365} 366 367#------------------------------------------------------------------------ 368# callsign() 369# 370# Returns a hash array mapping lower a..z to their phonetic alphabet 371# equivalent. 372#------------------------------------------------------------------------ 373 374sub callsign { 375 my %callsign; 376 @callsign{ 'a'..'z' } = qw( 377 alpha bravo charlie delta echo foxtrot golf hotel india 378 juliet kilo lima mike november oscar papa quebec romeo 379 sierra tango umbrella victor whisky x-ray yankee zulu ); 380 return \%callsign; 381} 382 383 384#------------------------------------------------------------------------ 385# banner($text) 386# 387# Prints a banner with the specified text if $DEBUG is set. 388#------------------------------------------------------------------------ 389 390sub banner { 391 return unless $DEBUG; 392 my $text = join('', @_); 393 my $count = $ok_count ? $ok_count - 1 : scalar @results; 394 print "-" x 72, "\n$text ($count tests completed)\n", "-" x 72, "\n"; 395} 396 397 398sub subtext { 399 my $text = shift; 400 $text =~ s/\s*$//sg; 401 $text = substr($text, 0, 32) . '...' if length $text > 32; 402 $text =~ s/\n/\\n/g; 403 return $text; 404} 405 406 4071; 408 409__END__ 410 411=head1 NAME 412 413Template::Test - Module for automating TT2 test scripts 414 415=head1 SYNOPSIS 416 417 use Template::Test; 418 419 $Template::Test::DEBUG = 0; # set this true to see each test running 420 $Template::Test::EXTRA = 2; # 2 extra tests follow test_expect()... 421 422 # ok() can be called any number of times before test_expect 423 ok( $true_or_false ) 424 425 # test_expect() splits $input into individual tests, processes each 426 # and compares generated output against expected output 427 test_expect($input, $template, \%replace ); 428 429 # $input is text or filehandle (e.g. DATA section after __END__) 430 test_expect( $text ); 431 test_expect( \*DATA ); 432 433 # $template is a Template object or configuration hash 434 my $template_cfg = { ... }; 435 test_expect( $input, $template_cfg ); 436 my $template_obj = Template->new($template_cfg); 437 test_expect( $input, $template_obj ); 438 439 # $replace is a hash reference of template variables 440 my $replace = { 441 a => 'alpha', 442 b => 'bravo' 443 }; 444 test_expect( $input, $template, $replace ); 445 446 # ok() called after test_expect should be declared in $EXTRA (2) 447 ok( $true_or_false ) 448 ok( $true_or_false ) 449 450=head1 DESCRIPTION 451 452The C<Template::Test> module defines the L<test_expect()> and other related 453subroutines which can be used to automate test scripts for the 454Template Toolkit. See the numerous tests in the F<t> sub-directory of 455the distribution for examples of use. 456 457=head1 PACKAGE SUBROUTINES 458 459=head2 text_expect() 460 461The C<test_expect()> subroutine splits an input document into a number 462of separate tests, processes each one using the Template Toolkit and 463then compares the generated output against an expected output, also 464specified in the input document. It generates the familiar 465C<ok>/C<not ok> output compatible with C<Test::Harness>. 466 467The test input should be specified as a text string or a reference to 468a filehandle (e.g. C<GLOB> or C<IO::Handle>) from which it can be read. In 469particular, this allows the test input to be placed after the C<__END__> 470marker and read via the C<DATA> filehandle. 471 472 use Template::Test; 473 474 test_expect(\*DATA); 475 476 __END__ 477 # this is the first test (this is a comment) 478 -- test -- 479 blah blah blah [% foo %] 480 -- expect -- 481 blah blah blah value_of_foo 482 483 # here's the second test (no surprise, so is this) 484 -- test -- 485 more blah blah [% bar %] 486 -- expect -- 487 more blah blah value_of_bar 488 489Blank lines between test sections are generally ignored. Any line starting 490with C<#> is treated as a comment and is ignored. 491 492The second and third parameters to C<test_expect()> are optional. The second 493may be either a reference to a Template object which should be used to 494process the template fragments, or a reference to a hash array containing 495configuration values which should be used to instantiate a new Template 496object. 497 498 # pass reference to config hash 499 my $config = { 500 INCLUDE_PATH => '/here/there:/every/where', 501 POST_CHOMP => 1, 502 }; 503 test_expect(\*DATA, $config); 504 505 # or create Template object explicitly 506 my $template = Template->new($config); 507 test_expect(\*DATA, $template); 508 509The third parameter may be used to reference a hash array of template 510variable which should be defined when processing the tests. This is 511passed to the L<Template> L<process()|Template#process()> method. 512 513 my $replace = { 514 a => 'alpha', 515 b => 'bravo', 516 }; 517 518 test_expect(\*DATA, $config, $replace); 519 520The second parameter may be left undefined to specify a default L<Template> 521configuration. 522 523 test_expect(\*DATA, undef, $replace); 524 525For testing the output of different L<Template> configurations, a 526reference to a list of named L<Template> objects also may be passed as 527the second parameter. 528 529 my $tt1 = Template->new({ ... }); 530 my $tt2 = Template->new({ ... }); 531 my @tts = [ one => $tt1, two => $tt1 ]; 532 533The first object in the list is used by default. Other objects may be 534switched in with a 'C<-- use $name -->' marker. This should immediately 535follow a 'C<-- test -->' line. That object will then be used for the rest 536of the test, or until a different object is selected. 537 538 -- test -- 539 -- use one -- 540 [% blah %] 541 -- expect -- 542 blah, blah 543 544 -- test -- 545 still using one... 546 -- expect -- 547 ... 548 549 -- test -- 550 -- use two -- 551 [% blah %] 552 -- expect -- 553 blah, blah, more blah 554 555The C<test_expect()> sub counts the number of tests, and then calls L<ntests()> 556to generate the familiar "C<1..$ntests\n>" test harness line. Each 557test defined generates two test numbers. The first indicates 558that the input was processed without error, and the second that the 559output matches that expected. 560 561Additional test may be run before C<test_expect()> by calling L<ok()>. These 562test results are cached until L<ntests()> is called and the final number of 563tests can be calculated. Then, the "C<1..$ntests>" line is output, along with 564"C<ok $n>" / "C<not ok $n>" lines for each of the cached test result. 565Subsequent calls to L<ok()> then generate an output line immediately. 566 567 my $something = SomeObject->new(); 568 ok( $something ); 569 570 my $other = AnotherThing->new(); 571 ok( $other ); 572 573 test_expect(\*DATA); 574 575If any tests are to follow after C<test_expect()> is called then these 576should be pre-declared by setting the C<$EXTRA> package variable. This 577value (default: C<0>) is added to the grand total calculated by L<ntests()>. 578The results of the additional tests are also registered by calling L<ok()>. 579 580 $Template::Test::EXTRA = 2; 581 582 # can call ok() any number of times before test_expect() 583 ok( $did_that_work ); 584 ok( $make_sure ); 585 ok( $dead_certain ); 586 587 # <some> number of tests... 588 test_expect(\*DATA, $config, $replace); 589 590 # here's those $EXTRA tests 591 ok( defined $some_result && ref $some_result eq 'ARRAY' ); 592 ok( $some_result->[0] eq 'some expected value' ); 593 594If you don't want to call C<test_expect()> at all then you can call 595C<ntests($n)> to declare the number of tests and generate the test 596header line. After that, simply call L<ok()> for each test passing 597a true or false values to indicate that the test passed or failed. 598 599 ntests(2); 600 ok(1); 601 ok(0); 602 603If you're really lazy, you can just call L<ok()> and not bother declaring 604the number of tests at all. All tests results will be cached until the 605end of the script and then printed in one go before the program exits. 606 607 ok( $x ); 608 ok( $y ); 609 610You can identify only a specific part of the input file for testing 611using the 'C<-- start -->' and 'C<-- stop -->' markers. Anything before the 612first 'C<-- start -->' is ignored, along with anything after the next 613'C<-- stop -->' marker. 614 615 -- test -- 616 this is test 1 (not performed) 617 -- expect -- 618 this is test 1 (not performed) 619 620 -- start -- 621 622 -- test -- 623 this is test 2 624 -- expect -- 625 this is test 2 626 627 -- stop -- 628 629 ... 630 631=head2 ntests() 632 633Subroutine used to specify how many tests you're expecting to run. 634 635=head2 ok($test) 636 637Generates an "C<ok $n>" or "C<not ok $n>" message if C<$test> is true or false. 638 639=head2 not_ok($test) 640 641The logical inverse of L<ok()>. Prints an "C<ok $n>" message is C<$test> is 642I<false> and vice-versa. 643 644=head2 callsign() 645 646For historical reasons and general utility, the module also defines a 647C<callsign()> subroutine which returns a hash mapping the letters C<a> 648to C<z> to their phonetic alphabet equivalent (e.g. radio callsigns). 649This is used by many of the test scripts as a known source of variable values. 650 651 test_expect(\*DATA, $config, callsign()); 652 653=head2 banner() 654 655This subroutine prints a simple banner including any text passed as parameters. 656The C<$DEBUG> variable must be set for it to generate any output. 657 658 banner('Testing something-or-other'); 659 660example output: 661 662 #------------------------------------------------------------ 663 # Testing something-or-other (27 tests completed) 664 #------------------------------------------------------------ 665 666=head1 PACKAGE VARIABLES 667 668=head2 $DEBUG 669 670The $DEBUG package variable can be set to enable debugging mode. 671 672=head2 $PRESERVE 673 674The $PRESERVE package variable can be set to stop the test_expect() 675from converting newlines in the output and expected output into 676the literal strings '\n'. 677 678=head1 HISTORY 679 680This module started its butt-ugly life as the C<t/texpect.pl> script. It 681was cleaned up to became the C<Template::Test> module some time around 682version 0.29. It underwent further cosmetic surgery for version 2.00 683but still retains some remarkable rear-end resemblances. 684 685Since then the C<Test::More> and related modules have appeared on CPAN 686making this module mostly, but not entirely, redundant. 687 688=head1 BUGS / KNOWN "FEATURES" 689 690Imports all methods by default. This is generally a Bad Thing, but 691this module is only used in test scripts (i.e. at build time) so a) we 692don't really care and b) it saves typing. 693 694The line splitter may be a bit dumb, especially if it sees lines like 695C<-- this --> that aren't supposed to be special markers. So don't do that. 696 697=head1 AUTHOR 698 699Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/> 700 701=head1 COPYRIGHT 702 703Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved. 704 705This module is free software; you can redistribute it and/or 706modify it under the same terms as Perl itself. 707 708=head1 SEE ALSO 709 710L<Template> 711 712=cut 713 714# Local Variables: 715# mode: perl 716# perl-indent-level: 4 717# indent-tabs-mode: nil 718# End: 719# 720# vim: expandtab shiftwidth=4: 721