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

[cvs@template-toolkit.org]

cvs         04/12/01 10:47:44

  Modified:    lib/Template Test.pm
  Log:
  * enhancements to test output
  
  Revision  Changes    Path
  1.7       +53 -27    TT3/lib/Template/Test.pm
  
  Index: Test.pm
  ===================================================================
  RCS file: /template-toolkit/TT3/lib/Template/Test.pm,v
  retrieving revision 1.6
  retrieving revision 1.7
  diff -u -r1.6 -r1.7
  --- Test.pm	2004/11/26 12:45:44	1.6
  +++ Test.pm	2004/12/01 10:47:44	1.7
  @@ -16,7 +16,7 @@
   #   modify it under the same terms as Perl itself.
   #
   # REVISION
  -#   $Id: Test.pm,v 1.6 2004/11/26 12:45:44 abw Exp $
  +#   $Id: Test.pm,v 1.7 2004/12/01 10:47:44 abw Exp $
   #
   #========================================================================
   
  @@ -28,7 +28,7 @@
   use Template::Base;
   use base qw( Template::Base Exporter );
   
  -our $VERSION = sprintf("%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/);
  +our $VERSION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/);
   our $DEBUG   = 0 unless defined $DEBUG;
   our $ERROR   = '';
   our $MAGIC   = '\s* -- \s*';
  @@ -215,12 +215,10 @@
       my $tests   = $config->{ tests } || data_tests();
       my $handler = $config->{ handler } 
           || die "no handler provider for test_expect()\n";
  -    my $ok = $config->{ ok } || \&ok
  -        || die "no ok() subroutine provided for test_expect()\n";
   
       foreach my $test (@$tests) {
           if (grep(/skip/, @{ $test->{ inflags } })) {
  -            &$ok( 1, "skipping test: $test->{ name }" );
  +            ok( 1, "skipping test: $test->{ name }" );
               next;
           }
   
  @@ -228,22 +226,22 @@
           chomp $result;
           
           if ($result eq $test->{ expect }) {
  -            &$ok(1, $test->{ name });
  +            ok(1, $test->{ name });
           }
           else {
  -            &$ok(0, "$test->{ name } did not match");
  -#            if ($config->{ debug } || $config->{ $DEBUG) {
  -                my ($e, $r) = ($test->{ expect }, $result);
  -                for ($e, $r) {
  -                    s/^/#/gm;
  -                }
  -                print STDERR "# -- expect --\n$e\n";
  -                print STDERR "# -- result --\n$r\n";
  -                if ($DIFF) {
  -                    print STDERR "# -- diffs --\n";
  -                    diff_result($test->{ expect }, $result);
  -                }
  +            # pass it over to is() to make pretty 
  +            is( $result, $test->{ expect }, $test->{ name });
  +#            ok(0, "$test->{ name } did not match");
  +#            my ($e, $r) = ($test->{ expect }, $result);
  +#            for ($e, $r) {
  +#                s/^/#/gm;
   #            }
  +#            print STDERR "# -- expect --\n$e\n";
  +#            print STDERR "# -- result --\n$r\n";
  +            if ($DIFF) {
  +                print STDERR "  diffs:\n";
  +                diff_result($test->{ expect }, $result);
  +            }
           }
       }
   }
  @@ -257,11 +255,12 @@
       my $diffs = diff( map { [ split(/\n/) ] } $expect, $result );
       my $n = 0;
       foreach my $hunk (@$diffs) {
  -        print STDERR '# -- hunk ', ++$n, ' of ', scalar @$diffs, " --\n";
  +        print STDERR '     -- hunk ', ++$n, ' of ', scalar @$diffs, " --\n";
           foreach my $diff (@$hunk) {
               my $line = sprintf('%3d', $diff->[1]);
  -            print STDERR "# $diff->[0] $line $diff->[2]\n";
  +            print STDERR "     $diff->[0] $line $diff->[2]\n";
           }
  +        print "\n";
       }
   
   #    $expect =~ s/\n/\\n/g;
  @@ -311,11 +310,12 @@
   #------------------------------------------------------------------------
   
   sub ok {
  -    my ($ok, $msg) = @_;
  +    my ($ok, $msg, $detail) = @_;
  +    $msg ||= test_name();
   
       # cache results if ntests() not yet called
       unless ($COUNT) {
  -        push(@RESULTS, [ $ok, $msg ]);
  +        push(@RESULTS, [ $ok, $msg, $detail ]);
           return $ok;
       }
   
  @@ -325,8 +325,8 @@
           print "ok ", $COUNT++, "$msg\n";
       }
       else {
  -        print STDERR "FAILED $COUNT: $msg\n" if defined $msg;
           print "not ok ", $COUNT++, "$msg\n";
  +        print STDERR $detail if $detail;
       }
   }
   
  @@ -339,6 +339,7 @@
   sub is {
       my ($result, $expect, $msg) = @_;
       my $count = $COUNT ? $COUNT : scalar @RESULTS + 1;
  +    $msg ||= test_name();
   
       # force stringification of $result to avoid 'no eq method' overload errors
       $result = "$result" if ref $result;	   
  @@ -347,8 +348,10 @@
           return ok(1, $msg);
       }
       else {
  -        print STDERR "FAILED $count:\n  expect: [$expect]\n  result: [$result]\n";
  -        return ok(0, $msg);
  +        for ($expect, $result) {
  +            s/\n/\\n]\n          [/g;
  +        }
  +        return ok(0, $msg, "  expect: [$expect]\n  result: [$result]\n");
       }
   }
   
  @@ -359,7 +362,14 @@
   
   sub like {
       my ($result, $expect, $msg) = @_;
  -    return ok( $result =~ $expect, $msg );
  +    $msg ||= test_name();
  +
  +    if ($result =~ $expect) {
  +        ok(1, $msg);
  +    }
  +    else {
  +        ok(0, $msg, "  expect: /$expect/\n  result: [$result]\n");
  +    }
   }
   
   
  @@ -375,6 +385,22 @@
   }
   
   
  +#------------------------------------------------------------------------
  +# test_name()
  +#
  +# Generate a default name for the test to use as a message when one isn't
  +# explicitly provided.  This is called by the ok(), is() and like() 
  +# methods and examines the caller of these methods (caller(1)) to get the
  +# file name and line where one of the above methods was called from.
  +#------------------------------------------------------------------------
  +
  +sub test_name {
  +    my ($pkg, $file, $line) = caller(1);
  +    my $n = $COUNT ? $COUNT : scalar @RESULTS + 1;
  +    return "test $n at $file line $line";
  +}
  +
  +
   1;
   __END__
   
  @@ -514,7 +540,7 @@
   
   =head1 VERSION
   
  -$Revision: 1.6 $
  +$Revision: 1.7 $
   
   =head1 COPYRIGHT