[Templates-cvs] cvs commit: TT3/lib/Template Test.pm

[cvs@template-toolkit.org]

cvs         04/11/08 18:49:06

  Modified:    lib/Template Test.pm
  Log:
  * added features to make Template::Test more like Test::More
  
  Revision  Changes    Path
  1.2       +121 -12   TT3/lib/Template/Test.pm
  
  Index: Test.pm
  ===================================================================
  RCS file: /template-toolkit/TT3/lib/Template/Test.pm,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- Test.pm	2004/03/25 16:58:40	1.1
  +++ Test.pm	2004/11/08 18:49:06	1.2
  @@ -18,7 +18,7 @@
   #   modify it under the same terms as Perl itself.
   #
   # REVISION
  -#   $Id: Test.pm,v 1.1 2004/03/25 16:58:40 abw Exp $
  +#   $Id: Test.pm,v 1.2 2004/11/08 18:49:06 abw Exp $
   #
   #========================================================================
   
  @@ -29,20 +29,37 @@
   use Exporter;
   use Template::Base;
   use base qw( Template::Base Exporter );
  -use vars qw( $VERSION $DEBUG $ERROR $WARNING 
  -             $MAGIC $DATA $DIFF @EXPORT_OK %EXPORT_TAGS );
   
  -$VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
  -$DEBUG   = 0 unless defined $DEBUG;
  -$ERROR   = '';
  -$MAGIC   = '\s* -- \s*';
  +our $VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
  +our $DEBUG   = 0 unless defined $DEBUG;
  +our $ERROR   = '';
  +our $MAGIC   = '\s* -- \s*';
  +our $EXTRA   = 0;
  +our $COUNT   = 0;
  +our $EXPECT  = 0;
  +our $REASON  = 'not applicable on this platform';
  +our ($DATA, @RESULTS);
   
   # can we generate a nice diff output?
   eval "use Algorithm::Diff qw( diff )";
  -$DIFF = $@ ? 0 : 1;
  +our $DIFF = $@ ? 0 : 1;
   
  -@EXPORT_OK   = qw( data_text data_tests test_expect diff_result $DIFF );
  -%EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
  +our @EXPORT      = qw( ok is plan );
  +our @EXPORT_OK   = qw( data_text data_tests test_expect diff_result $DIFF );
  +our %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_OK ] );
  +
  +END {
  +    # ensure flush() is called to print any cached results 
  +    flush();
  +
  +    my $ran = $COUNT - 1;
  +    if ($ran < $EXPECT) {
  +        print "# Looks like you planned $EXPECT tests but only ran $ran.\n";
  +    }
  +    elsif ($ran > $EXPECT) {
  +        print "# Looks like you planned only $EXPECT tests but ran $ran.\n";
  +    }
  +}
   
   
   #------------------------------------------------------------------------
  @@ -57,6 +74,7 @@
   sub data_text {
       return $DATA if defined $DATA;
       local $/ = undef;
  +    no warnings;
       $DATA = <main::DATA>;
       $DATA =~ s/^__END__.*//sm;
       return $DATA;
  @@ -139,7 +157,7 @@
       my $tests   = $config->{ tests } || data_tests();
       my $handler = $config->{ handler } 
           || die "no handler provider for test_expect()\n";
  -    my $ok = $config->{ ok } 
  +    my $ok = $config->{ ok } || \&ok
           || die "no ok() subroutine provided for test_expect()\n";
   
       foreach my $test (@$tests) {
  @@ -189,6 +207,97 @@
   }
   
   
  +#------------------------------------------------------------------------
  +# plan($n)
  +#
  +# Declare how many (more) tests are expected to come.  If ok() is called 
  +# before plan() then the results are cached instead of being printed
  +# to STDOUT.  When plan() is called, the total number of tests 
  +# (including any cached) is known and the "1..$n" line can be
  +# printed along with the cached results.  After that, calls to ok() 
  +# generated printed output immediately.
  +#------------------------------------------------------------------------
  +
  +sub plan {
  +    my $tests = shift;
  +
  +    # add any pre-declared extra tests, or pre-stored test @results, to 
  +    # the grand total of tests
  +    $tests += $EXTRA + scalar @RESULTS;	 
  +
  +    $COUNT = 1;
  +    print $tests ? "1..$tests\n" : "1..$tests # skipped: $REASON\n";
  +        
  +    $EXPECT = $tests;
  +
  +    # flush cached results
  +    foreach my $pre_test (@RESULTS) {
  +        ok(@$pre_test);
  +    }
  +}
  +
  +
  +#------------------------------------------------------------------------
  +# ok($truth, $msg)
  +#
  +# Tests the value passed for truth and generates an "ok $n" or "not ok $n"
  +# line accordingly.  If ntests() hasn't been called then we cached 
  +# results for later, instead.
  +#------------------------------------------------------------------------
  +
  +sub ok {
  +    my ($ok, $msg) = @_;
  +
  +    # cache results if ntests() not yet called
  +    unless ($COUNT) {
  +        push(@RESULTS, [ $ok, $msg ]);
  +        return $ok;
  +    }
  +
  +    $msg = defined $msg ? " - $msg" : '';
  +
  +    if ($ok) {
  +        print "ok ", $COUNT++, "$msg\n";
  +    }
  +    else {
  +        print STDERR "FAILED $COUNT: $msg\n" if defined $msg;
  +        print "not ok ", $COUNT++, "$msg\n";
  +    }
  +}
  +
  +
  +
  +#------------------------------------------------------------------------
  +# is( $result, $expect, $message )
  +#------------------------------------------------------------------------
  +
  +sub is {
  +    my ($result, $expect, $msg) = @_;
  +    my $count = $COUNT ? $COUNT : scalar @RESULTS + 1;
  +
  +    # force stringification of $result to avoid 'no eq method' overload errors
  +    $result = "$result" if ref $result;	   
  +
  +    if ($result eq $expect) {
  +        return ok(1, $msg);
  +    }
  +    else {
  +        print STDERR "FAILED $count:\n  expect: [$expect]\n  result: [$result]\n";
  +        return ok(0, $msg);
  +    }
  +}
  +
  +
  +#------------------------------------------------------------------------
  +# flush()
  +#
  +# Flush any tests results.
  +#------------------------------------------------------------------------
  +
  +sub flush {
  +    plan(0)
  +        unless $COUNT;   #  || $NO_FLUSH;
  +}
   
   
   1;
  @@ -330,7 +439,7 @@
   
   =head1 VERSION
   
  -$Revision: 1.1 $
  +$Revision: 1.2 $
   
   =head1 COPYRIGHT