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 # split input by a line like "-- expect --" 280 ($input, $expect) = 281 split(/^\s*--\s*expect\s*--\s*\n/im, $input); 282 $expect = '' 283 unless defined $expect; 284 285 $output = ''; 286 287 # input text may be prefixed with "-- use name --" to indicate a 288 # Template object in the $ttproc hash which we should use 289 if ($input =~ s/^\s*--\s*use\s+(\S+)\s*--\s*\n//im) { 290 my $ttname = $1; 291 my $ttlookup; 292 if ($ttlookup = $ttprocs->{ $ttname }) { 293 $tproc = $ttlookup; 294 } 295 else { 296 warn "no such template object to use: $ttname\n"; 297 } 298 } 299 300 # process input text 301 $tproc->process(\$input, $params, \$output) || do { 302 warn "Template process failed: ", $tproc->error(), "\n"; 303 # report failure and automatically fail the expect match 304 ok(0, "$name process FAILED: " . subtext($input)); 305 ok(0, '(obviously did not match expected)'); 306 next; 307 }; 308 309 # processed OK 310 ok(1, "$name processed OK: " . subtext($input)); 311 312 # another hack: if the '-- expect --' section starts with 313 # '-- process --' then we process the expected output 314 # before comparing it with the generated output. This is 315 # slightly twisted but it makes it possible to run tests 316 # where the expected output isn't static. See t/date.t for 317 # an example. 318 319 if ($expect =~ s/^\s*--+\s*process\s*--+\s*\n//im) { 320 my $out; 321 $tproc->process(\$expect, $params, \$out) || do { 322 warn("Template process failed (expect): ", 323 $tproc->error(), "\n"); 324 # report failure and automatically fail the expect match 325 ok(0, "failed to process expected output [" 326 . subtext($expect) . ']'); 327 next; 328 }; 329 $expect = $out; 330 }; 331 332 # strip any trailing blank lines from expected and real output 333 foreach ($expect, $output) { 334 s/[\n\r]*\Z//mg; 335 } 336 337 $match = ($expect eq $output) ? 1 : 0; 338 if (! $match || $DEBUG) { 339 print "MATCH FAILED\n" 340 unless $match; 341 342 my ($copyi, $copye, $copyo) = ($input, $expect, $output); 343 unless ($PRESERVE) { 344 foreach ($copyi, $copye, $copyo) { 345 s/\n/\\n/g; 346 } 347 } 348 printf(" input: [%s]\nexpect: [%s]\noutput: [%s]\n", 349 $copyi, $copye, $copyo); 350 } 351 352 ok($match, $match ? "$name matched expected" : "$name did not match expected"); 353 }; 354} 355 356#------------------------------------------------------------------------ 357# callsign() 358# 359# Returns a hash array mapping lower a..z to their phonetic alphabet 360# equivalent. 361#------------------------------------------------------------------------ 362 363sub callsign { 364 my %callsign; 365 @callsign{ 'a'..'z' } = qw( 366 alpha bravo charlie delta echo foxtrot golf hotel india 367 juliet kilo lima mike november oscar papa quebec romeo 368 sierra tango umbrella victor whisky x-ray yankee zulu ); 369 return \%callsign; 370} 371 372 373#------------------------------------------------------------------------ 374# banner($text) 375# 376# Prints a banner with the specified text if $DEBUG is set. 377#------------------------------------------------------------------------ 378 379sub banner { 380 return unless $DEBUG; 381 my $text = join('', @_); 382 my $count = $ok_count ? $ok_count - 1 : scalar @results; 383 print "-" x 72, "\n$text ($count tests completed)\n", "-" x 72, "\n"; 384} 385 386 387sub subtext { 388 my $text = shift; 389 $text =~ s/\s*$//sg; 390 $text = substr($text, 0, 32) . '...' if length $text > 32; 391 $text =~ s/\n/\\n/g; 392 return $text; 393} 394 395 3961; 397 398__END__ 399 400=head1 NAME 401 402Template::Test - Module for automating TT2 test scripts 403 404=head1 SYNOPSIS 405 406 use Template::Test; 407 408 $Template::Test::DEBUG = 0; # set this true to see each test running 409 $Template::Test::EXTRA = 2; # 2 extra tests follow test_expect()... 410 411 # ok() can be called any number of times before test_expect 412 ok( $true_or_false ) 413 414 # test_expect() splits $input into individual tests, processes each 415 # and compares generated output against expected output 416 test_expect($input, $template, \%replace ); 417 418 # $input is text or filehandle (e.g. DATA section after __END__) 419 test_expect( $text ); 420 test_expect( \*DATA ); 421 422 # $template is a Template object or configuration hash 423 my $template_cfg = { ... }; 424 test_expect( $input, $template_cfg ); 425 my $template_obj = Template->new($template_cfg); 426 test_expect( $input, $template_obj ); 427 428 # $replace is a hash reference of template variables 429 my $replace = { 430 a => 'alpha', 431 b => 'bravo' 432 }; 433 test_expect( $input, $template, $replace ); 434 435 # ok() called after test_expect should be declared in $EXTRA (2) 436 ok( $true_or_false ) 437 ok( $true_or_false ) 438 439=head1 DESCRIPTION 440 441The C<Template::Test> module defines the L<test_expect()> and other related 442subroutines which can be used to automate test scripts for the 443Template Toolkit. See the numerous tests in the F<t> sub-directory of 444the distribution for examples of use. 445 446=head1 PACKAGE SUBROUTINES 447 448=head2 text_expect() 449 450The C<test_expect()> subroutine splits an input document into a number 451of separate tests, processes each one using the Template Toolkit and 452then compares the generated output against an expected output, also 453specified in the input document. It generates the familiar 454C<ok>/C<not ok> output compatible with C<Test::Harness>. 455 456The test input should be specified as a text string or a reference to 457a filehandle (e.g. C<GLOB> or C<IO::Handle>) from which it can be read. In 458particular, this allows the test input to be placed after the C<__END__> 459marker and read via the C<DATA> filehandle. 460 461 use Template::Test; 462 463 test_expect(\*DATA); 464 465 __END__ 466 # this is the first test (this is a comment) 467 -- test -- 468 blah blah blah [% foo %] 469 -- expect -- 470 blah blah blah value_of_foo 471 472 # here's the second test (no surprise, so is this) 473 -- test -- 474 more blah blah [% bar %] 475 -- expect -- 476 more blah blah value_of_bar 477 478Blank lines between test sections are generally ignored. Any line starting 479with C<#> is treated as a comment and is ignored. 480 481The second and third parameters to C<test_expect()> are optional. The second 482may be either a reference to a Template object which should be used to 483process the template fragments, or a reference to a hash array containing 484configuration values which should be used to instantiate a new Template 485object. 486 487 # pass reference to config hash 488 my $config = { 489 INCLUDE_PATH => '/here/there:/every/where', 490 POST_CHOMP => 1, 491 }; 492 test_expect(\*DATA, $config); 493 494 # or create Template object explicitly 495 my $template = Template->new($config); 496 test_expect(\*DATA, $template); 497 498The third parameter may be used to reference a hash array of template 499variable which should be defined when processing the tests. This is 500passed to the L<Template> L<process()|Template#process()> method. 501 502 my $replace = { 503 a => 'alpha', 504 b => 'bravo', 505 }; 506 507 test_expect(\*DATA, $config, $replace); 508 509The second parameter may be left undefined to specify a default L<Template> 510configuration. 511 512 test_expect(\*DATA, undef, $replace); 513 514For testing the output of different L<Template> configurations, a 515reference to a list of named L<Template> objects also may be passed as 516the second parameter. 517 518 my $tt1 = Template->new({ ... }); 519 my $tt2 = Template->new({ ... }); 520 my @tts = [ one => $tt1, two => $tt1 ]; 521 522The first object in the list is used by default. Other objects may be 523switched in with a 'C<-- use $name -->' marker. This should immediately 524follow a 'C<-- test -->' line. That object will then be used for the rest 525of the test, or until a different object is selected. 526 527 -- test -- 528 -- use one -- 529 [% blah %] 530 -- expect -- 531 blah, blah 532 533 -- test -- 534 still using one... 535 -- expect -- 536 ... 537 538 -- test -- 539 -- use two -- 540 [% blah %] 541 -- expect -- 542 blah, blah, more blah 543 544The C<test_expect()> sub counts the number of tests, and then calls L<ntests()> 545to generate the familiar "C<1..$ntests\n>" test harness line. Each 546test defined generates two test numbers. The first indicates 547that the input was processed without error, and the second that the 548output matches that expected. 549 550Additional test may be run before C<test_expect()> by calling L<ok()>. These 551test results are cached until L<ntests()> is called and the final number of 552tests can be calculated. Then, the "C<1..$ntests>" line is output, along with 553"C<ok $n>" / "C<not ok $n>" lines for each of the cached test result. 554Subsequent calls to L<ok()> then generate an output line immediately. 555 556 my $something = SomeObject->new(); 557 ok( $something ); 558 559 my $other = AnotherThing->new(); 560 ok( $other ); 561 562 test_expect(\*DATA); 563 564If any tests are to follow after C<test_expect()> is called then these 565should be pre-declared by setting the C<$EXTRA> package variable. This 566value (default: C<0>) is added to the grand total calculated by L<ntests()>. 567The results of the additional tests are also registered by calling L<ok()>. 568 569 $Template::Test::EXTRA = 2; 570 571 # can call ok() any number of times before test_expect() 572 ok( $did_that_work ); 573 ok( $make_sure ); 574 ok( $dead_certain ); 575 576 # <some> number of tests... 577 test_expect(\*DATA, $config, $replace); 578 579 # here's those $EXTRA tests 580 ok( defined $some_result && ref $some_result eq 'ARRAY' ); 581 ok( $some_result->[0] eq 'some expected value' ); 582 583If you don't want to call C<test_expect()> at all then you can call 584C<ntests($n)> to declare the number of tests and generate the test 585header line. After that, simply call L<ok()> for each test passing 586a true or false values to indicate that the test passed or failed. 587 588 ntests(2); 589 ok(1); 590 ok(0); 591 592If you're really lazy, you can just call L<ok()> and not bother declaring 593the number of tests at all. All tests results will be cached until the 594end of the script and then printed in one go before the program exits. 595 596 ok( $x ); 597 ok( $y ); 598 599You can identify only a specific part of the input file for testing 600using the 'C<-- start -->' and 'C<-- stop -->' markers. Anything before the 601first 'C<-- start -->' is ignored, along with anything after the next 602'C<-- stop -->' marker. 603 604 -- test -- 605 this is test 1 (not performed) 606 -- expect -- 607 this is test 1 (not performed) 608 609 -- start -- 610 611 -- test -- 612 this is test 2 613 -- expect -- 614 this is test 2 615 616 -- stop -- 617 618 ... 619 620=head2 ntests() 621 622Subroutine used to specify how many tests you're expecting to run. 623 624=head2 ok($test) 625 626Generates an "C<ok $n>" or "C<not ok $n>" message if C<$test> is true or false. 627 628=head2 not_ok($test) 629 630The logical inverse of L<ok()>. Prints an "C<ok $n>" message is C<$test> is 631I<false> and vice-versa. 632 633=head2 callsign() 634 635For historical reasons and general utility, the module also defines a 636C<callsign()> subroutine which returns a hash mapping the letters C<a> 637to C<z> to their phonetic alphabet equivalent (e.g. radio callsigns). 638This is used by many of the test scripts as a known source of variable values. 639 640 test_expect(\*DATA, $config, callsign()); 641 642=head2 banner() 643 644This subroutine prints a simple banner including any text passed as parameters. 645The C<$DEBUG> variable must be set for it to generate any output. 646 647 banner('Testing something-or-other'); 648 649example output: 650 651 #------------------------------------------------------------ 652 # Testing something-or-other (27 tests completed) 653 #------------------------------------------------------------ 654 655=head1 PACKAGE VARIABLES 656 657=head2 $DEBUG 658 659The $DEBUG package variable can be set to enable debugging mode. 660 661=head2 $PRESERVE 662 663The $PRESERVE package variable can be set to stop the test_expect() 664from converting newlines in the output and expected output into 665the literal strings '\n'. 666 667=head1 HISTORY 668 669This module started its butt-ugly life as the C<t/texpect.pl> script. It 670was cleaned up to became the C<Template::Test> module some time around 671version 0.29. It underwent further cosmetic surgery for version 2.00 672but still retains some remarkable rear-end resemblances. 673 674Since then the C<Test::More> and related modules have appeared on CPAN 675making this module mostly, but not entirely, redundant. 676 677=head1 BUGS / KNOWN "FEATURES" 678 679Imports all methods by default. This is generally a Bad Thing, but 680this module is only used in test scripts (i.e. at build time) so a) we 681don't really care and b) it saves typing. 682 683The line splitter may be a bit dumb, especially if it sees lines like 684C<-- this --> that aren't supposed to be special markers. So don't do that. 685 686=head1 AUTHOR 687 688Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/> 689 690=head1 COPYRIGHT 691 692Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved. 693 694This module is free software; you can redistribute it and/or 695modify it under the same terms as Perl itself. 696 697=head1 SEE ALSO 698 699L<Template> 700 701=cut 702 703# Local Variables: 704# mode: perl 705# perl-indent-level: 4 706# indent-tabs-mode: nil 707# End: 708# 709# vim: expandtab shiftwidth=4: 710