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

[cvs@template-toolkit.org]

cvs         03/12/16 13:35:01

  Added:       lib/Template/TT3 Test.pm
  Log:
  * added Template::TT3::Test module for writing test scripts
  
  Revision  Changes    Path
  1.1                  TT3/lib/Template/TT3/Test.pm
  
  Index: Test.pm
  ===================================================================
  #========================================================================
  #
  # Template::TT3::Test
  #
  # DESCRIPTION
  #   Module implementing a number of useful functions for writing TT test
  #   scripts.
  # 
  # AUTHOR
  #   Andy Wardley <abw@wardley.org>
  #
  # COPYRIGHT
  #   Copyright (C) 1996-2003 Andy Wardley.  All Rights Reserved.
  #   Copyright (C) 1998-2002 Canon Research Centre Europe Ltd.
  #
  #   This module is free software; you can redistribute it and/or
  #   modify it under the same terms as Perl itself.
  #
  # REVISION
  #   $Id: Test.pm,v 1.1 2003/12/16 13:35:01 abw Exp $
  #
  #========================================================================
  
  package Template::TT3::Test;
  
  use strict;
  use warnings;
  use Exporter;
  use Template::TT3::Base;
  use base qw( Template::TT3::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*';
  
  # can we generate a nice diff output?
  eval "use Algorithm::Diff qw( diff )";
  $DIFF = $@ ? 0 : 1;
  
  @EXPORT_OK   = qw( data_text data_tests diff_result $DIFF );
  %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
  
  
  sub data_text {
      return $DATA if defined $DATA;
      local $/ = undef;
      $DATA = <main::DATA>;
      $DATA =~ s/^__END__.*//sm;
      return $DATA;
  }
  
  
  sub data_tests {
      my $source = shift || data_text();
      my (@tests, $test, $input, $expect);
      my $count = 0;
  
      # remove any comment lines
      $source =~ s/^#.*?\n//gm;
  
      # remove anything before '-- start --' and/or after '-- stop --'
      $source =~ s/ .*? ^ $MAGIC start $MAGIC \n //smix;
      $source =~ s/ ^ $MAGIC stop  $MAGIC \n .* //smix;
  
      @tests = split(/ ^ $MAGIC test /mix, $source);
  
      # if the first line of the file was '-- test --' (optional) then the 
      # first test will be empty and can be discarded
      shift(@tests) if $tests[0] =~ /^\s*$/;
  
      foreach $test (@tests) {
          $test =~ s/ ^ \s* (.*?) $MAGIC \n //x;
          my $name = $1 || 'test ' . ++$count;
  
          # split input by a line like "-- expect --"
          ($input, $expect) = 
              split(/ ^ $MAGIC expect $MAGIC \n/mix, $test);
          $expect = '' 
              unless defined $expect;
          
          my @inflags;
          while ($input =~ s/ ^ $MAGIC (.*?) $MAGIC \n //mx) {
              push(@inflags, $1);
          }
  
          my @exflags;
          while ($expect =~ s/ ^ $MAGIC (.*?) $MAGIC \n //mx) {
              push(@exflags, $1);
          }
              
          for ($input, $expect) {
              s/^\s+//;
              s/\s+$//;
          }
  
          $test = {
              name    => $name,
              input   => $input,
              expect  => $expect,
              inflags => \@inflags,
              exflags => \@exflags,
          };
      }
  
      return wantarray ? @tests : \@tests;
  }
  
  sub diff_result {
      my ($expect, $result) = @_;
  
      return warn "Algorithm:Diff not installed, cannot run diff_result()\n"
          unless $DIFF;
  
      my $diffs = diff( map { [ split(/\n/) ] } $expect, $result );
      my $n = 0;
      foreach my $hunk (@$diffs) {
          print STDERR '# hunk ', ++$n, ' of ', scalar @$diffs, "\n";
          foreach my $diff (@$hunk) {
              printf STDERR "# $diff->[0] %3d $diff->[2]\n", $diff->[1];
          }
      }
  }
  
  
  
  
  1;
  __END__
  
  =head1 NAME
  
  Template::TT3::Test - useful functions for writing test scripts
  
  =head1 SYNOPSIS
  
      use Template::TT3::Test;
  
      # TODO
  
  =head1 DESCRIPTION
  
  # TODO
  
  =head1 METHODS
  
  =head2 new()
  
  # TODO
  
  =head1 AUTHOR
  
  Andy Wardley  E<lt>abw@wardley.orgE<gt>
  
  =head1 VERSION
  
  $Revision: 1.1 $
  
  =head1 COPYRIGHT
  
    Copyright (C) 1996-2003 Andy Wardley.  All Rights Reserved.
    Copyright (C) 1998-2002 Canon Research Centre Europe Ltd.
  
  This module is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
  
  =cut
  
  # Local Variables:
  # mode: perl
  # perl-indent-level: 4
  # indent-tabs-mode: nil
  # End:
  #
  # vim: expandtab shiftwidth=4: