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

[cvs@template-toolkit.org]

cvs         03/12/16 18:47:38

  Modified:    lib/Template/TT3 Test.pm
  Log:
  * added test_expect() method
  
  Revision  Changes    Path
  1.2       +43 -4     TT3/lib/Template/TT3/Test.pm
  
  Index: Test.pm
  ===================================================================
  RCS file: /template-toolkit/TT3/lib/Template/TT3/Test.pm,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- Test.pm	2003/12/16 13:35:01	1.1
  +++ Test.pm	2003/12/16 18:47:37	1.2
  @@ -17,7 +17,7 @@
   #   modify it under the same terms as Perl itself.
   #
   # REVISION
  -#   $Id: Test.pm,v 1.1 2003/12/16 13:35:01 abw Exp $
  +#   $Id: Test.pm,v 1.2 2003/12/16 18:47:37 abw Exp $
   #
   #========================================================================
   
  @@ -31,7 +31,7 @@
   use vars qw( $VERSION $DEBUG $ERROR $WARNING 
                $MAGIC $DATA $DIFF @EXPORT_OK %EXPORT_TAGS );
   
  -$VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
  +$VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
   $DEBUG   = 0 unless defined $DEBUG;
   $ERROR   = '';
   $MAGIC   = '\s* -- \s*';
  @@ -40,7 +40,7 @@
   eval "use Algorithm::Diff qw( diff )";
   $DIFF = $@ ? 0 : 1;
   
  -@EXPORT_OK   = qw( data_text data_tests diff_result $DIFF );
  +@EXPORT_OK   = qw( data_text data_tests test_expect diff_result $DIFF );
   %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
   
   
  @@ -108,6 +108,45 @@
       return wantarray ? @tests : \@tests;
   }
   
  +
  +
  +sub test_expect {
  +    my $config  = @_ && ref $_[0] eq 'HASH' ? shift : { @_ };
  +    my $tests   = $config->{ tests } || data_tests();
  +    my $handler = $config->{ handler } 
  +        || die "no handler provider for test_expect()\n";
  +    my $ok = $config->{ 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 }" );
  +            next;
  +        }
  +
  +        my $result = &$handler($test);
  +        
  +        if ($result eq $test->{ expect }) {
  +            &$ok(1, $test->{ name });
  +        }
  +        else {
  +            &$ok(0, $test->{ name });
  +            if ($DEBUG) {
  +                my ($e, $r) = ($test->{ expect }, $result);
  +                for ($e, $r) {
  +                    s/^/#/gm;
  +                }
  +                print STDERR "# expect [$e]\n";
  +                print STDERR "# result [$r]\n";
  +                if ($DIFF) {
  +                    print STDERR "# diff\n";
  +                    diff_result($test->{ expect }, $result);
  +                }
  +            }
  +        }
  +    }
  +}
  +
   sub diff_result {
       my ($expect, $result) = @_;
   
  @@ -156,7 +195,7 @@
   
   =head1 VERSION
   
  -$Revision: 1.1 $
  +$Revision: 1.2 $
   
   =head1 COPYRIGHT