dslinux/user/perl/lib/Test/Harness Assert.pm Changes Iterator.pm Point.pm Straps.pm TAP.pod
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:01:03 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/lib/Test/Harness
In directory antilope:/tmp/cvs-serv17422/lib/Test/Harness
Added Files:
Assert.pm Changes Iterator.pm Point.pm Straps.pm TAP.pod
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: Straps.pm ---
# -*- Mode: cperl; cperl-indent-level: 4 -*-
package Test::Harness::Straps;
use strict;
use vars qw($VERSION);
$VERSION = '0.26';
use Config;
use Test::Harness::Assert;
use Test::Harness::Iterator;
use Test::Harness::Point;
# Flags used as return values from our methods. Just for internal
# clarification.
my $YES = (1==1);
my $NO = !$YES;
=head1 NAME
Test::Harness::Straps - detailed analysis of test results
=head1 SYNOPSIS
use Test::Harness::Straps;
my $strap = Test::Harness::Straps->new;
# Various ways to interpret a test
my %results = $strap->analyze($name, \@test_output);
my %results = $strap->analyze_fh($name, $test_filehandle);
my %results = $strap->analyze_file($test_file);
# UNIMPLEMENTED
my %total = $strap->total_results;
# Altering the behavior of the strap UNIMPLEMENTED
my $verbose_output = $strap->dump_verbose();
$strap->dump_verbose_fh($output_filehandle);
=head1 DESCRIPTION
B<THIS IS ALPHA SOFTWARE> in that the interface is subject to change
in incompatible ways. It is otherwise stable.
Test::Harness is limited to printing out its results. This makes
analysis of the test results difficult for anything but a human. To
make it easier for programs to work with test results, we provide
Test::Harness::Straps. Instead of printing the results, straps
provide them as raw data. You can also configure how the tests are to
be run.
The interface is currently incomplete. I<Please> contact the author
if you'd like a feature added or something change or just have
comments.
=head1 CONSTRUCTION
=head2 new()
my $strap = Test::Harness::Straps->new;
Initialize a new strap.
=cut
sub new {
my $class = shift;
my $self = bless {}, $class;
$self->_init;
return $self;
}
=head2 $strap->_init
$strap->_init;
Initialize the internal state of a strap to make it ready for parsing.
=cut
sub _init {
my($self) = shift;
$self->{_is_vms} = ( $^O eq 'VMS' );
$self->{_is_win32} = ( $^O =~ /^(MS)?Win32$/ );
$self->{_is_macos} = ( $^O eq 'MacOS' );
}
=head1 ANALYSIS
=head2 $strap->analyze( $name, \@output_lines )
my %results = $strap->analyze($name, \@test_output);
Analyzes the output of a single test, assigning it the given C<$name>
for use in the total report. Returns the C<%results> of the test.
See L<Results>.
C<@test_output> should be the raw output from the test, including
newlines.
=cut
sub analyze {
my($self, $name, $test_output) = @_;
my $it = Test::Harness::Iterator->new($test_output);
return $self->_analyze_iterator($name, $it);
}
sub _analyze_iterator {
my($self, $name, $it) = @_;
$self->_reset_file_state;
$self->{file} = $name;
my %totals = (
max => 0,
seen => 0,
ok => 0,
todo => 0,
skip => 0,
bonus => 0,
details => []
);
# Set them up here so callbacks can have them.
$self->{totals}{$name} = \%totals;
while( defined(my $line = $it->next) ) {
$self->_analyze_line($line, \%totals);
last if $self->{saw_bailout};
}
$totals{skip_all} = $self->{skip_all} if defined $self->{skip_all};
my $passed = ($totals{max} == 0 && defined $totals{skip_all}) ||
($totals{max} && $totals{seen} &&
$totals{max} == $totals{seen} &&
$totals{max} == $totals{ok});
$totals{passing} = $passed ? 1 : 0;
return %totals;
}
sub _analyze_line {
my $self = shift;
my $line = shift;
my $totals = shift;
$self->{line}++;
my $linetype;
my $point = Test::Harness::Point->from_test_line( $line );
if ( $point ) {
$linetype = 'test';
$totals->{seen}++;
$point->set_number( $self->{'next'} ) unless $point->number;
# sometimes the 'not ' and the 'ok' are on different lines,
# happens often on VMS if you do:
# print "not " unless $test;
# print "ok $num\n";
if ( $self->{lone_not_line} && ($self->{lone_not_line} == $self->{line} - 1) ) {
$point->set_ok( 0 );
}
if ( $self->{todo}{$point->number} ) {
$point->set_directive_type( 'todo' );
}
if ( $point->is_todo ) {
$totals->{todo}++;
$totals->{bonus}++ if $point->ok;
}
elsif ( $point->is_skip ) {
$totals->{skip}++;
}
$totals->{ok}++ if $point->pass;
if ( ($point->number > 100_000) && ($point->number > ($self->{max}||100_000)) ) {
if ( !$self->{too_many_tests}++ ) {
warn "Enormous test number seen [test ", $point->number, "]\n";
warn "Can't detailize, too big.\n";
}
}
else {
my $details = {
ok => $point->pass,
actual_ok => $point->ok,
name => _def_or_blank( $point->description ),
type => _def_or_blank( $point->directive_type ),
reason => _def_or_blank( $point->directive_reason ),
};
assert( defined( $details->{ok} ) && defined( $details->{actual_ok} ) );
$totals->{details}[$point->number - 1] = $details;
}
} # test point
elsif ( $line =~ /^not\s+$/ ) {
$linetype = 'other';
# Sometimes the "not " and "ok" will be on separate lines on VMS.
# We catch this and remember we saw it.
$self->{lone_not_line} = $self->{line};
}
elsif ( $self->_is_header($line) ) {
$linetype = 'header';
$self->{saw_header}++;
$totals->{max} += $self->{max};
}
elsif ( $self->_is_bail_out($line, \$self->{bailout_reason}) ) {
$linetype = 'bailout';
$self->{saw_bailout} = 1;
}
elsif (my $diagnostics = $self->_is_diagnostic_line( $line )) {
$linetype = 'other';
my $test = $totals->{details}[-1];
$test->{diagnostics} ||= '';
$test->{diagnostics} .= $diagnostics;
}
else {
$linetype = 'other';
}
$self->{callback}->($self, $line, $linetype, $totals) if $self->{callback};
$self->{'next'} = $point->number + 1 if $point;
} # _analyze_line
sub _is_diagnostic_line {
my ($self, $line) = @_;
return if index( $line, '# Looks like you failed' ) == 0;
$line =~ s/^#\s//;
return $line;
}
=head2 $strap->analyze_fh( $name, $test_filehandle )
my %results = $strap->analyze_fh($name, $test_filehandle);
Like C<analyze>, but it reads from the given filehandle.
=cut
sub analyze_fh {
my($self, $name, $fh) = @_;
my $it = Test::Harness::Iterator->new($fh);
return $self->_analyze_iterator($name, $it);
}
=head2 $strap->analyze_file( $test_file )
my %results = $strap->analyze_file($test_file);
Like C<analyze>, but it runs the given C<$test_file> and parses its
results. It will also use that name for the total report.
=cut
sub analyze_file {
my($self, $file) = @_;
unless( -e $file ) {
$self->{error} = "$file does not exist";
return;
}
unless( -r $file ) {
$self->{error} = "$file is not readable";
return;
}
local $ENV{PERL5LIB} = $self->_INC2PERL5LIB;
if ( $Test::Harness::Debug ) {
local $^W=0; # ignore undef warnings
print "# PERL5LIB=$ENV{PERL5LIB}\n";
}
# *sigh* this breaks under taint, but open -| is unportable.
my $line = $self->_command_line($file);
unless ( open(FILE, "$line|" )) {
print "can't run $file. $!\n";
return;
}
my %results = $self->analyze_fh($file, \*FILE);
my $exit = close FILE;
$results{'wait'} = $?;
if( $? && $self->{_is_vms} ) {
eval q{use vmsish "status"; $results{'exit'} = $?};
}
else {
$results{'exit'} = _wait2exit($?);
}
$results{passing} = 0 unless $? == 0;
$self->_restore_PERL5LIB();
return %results;
}
eval { require POSIX; &POSIX::WEXITSTATUS(0) };
if( $@ ) {
*_wait2exit = sub { $_[0] >> 8 };
}
else {
*_wait2exit = sub { POSIX::WEXITSTATUS($_[0]) }
}
=head2 $strap->_command_line( $file )
Returns the full command line that will be run to test I<$file>.
=cut
sub _command_line {
my $self = shift;
my $file = shift;
my $command = $self->_command();
my $switches = $self->_switches($file);
$file = qq["$file"] if ($file =~ /\s/) && ($file !~ /^".*"$/);
my $line = "$command $switches $file";
return $line;
}
=head2 $strap->_command()
Returns the command that runs the test. Combine this with C<_switches()>
to build a command line.
Typically this is C<$^X>, but you can set C<$ENV{HARNESS_PERL}>
to use a different Perl than what you're running the harness under.
This might be to run a threaded Perl, for example.
You can also overload this method if you've built your own strap subclass,
such as a PHP interpreter for a PHP-based strap.
=cut
sub _command {
my $self = shift;
return $ENV{HARNESS_PERL} if defined $ENV{HARNESS_PERL};
return qq("$^X") if $self->{_is_win32} && $^X =~ /[^\w\.\/\\]/;
return $^X;
}
=head2 $strap->_switches( $file )
Formats and returns the switches necessary to run the test.
=cut
sub _switches {
my($self, $file) = @_;
my @existing_switches = $self->_cleaned_switches( $Test::Harness::Switches, $ENV{HARNESS_PERL_SWITCHES} );
my @derived_switches;
local *TEST;
open(TEST, $file) or print "can't open $file. $!\n";
my $shebang = <TEST>;
close(TEST) or print "can't close $file. $!\n";
my $taint = ( $shebang =~ /^#!.*\bperl.*\s-\w*([Tt]+)/ );
push( @derived_switches, "-$1" ) if $taint;
# When taint mode is on, PERL5LIB is ignored. So we need to put
# all that on the command line as -Is.
# MacPerl's putenv is broken, so it will not see PERL5LIB, tainted or not.
if ( $taint || $self->{_is_macos} ) {
my @inc = $self->_filtered_INC;
push @derived_switches, map { "-I$_" } @inc;
}
# Quote the argument if there's any whitespace in it, or if
# we're VMS, since VMS requires all parms quoted. Also, don't quote
# it if it's already quoted.
for ( @derived_switches ) {
$_ = qq["$_"] if ((/\s/ || $self->{_is_vms}) && !/^".*"$/ );
}
return join( " ", @existing_switches, @derived_switches );
}
=head2 $strap->_cleaned_switches( @switches_from_user )
Returns only defined, non-blank, trimmed switches from the parms passed.
=cut
sub _cleaned_switches {
my $self = shift;
local $_;
my @switches;
for ( @_ ) {
my $switch = $_;
next unless defined $switch;
$switch =~ s/^\s+//;
$switch =~ s/\s+$//;
push( @switches, $switch ) if $switch ne "";
}
return @switches;
}
=head2 $strap->_INC2PERL5LIB
local $ENV{PERL5LIB} = $self->_INC2PERL5LIB;
Takes the current value of C<@INC> and turns it into something suitable
for putting onto C<PERL5LIB>.
=cut
sub _INC2PERL5LIB {
my($self) = shift;
$self->{_old5lib} = $ENV{PERL5LIB};
return join $Config{path_sep}, $self->_filtered_INC;
}
=head2 $strap->_filtered_INC()
my @filtered_inc = $self->_filtered_INC;
Shortens C<@INC> by removing redundant and unnecessary entries.
Necessary for OSes with limited command line lengths, like VMS.
=cut
sub _filtered_INC {
my($self, @inc) = @_;
@inc = @INC unless @inc;
if( $self->{_is_vms} ) {
# VMS has a 255-byte limit on the length of %ENV entries, so
# toss the ones that involve perl_root, the install location
@inc = grep !/perl_root/i, @inc;
}
elsif ( $self->{_is_win32} ) {
# Lose any trailing backslashes in the Win32 paths
s/[\\\/+]$// foreach @inc;
}
my %seen;
$seen{$_}++ foreach $self->_default_inc();
@inc = grep !$seen{$_}++, @inc;
return @inc;
}
sub _default_inc {
my $self = shift;
local $ENV{PERL5LIB};
my $perl = $self->_command;
my @inc =`$perl -le "print join qq[\\n], \@INC"`;
chomp @inc;
return @inc;
}
=head2 $strap->_restore_PERL5LIB()
$self->_restore_PERL5LIB;
This restores the original value of the C<PERL5LIB> environment variable.
Necessary on VMS, otherwise a no-op.
=cut
sub _restore_PERL5LIB {
my($self) = shift;
return unless $self->{_is_vms};
if (defined $self->{_old5lib}) {
$ENV{PERL5LIB} = $self->{_old5lib};
}
}
=head1 Parsing
Methods for identifying what sort of line you're looking at.
=head2 C<_is_diagnostic>
my $is_diagnostic = $strap->_is_diagnostic($line, \$comment);
Checks if the given line is a comment. If so, it will place it into
C<$comment> (sans #).
=cut
sub _is_diagnostic {
my($self, $line, $comment) = @_;
if( $line =~ /^\s*\#(.*)/ ) {
$$comment = $1;
return $YES;
}
else {
return $NO;
}
}
=head2 C<_is_header>
my $is_header = $strap->_is_header($line);
Checks if the given line is a header (1..M) line. If so, it places how
many tests there will be in C<< $strap->{max} >>, a list of which tests
are todo in C<< $strap->{todo} >> and if the whole test was skipped
C<< $strap->{skip_all} >> contains the reason.
=cut
# Regex for parsing a header. Will be run with /x
my $Extra_Header_Re = <<'REGEX';
^
(?: \s+ todo \s+ ([\d \t]+) )? # optional todo set
(?: \s* \# \s* ([\w:]+\s?) (.*) )? # optional skip with optional reason
REGEX
sub _is_header {
my($self, $line) = @_;
if( my($max, $extra) = $line =~ /^1\.\.(\d+)(.*)/ ) {
$self->{max} = $max;
assert( $self->{max} >= 0, 'Max # of tests looks right' );
if( defined $extra ) {
my($todo, $skip, $reason) = $extra =~ /$Extra_Header_Re/xo;
$self->{todo} = { map { $_ => 1 } split /\s+/, $todo } if $todo;
if( $self->{max} == 0 ) {
$reason = '' unless defined $skip and $skip =~ /^Skip/i;
}
$self->{skip_all} = $reason;
}
return $YES;
}
else {
return $NO;
}
}
=head2 C<_is_bail_out>
my $is_bail_out = $strap->_is_bail_out($line, \$reason);
Checks if the line is a "Bail out!". Places the reason for bailing
(if any) in $reason.
=cut
sub _is_bail_out {
my($self, $line, $reason) = @_;
if( $line =~ /^Bail out!\s*(.*)/i ) {
$$reason = $1 if $1;
return $YES;
}
else {
return $NO;
}
}
=head2 C<_reset_file_state>
$strap->_reset_file_state;
Resets things like C<< $strap->{max} >> , C<< $strap->{skip_all} >>,
etc. so it's ready to parse the next file.
=cut
sub _reset_file_state {
my($self) = shift;
delete @{$self}{qw(max skip_all todo too_many_tests)};
$self->{line} = 0;
$self->{saw_header} = 0;
$self->{saw_bailout}= 0;
$self->{lone_not_line} = 0;
$self->{bailout_reason} = '';
$self->{'next'} = 1;
}
=head1 Results
The C<%results> returned from C<analyze()> contain the following
information:
passing true if the whole test is considered a pass
(or skipped), false if its a failure
exit the exit code of the test run, if from a file
wait the wait code of the test run, if from a file
max total tests which should have been run
seen total tests actually seen
skip_all if the whole test was skipped, this will
contain the reason.
ok number of tests which passed
(including todo and skips)
todo number of todo tests seen
bonus number of todo tests which
unexpectedly passed
skip number of tests skipped
So a successful test should have max == seen == ok.
There is one final item, the details.
details an array ref reporting the result of
each test looks like this:
$results{details}[$test_num - 1] =
{ ok => is the test considered ok?
actual_ok => did it literally say 'ok'?
name => name of the test (if any)
diagnostics => test diagnostics (if any)
type => 'skip' or 'todo' (if any)
reason => reason for the above (if any)
};
Element 0 of the details is test #1. I tried it with element 1 being
#1 and 0 being empty, this is less awkward.
=head1 EXAMPLES
See F<examples/mini_harness.plx> for an example of use.
=head1 AUTHOR
Michael G Schwern C<< <schwern at pobox.com> >>, currently maintained by
Andy Lester C<< <andy at petdance.com> >>.
=head1 SEE ALSO
L<Test::Harness>
=cut
sub _def_or_blank {
return $_[0] if defined $_[0];
return "";
}
1;
--- NEW FILE: TAP.pod ---
=head1 NAME
Test::Harness::TAP - Documentation for the TAP format
=head1 SYNOPSIS
TAP, the Test Anything Protocol, is Perl's simple text-based interface
between testing modules such as Test::More and the test harness
Test::Harness.
=head1 TODO
Exit code of the process.
=head1 THE TAP FORMAT
TAP's general format is:
1..N
ok 1 Description # Directive
# Diagnostic
....
ok 47 Description
ok 48 Description
more tests....
For example, a test file's output might look like:
1..4
ok 1 - Input file opened
not ok 2 - First line of the input valid
ok 3 - Read the rest of the file
not ok 4 - Summarized correctly # TODO Not written yet
=head1 HARNESS BEHAVIOR
In this document, the "harness" is any program analyzing TAP output.
Typically this will be Perl's I<prove> program, or the underlying
C<Test::Harness::runtests> subroutine.
A harness must only read TAP output from standard output and not
from standard error. Lines written to standard output matching
C</^(not )?ok\b/> must be interpreted as test lines. All other
lines must not be considered test output.
=head1 TESTS LINES AND THE PLAN
=head2 The plan
The plan tells how many tests will be run, or how many tests have
run. It's a check that the test file hasn't stopped prematurely.
It must appear once, whether at the beginning or end of the output.
The plan is usually the first line of TAP output and it specifies how
many test points are to follow. For example,
1..10
means you plan on running 10 tests. This is a safeguard in case your test
file dies silently in the middle of its run. The plan is optional but if
there is a plan before the test points it must be the first non-diagnostic
line output by the test file.
In certain instances a test file may not know how many test points
it will ultimately be running. In this case the plan can be the last
non-diagnostic line in the output.
The plan cannot appear in the middle of the output, nor can it appear more
than once.
=head2 The test line
The core of TAP is the test line. A test file prints one test line test
point executed. There must be at least one test line in TAP output. Each
test line comprises the following elements:
=over 4
=item * C<ok> or C<not ok>
This tells whether the test point passed or failed. It must be
at the beginning of the line. C</^not ok/> indicates a failed test
point. C</^ok/> is a successful test point. This is the only mandatory
part of the line.
Note that unlike the Directives below, C<ok> and C<not ok> are
case-sensitive.
=item * Test number
TAP expects the C<ok> or C<not ok> to be followed by a test point
number. If there is no number the harness must maintain
its own counter until the script supplies test numbers again. So
the following test output
1..6
not ok
ok
not ok
ok
ok
has five tests. The sixth is missing. Test::Harness will generate
FAILED tests 1, 3, 6
Failed 3/6 tests, 50.00% okay
=item * Description
Any text after the test number but before a C<#> is the description of
the test point.
ok 42 this is the description of the test
Descriptions should not begin with a digit so that they are not confused
with the test point number.
The harness may do whatever it wants with the description.
=item * Directive
The test point may include a directive, following a hash on the
test line. There are currently two directives allowed: C<TODO> and
C<SKIP>. These are discussed below.
=back
To summarize:
=over 4
=item * ok/not ok (required)
=item * Test number (recommended)
=item * Description (recommended)
=item * Directive (only when necessary)
=back
=head1 DIRECTIVES
Directives are special notes that follow a C<#> on the test line.
Only two are currently defined: C<TODO> and C<SKIP>. Note that
these two keywords are not case-sensitive.
=head2 TODO tests
If the directive starts with C<# TODO>, the test is counted as a
todo test, and the text after C<TODO> is the explanation.
not ok 13 # TODO bend space and time
Note that if the TODO has an explanation it must be separated from
C<TODO> by a space.
These tests represent a feature to be implemented or a bug to be fixed
and act as something of an executable "things to do" list. They are
B<not> expected to succeed. Should a todo test point begin succeeding,
the harness should report it as a bonus. This indicates that whatever
you were supposed to do has been done and you should promote this to a
normal test point.
=head2 Skipping tests
If the directive starts with C<# SKIP>, the test is counted as having
been skipped. If the whole test file succeeds, the count of skipped
tests is included in the generated output. The harness should report
the text after C< # SKIP\S*\s+> as a reason for skipping.
ok 23 # skip Insufficient flogiston pressure.
Similarly, one can include an explanation in a plan line,
emitted if the test file is skipped completely:
1..0 # Skipped: WWW::Mechanize not installed
=head1 OTHER LINES
=head2 Bail out!
As an emergency measure a test script can decide that further tests
are useless (e.g. missing dependencies) and testing should stop
immediately. In that case the test script prints the magic words
Bail out!
to standard output. Any message after these words must be displayed
by the interpreter as the reason why testing must be stopped, as
in
Bail out! MySQL is not running.
=head2 Diagnostics
Additional information may be put into the testing output on separate
lines. Diagnostic lines should begin with a C<#>, which the harness must
ignore, at least as far as analyzing the test results. The harness is
free, however, to display the diagnostics. Typically diagnostics are
used to provide information about the environment in which test file is
running, or to delineate a group of tests.
...
ok 18 - Closed database connection
# End of database section.
# This starts the network part of the test.
# Daemon started on port 2112
ok 19 - Opened socket
...
ok 47 - Closed socket
# End of network tests
=head2 Anything else
Any output line that is not a plan, a test line or a diagnostic is
incorrect. How a harness handles the incorrect line is undefined.
Test::Harness silently ignores incorrect lines, but will become more
stringent in the future.
=head1 EXAMPLES
All names, places, and events depicted in any example are wholly
fictitious and bear no resemblance to, connection with, or relation to any
real entity. Any such similarity is purely coincidental, unintentional,
and unintended.
=head2 Common with explanation
The following TAP listing declares that six tests follow as well as
provides handy feedback as to what the test is about to do. All six
tests pass.
1..6
#
# Create a new Board and Tile, then place
# the Tile onto the board.
#
ok 1 - The object isa Board
ok 2 - Board size is zero
ok 3 - The object isa Tile
ok 4 - Get possible places to put the Tile
ok 5 - Placing the tile produces no error
ok 6 - Board size is 1
=head2 Unknown amount and failures
This hypothetical test program ensures that a handful of servers are
online and network-accessible. Because it retrieves the hypothetical
servers from a database, it doesn't know exactly how many servers it
will need to ping. Thus, the test count is declared at the bottom after
all the test points have run. Also, two of the tests fail.
ok 1 - retrieving servers from the database
# need to ping 6 servers
ok 2 - pinged diamond
ok 3 - pinged ruby
not ok 4 - pinged saphire
ok 5 - pinged onyx
not ok 6 - pinged quartz
ok 7 - pinged gold
1..7
=head2 Giving up
This listing reports that a pile of tests are going to be run. However,
the first test fails, reportedly because a connection to the database
could not be established. The program decided that continuing was
pointless and exited.
1..573
not ok 1 - database handle
Bail out! Couldn't connect to database.
=head2 Skipping a few
The following listing plans on running 5 tests. However, our program
decided to not run tests 2 thru 5 at all. To properly report this,
the tests are marked as being skipped.
1..5
ok 1 - approved operating system
# $^0 is solaris
ok 2 - # SKIP no /sys directory
ok 3 - # SKIP no /sys directory
ok 4 - # SKIP no /sys directory
ok 5 - # SKIP no /sys directory
=head2 Skipping everything
This listing shows that the entire listing is a skip. No tests were run.
1..0 # skip because English-to-French translator isn't installed
=head2 Got spare tuits?
The following example reports that four tests are run and the last two
tests failed. However, because the failing tests are marked as things
to do later, they are considered successes. Thus, a harness should report
this entire listing as a success.
1..4
ok 1 - Creating test program
ok 2 - Test program runs, no error
not ok 3 - infinite loop # TODO halting problem unsolved
not ok 4 - infinite loop 2 # TODO halting problem unsolved
=head2 Creative liberties
This listing shows an alternate output where the test numbers aren't
provided. The test also reports the state of a ficticious board game in
diagnostic form. Finally, the test count is reported at the end.
ok - created Board
ok
ok
ok
ok
ok
ok
ok
# +------+------+------+------+
# | |16G | |05C |
# | |G N C | |C C G |
# | | G | | C +|
# +------+------+------+------+
# |10C |01G | |03C |
# |R N G |G A G | |C C C |
# | R | G | | C +|
# +------+------+------+------+
# | |01G |17C |00C |
# | |G A G |G N R |R N R |
# | | G | R | G |
# +------+------+------+------+
ok - board has 7 tiles + starter tile
1..9
=head1 AUTHORS
Andy Lester, based on the original Test::Harness documentation by Michael Schwern.
=head1 ACKNOWLEDGEMENTS
Thanks to
Pete Krawczyk,
Paul Johnson,
Ian Langworth
and Nik Clayton
for help and contributions on this document.
The basis for the TAP format was created by Larry Wall in the
original test script for Perl 1. Tim Bunce and Andreas Koenig
developed it further with their modifications to Test::Harness.
=head1 COPYRIGHT
Copyright 2003-2005 by
Michael G Schwern C<< <schwern at pobox.com> >>,
Andy Lester C<< <andy at petdance.com> >>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
See L<http://www.perl.com/perl/misc/Artistic.html>.
=cut
--- NEW FILE: Iterator.pm ---
package Test::Harness::Iterator;
use strict;
use vars qw($VERSION);
$VERSION = 0.02;
=head1 NAME
Test::Harness::Iterator - Internal Test::Harness Iterator
=head1 SYNOPSIS
use Test::Harness::Iterator;
my $it = Test::Harness::Iterator->new(\*TEST);
my $it = Test::Harness::Iterator->new(\@array);
my $line = $it->next;
=head1 DESCRIPTION
B<FOR INTERNAL USE ONLY!>
This is a simple iterator wrapper for arrays and filehandles.
=head2 new()
Create an iterator.
=head2 next()
Iterate through it, of course.
=cut
sub new {
my($proto, $thing) = @_;
my $self = {};
if( ref $thing eq 'GLOB' ) {
bless $self, 'Test::Harness::Iterator::FH';
$self->{fh} = $thing;
}
elsif( ref $thing eq 'ARRAY' ) {
bless $self, 'Test::Harness::Iterator::ARRAY';
$self->{idx} = 0;
$self->{array} = $thing;
}
else {
warn "Can't iterate with a ", ref $thing;
}
return $self;
}
package Test::Harness::Iterator::FH;
sub next {
my $fh = $_[0]->{fh};
# readline() doesn't work so good on 5.5.4.
return scalar <$fh>;
}
package Test::Harness::Iterator::ARRAY;
sub next {
my $self = shift;
return $self->{array}->[$self->{idx}++];
}
"Steve Peters, Master Of True Value Finding, was here.";
--- NEW FILE: Assert.pm ---
# $Id: Assert.pm,v 1.1 2006-12-04 17:01:01 dslinux_cayenne Exp $
package Test::Harness::Assert;
use strict;
require Exporter;
use vars qw($VERSION @EXPORT @ISA);
$VERSION = '0.02';
@ISA = qw(Exporter);
@EXPORT = qw(assert);
=head1 NAME
Test::Harness::Assert - simple assert
=head1 SYNOPSIS
### FOR INTERNAL USE ONLY ###
use Test::Harness::Assert;
assert( EXPR, $name );
=head1 DESCRIPTION
A simple assert routine since we don't have Carp::Assert handy.
B<For internal use by Test::Harness ONLY!>
=head1 FUNCTIONS
=head2 C<assert()>
assert( EXPR, $name );
If the expression is false the program aborts.
=cut
sub assert ($;$) {
my($assert, $name) = @_;
unless( $assert ) {
require Carp;
my $msg = 'Assert failed';
$msg .= " - '$name'" if defined $name;
$msg .= '!';
Carp::croak($msg);
}
}
=head1 AUTHOR
Michael G Schwern C<< <schwern at pobox.com> >>
=head1 SEE ALSO
L<Carp::Assert>
=cut
1;
--- NEW FILE: Changes ---
Revision history for Perl extension Test::Harness
2.56 Wed Sep 28 16:04:00 CDT 2005
[FIXES]
* Incorporate bleadperl patch to fix Test::Harness on VMS.
2.54 Wed Sep 28 09:52:19 CDT 2005
[FIXES]
* Test counts were wrong, so wouldn't install on Perls < 5.8.0.
2.53_02 Thu Aug 25 21:37:01 CDT 2005
[FIXES]
* File order in prove is now sorted within the directory. It's not
the sorting that's important as much as the deterministic results.
Thanks to Adam Kennedy and Casey West for pointing this out,
independently of each other, with 12 hours of the other.
[INTERNALS]
* Fix calls to podusage() to not use the DATA typeglob. Thanks sungo.
2.53_01 Sun Jul 10 10:45:27 CDT 2005
[FIXES]
* If we go over 100,000 tests, it used to print out a warning for
every test over 100,000. Now, we stop after the first. Thanks to
Sebastien Aperghis-Tramoni.
2.52 Sun Jun 26 23:05:19 CDT 2005
No changes
2.51_02
[ENHANCEMENTS]
* The Test::Harness timer is now off by default. Set HARNESS_TIMER
true if you want it. Added --timer flag to prove.
2.50_01
[FIXES]
* Call CORE::time() to figure out if we should print when we're
printing once per second. Otherwise, we're using Time::HiRes'
version of it. Thanks, Nicholas Clark.
2.50 Tue Jun 21 14:32:12 CDT 2005
[FIXES]
* Added some includes in t/strap-analyze.t to make Cygwin happy.
2.49_02 Tue Jun 21 09:54:44 CDT 2005
[FIXES]
* Added some includes in t/test_harness.t to make Cygwin happy.
2.49_01 Fri Jun 10 15:37:31 CDT 2005
[ENHANCEMENTS]
* Now shows elapsed time in 1000ths of a second if Time::HiRes
is available.
[FIXES]
* Test::Harness::Iterator didn't have a 1; at the end. Thanks to
Steve Peters for finding it.
2.48 Fri Apr 22 22:41:46 CDT 2005
Released after weeks of non-complaint.
2.47_03 Wed Mar 2 16:52:55 CST 2005
[THINGS THAT MIGHT BREAK YOUR CODE]
* Test::Harness now requires Perl 5.005_03 or above.
[FIXES]
* Fixed incorrect "confused by tests in wrong order" error in 2.47_02.
2.47_02 Tue Mar 1 23:15:47 CST 2005
[THINGS THAT MIGHT BREAK YOUR CODE]
* Test directives for skip tests used to be anything that matches
/^skip/i, like the word "skipped", but now it must match
/^skip\s+/i.
[ENHANCEMENTS]
* T::H now sets environment variable HARNESS_VERSION, in case a test
program wants to know what version of T::H it's running under.
2.47_01 Mon Feb 21 01:14:13 CST 2005
[FIXES]
* Fixed a problem submitted by Craig Berry:
Several of the Test::Harness tests now fail on VMS with the
following warning:
Can't find string terminator "]" anywhere before EOF at -e line 1.
The problem is that when a command is piped to the shell and that
command has a newline character embedded in it, the part after
the newline is invisible to the shell. The patch below corrects
that by escaping the newline so it is not subject to variable
interpolation until it gets to the child's Perl one-liner.
[ENHANCEMENTS]
* Test::Harness::Straps now has diagnostic gathering without changing
how tests are run. It also adds these messages by default.
Note that the new method, _is_diagnostic(), is for internal
use only. It may change soon. Thanks to chromatic.
[DOCUMENTATION]
* Expanded Test::Harness::TAP.pod, and added examples.
* Fixed a crucial documentation typo in Test::Harness::Straps.
2.46 Thu Jan 20 11:50:59 CST 2005
Released.
2.45_02 Fri Dec 31 14:57:33 CST 2004
[ENHANCEMENTS]
* Turns off buffering on both STDERR and STDOUT, so that the two
output handles don't get out of sync with each other. Thanks to
David Wheeler.
* No longer requires, or supports, the HARNESS_OK_SLOW environment
variable. Test counts are only updated once per second, which
used to require having HARNESS_OK_SLOW set.
2.45_01 Fri Dec 17 22:39:17 CST 2004
[THINGS THAT MIGHT BREAK YOUR CODE]
* Test::Harness now requires Perl 5.004_05.
* We no longer try to print a stack if a coredump is detected.
[FIXES]
* Reverted Test::Harness::Iterator::next()'s use of readline, since
it fails under Perl 5.5.4.
* We no longer try to print a stack if a coredump is detected.
This means that the external problems we've had with wait.ph
now disappear. This resolves a number of problems that various
Linux distros have, and closes a couple of RT tickets like #2729
and #7716.
[ENHANCEMENTS]
* Added Test::Harness->strap() method to access the internal strap.
[DOCUMENTATION]
* Obfuscated the rt.cpan.org email address. The damage is already
done, but at least we'll have it hidden going forward.
2.44 Tue Nov 30 18:38:17 CST 2004
[INTERNALS]
* De-anonymized the callbacks and handlers in Test::Harness, mostly
so I can profile better.
* Checks _is_header() only if _is_line() fails first. No point
in checking every line of the input for something that can only
occur once.
* Inline the _detailize() function, which was getting called once
per line of input. Reduced execution time about 5-7%.
* Removed unnecessary temporary variables in Test::Harness::Straps
and in Test::Harness::Iterator.
2.43_02 Thu Nov 25 00:20:36 CST 2004
[ENHANCEMENTS]
* Added more debug output if $Test::Harness::Debug is on.
[FIXES]
* Test::Harness now removes default paths from the paths that it
sets in PERL5LIB. This fixes RT #5649. Thanks, Schwern.
[THINGS THAT MIGHT BREAK YOUR CODE]
* Test::Harness::Straps' constructor no longer will work as an
object method. You can't say $strap->new any more, but that's
OK because you never really wanted to anyway.
2.43_01
[FIXES]
* Added workaround for local $ENV{} bug on Cygwin to
t/prove-switches.t. See the following RT tickets for details.
https://rt.cpan.org/Ticket/Display.html?id=6452
http://rt.perl.org/rt3/Ticket/Display.html?id=30952
2.42 Wed Apr 28 22:13:11 CDT 2004
[ENHANCEMENTS]
* prove -v now sets TEST_VERBOSE in case your tests rely on them.
* prove globs the command line, since Win32's shell doesn't.
[FIXES]
* Cross-platform test fixes on t/prove-globbing.t
2.40 Tue Dec 30 20:38:59 CST 2003
[FIXES]
* Test::Harness::Straps should now properly quote on VMS.
[ENHANCEMENTS]
* prove now takes a -l option to add lib/ to @INC. Now when you're
building a module, you don't have to do a make before you run
the prove. Thanks to David Wheeler for the idea.
[INTERNALS]
* Internal functions corestatus() and canonfailed() prepended with
underscores, to indicate such.
* Gratuitous text-only changes in Test::Harness::Iterator.
* All tests now do their use_ok() in a BEGIN block. Some of the
use_ok() calls were too much of a hassle to put into a BEGIN block,
so I changed them to regular use calls.
2.38 Mon Nov 24 22:36:18 CST 2003
Released. See changes below.
2.37_03 Tue Nov 18 23:51:38 CST 2003
[ENHANCEMENTS]
* prove -V now shows the Perl version being used.
* Now there's a HARNESS_DEBUG flag that shows diagnostics as the
harness runs the tests. This is different from HARNESS_VERBOSE,
which shows test output, but not information about the harness
itself.
* Added _command_line() to the Strap API.
[FIXES]
* Bad interaction with Module::Build: The strap was only checking
$ENV{HARNESS_PERL_SWITCHES} for definedness, but not emptiness.
It now also strips any leading or trailing whitesapce from the
switches.
* Test::Harness and prove only quote those parms that actually need
to be quoted: Have some whitespace and aren't already quoted.
2.36 Fri Nov 14 09:24:44 CST 2003
[FIXES]
* t/prove-includes.t properly ignores PROVE_SWITCHES that you may
already have set.
2.35_02 Thu Nov 13 09:57:36 CST 2003
[ENHANCEMENTS]
* prove's --blib now works just like the blib pragma.
2.35_01 Wed Nov 12 23:08:45 CST 2003
[FIXES]
* Fixed taint-handling and path preservation under MacOS. Thanks to
Schwern for the patch and the tests.
* Preserves case of -t or -T in the shebang line of the test.
[ENHANCEMENTS]
* Added -t to prove analogous to Perl's -t. Removed the --taint
switch.
* prove can take default options from the PROVE_SWITCHES variable.
* Added HARNESS_PERL to allow you to specify the Perl interpreter
to run the tests as.
* prove's --perl switch sets the HARNESS_PERL on the fly for you.
* Quotes the switches and filename in the subprogram. This helps
with filenames with spaces that are subject to shell mangling.
2.34 Sat Nov 8 22:09:15 CST 2003
[FIXES]
* Allowed prove to run on Perl versions < 5.6.0.
[ENHANCEMENTS]
* Command-line switches to prove may now be stacked.
* Added check for proper Pod::Usage version.
* "make clean" does a better job of cleaning up after itself.
2.32 Fri Nov 7 09:41:21 CST 2003
Test::Harness now includes a powerful development tool to help
programmers work with automated tests. The prove utility runs
test files against the harness, like a "make test", but with many
advantages:
* prove is designed as a development tool
Perl users typically run the test harness through a makefile via
"make test". That's fine for module distributions, but it's
suboptimal for a test/code/debug development cycle.
* prove is granular
prove lets your run against only the files you want to check.
Running "prove t/live/ t/master.t" checks every *.t in t/live, plus
t/master.t.
* prove has an easy verbose mode
To get full test program output from "make test", you must set
"HARNESS_VERBOSE" in the environment. prove has a "-v" option.
* prove can run under taint mode
prove's "-T" runs your tests under "perl -T".
* prove can shuffle tests
You can use prove's "--shuffle" option to try to excite problems
that don't show up when tests are run in the same order every time.
* Not everything is a module
More and more users are using Perl's testing tools outside the
context of a module distribution, and may not even use a makefile at
all.
Prove requires Pod::Usage, which is standard after Perl 5.004.
I'm very excited about prove, and hope that developers will begin
adopting it to their coding cycles. I welcome your comments at
andy at petdance.com.
There are also some minor bug fixes in Test::Harness itself, listed
below in the 2.31_* notes.
2.31_05 Thu Nov 6 14:56:22 CST 2003
[FIXES]
- If a MacPerl script had a shebang with -T, the -T wouldn't get
passed as a switch.
- Removed the -T on three *.t files, which didn't need them, and
which were causing problems.
- Conditionally installs bin/prove, depending on whether Pod::Usage
is available, which prove needs.
- Removed old leftover code from Makefile.PL.
2.31_04 Mon Nov 3 23:36:06 CST 2003
Minor tweaks here and there, almost ready to release.
2.31_03 Mon Nov 3 08:50:36 CST 2003
[FEATURES]
- prove is almost feature-complete. Removed the handling of
--exclude for excluding certain tests. It may go back in the
future.
- prove -d is now debug. Dry is prove -D.
2.31_02 Fri Oct 31 23:46:03 CST 2003
[FEATURES]
- Added many more switches to prove: -d for dry run, and -b for
blib.
[FIXES]
- T:H:Straps now recognizes MSWin32 in $^0.
- RT#3811: Could do regex matching on garbage in _is_test().
Fixed by Yves Orton
- RT#3827: Strips backslashes from and normalizes @INC entries
for Win32. Fixed by Yves Orton.
[INTERNALS]
- Added $self->{_is_macos} to the T:H:Strap object.
- t/test-harness.t sorts its test results, rather than relying on
internal key order.
2.31_01
[FEATURES]
- Added "prove" script to run a test or set of tests through the
harness. Thanks to Curtis Poe for the foundation.
[DOCUMENTATION]
- Fixed POD problem in Test::Harness::Assert
2.30 Thu Aug 14 20:04:00 CDT 2003
No functional changes in this version. It's only to make some doc
tweaks, and bump up the version number in T:H:Straps.
[DOCUMENTATION]
- Changed Schwern to Andy as the maintainer.
- Incorporated the TODO file into Harness.pm proper.
- Cleaned up formatting in Test::Harness::Straps.
2.29 Wed Jul 17 14:08:00 CDT 2003
- Released as 2.29.
2.28_91 Sun Jul 13 00:10:00 CDT 2003
[ENHANCEMENTS]
- Added support for HARNESS_OK_SLOW. This will make a significant
speedup for slower connections.
- Folded in some changes from bleadperl that spiff up the
failure reports.
[INTERNALS]
- Added some isa_ok() checks to the tests.
- All Test::Harness* modules are used by use_ok()
- Fixed the prototype for the canonfailed() function, not that
it matters since it's never called without parens.
2.28_90 Sat Jul 05 20:21:00 CDT 2003
[ENHANCEMENTS]
- Now, when you run a test harnessed, the numbers don't fly by one
at a time, one update per second. This significantly speeds
up the run time for running thousands of tests. *COUGH*
Regexp::Common *COUGH*
2.28 Thu Apr 24 14:39:00 CDT 2003
- No functional changes.
2.27_05 Mon Apr 21 15:55:00 CDT 2003
- No functional changes.
- Fixed circular depency in the test suite. Thanks, Rob Brown.
2.27_04 Sat Apr 12 21:42:00 CDT 2003
- Added test for $Test::Harness::Switches patch below.
2.27_03 Thu Apr 03 10:47:00 CDT 2003
- Fixed straps not respecting $Test::Harness::Switches. Thanks
to Miyagawa for the patch.
- Added t/pod.t to test POD validity.
2.27_02 Mon Mar 24 13:17:00 CDT 2003
2.27_01 Sun Mar 23 19:46:00 CDT 2003
- Handed over to Andy Lester for further maintenance.
- Fixed when the path to perl contains spaces on Windows
* Stas Bekman noticed that tests with no output at all were
interpreted as passing
- MacPerl test tweak for busted exit codes (bleadperl 17345)
- Abigail and Nick Clark both hit the 100000 "huge test that will
suck up all your memory" limit with legit tests. Made the check
smarter to allow large, planned tests to work.
- Partial fix of stats display when a test fails only because there's
too many tests.
- Made wait.ph and WCOREDUMP anti-vommit protection more robust in
cases where wait.ph loads but WCOREDUMP() pukes when run.
- Added a LICENSE.
- Ilya noticed the per test skip reason was accumlating between tests.
2.26 Wed Jun 19 16:58:02 EDT 2002
- Workaround for MacPerl's lack of a working putenv. It will never
see the PERL5LIB environment variable (perl at 16942).
2.25 Sun Jun 16 03:00:33 EDT 2002
- $Strap is now a global to allow Test::Harness::Straps
experimentation.
- Little spelling nit in a diagnostic.
- Chris Richmond noted that the runtests() docs were wrong. It will
die, not return false, when any tests fail. This is silly, but
historically necessary for 'make test'. Docs corrected.
- MacPerl test fixes from Pudge. (mutation of bleadperl at 16989)
- Undef warning introduced in 2.24 on skipped tests with no reasons
fixed.
* Test::Harness now depends on File::Spec
2.24 Wed May 29 19:02:18 EDT 2002
* Nikola Knezevic found a bug when tests are completely skipped
but no reason is given it was considered a failure.
* Made Test::Harness::Straps->analyze_file & Test::Harness a bit
more graceful when the test doesn't exist.
2.23 Wed May 22 12:59:47 EDT 2002
- reason for all skip wasn't being displayed. Broken in 2.20.
- Changed the wait status tests to conform with POSIX standards.
- Quieted some SYSTEM$ABORT noise leaking out from dying test tests
on VMS.
2.22 Fri May 17 19:01:35 EDT 2002
- Fixed parsing of #!/usr/bin/perl-current to not see a -t.
(RT #574)
- Fixed exit codes on MPE/iX
2.21 Mon May 6 00:43:22 EDT 2002
- removed a bunch of dead code left over after 2.20's gutting.
- The fix for the $^X "bug" added in 2.02 has been removed. It
caused more trouble than the old bug (I'd never seen a problem
before anyway)
- 2.20 broke $verbose
2.20 Sat May 4 22:31:20 EDT 2002
* An almost complete conversion of the Test::Harness test parsing
to use Test::Harness::Straps.
2.04 Tue Apr 30 00:54:49 EDT 2002
* Changing the output format of skips
- Taking into account VMS's special exit codes in the tests.
2.03 Thu Apr 25 01:01:34 EDT 2002
* $^X fix made safer.
- Noise from loading wait.ph to analyze core files supressed
- MJD found a situation where a test could run Test::Harness
out of memory. Protecting against that specific case.
- Made the 1..M docs a bit clearer.
- Fixed TODO tests so Test::Harness does not display a NOK for
them.
- Test::Harness::Straps->analyze_file() docs were not clear as to
its effects
2.02 Thu Mar 14 18:06:04 EST 2002
* Ken Williams fixed the long standing $^X bug.
* Added HARNESS_VERBOSE
* Fixed a bug where Test::Harness::Straps was considering a test that
is ok but died as passing.
- Added the exit and wait codes of the test to the
analyze_file() results.
2.01 Thu Dec 27 18:54:36 EST 2001
* Added 'passing' to the results to tell you if the test passed
* Added Test::Harness::Straps example (examples/mini_harness.plx)
* Header-at-end tests were being interpreted as failing sometimes
- The 'skip_all' results from analyze* was not being set
- analyze_fh() and analyze_file() now work more efficiently, reading
line-by-line instead of slurping as before.
2.00 Sun Dec 23 19:13:57 EST 2001
- Fixed a warning on VMS.
- Removed a little unnecessary code from analyze_file()
- Made sure filehandles are getting closed
- analyze() now considers "not \nok" to be a failure (VMSism)
but Test::Harness still doesn't.
2.00_05 Mon Dec 17 22:08:02 EST 2001
* Wasn't filtering @INC properly when a test is run with -T, caused the
command line to be too long on VMS. VMS should be 100% now.
- Little bug in the skip 'various reasons' logic.
- Minor POD nit in 5.004_04
- Little speling mistak
2.00_04 Sun Dec 16 00:33:32 EST 2001
* Major Test::Harness::Straps doc bug.
2.00_03 Sat Dec 15 23:52:17 EST 2001
* First release candidate
* 'summary' is now 'details'
* Test #1 is now element 0 on the details array. It works out better
that way.
* analyze_file() is more portable, but no longer taint clean
* analyze_file() properly preserves @INC and handles -T switches
- minor mistake in the test header line parsing
1.26 Mon Nov 12 15:44:01 EST 2001
* An excuse to upload a new version to CPAN to get Test::Harness
back on the index.
2.00_00 Sat Sep 29 00:12:03 EDT 2001
* Partial gutting of the internals
* Added Test::Harness::Straps
1.25 Tue Aug 7 08:51:09 EDT 2001
* Fixed a bug with tests failing if they're all skipped
reported by Stas Bekman.
- Fixed a very minor warning in 5.004_04
- Fixed displaying filenames not from @ARGV
- Merging with bleadperl
- minor fixes to the filename in the report
- '[no reason given]' skip reason
1.24 Tue Aug 7 08:51:09 EDT 2001
- Added internal information about number of todo tests
1.23 Tue Jul 31 15:06:47 EDT 2001
- Merged in Ilya's "various reasons" patch
* Fixed "not ok 23 - some name # TODO" style tests
1.22 Mon Jun 25 02:00:02 EDT 2001
* Fixed bug with failing tests using header at end.
- Documented how Test::Harness deals with garbage input
- Turned on test counter mismatch warning
1.21 Wed May 23 19:22:53 BST 2001
* No longer considered unstable. Merging back with the perl core.
- Fixed minor nit about the report summary
- Added docs on the meaning of the failure report
- Minor POD nits fixed mirroring perl change 9176
- TODO and SEE ALSO expanded
1.20 Wed Mar 14 23:09:20 GMT 2001 by Michael G Schwern *UNSTABLE*
* Fixed and tested with 5.004!
- Added EXAMPLE docs
- Added TODO docs
- Now uneffected by -l, $\ or $,
1.19 Sat Mar 10 00:43:29 GMT 2001 by Michael G Schwern *UNSTABLE*
- More internal reworking
* Removed use of experimental /(?>...)/ feature for backwards compat
* Removed use of open(my $fh, $file) for backwards compatibility
* Removed use of Tie::StdHandle in tests for backwards compat
* Added dire warning that this is unstable.
- Added some tests from the old CPAN release
1.18 Mon Mar 5 17:35:11 GMT 2001 by Michael G Schwern
* Under new management!
* Test::Harness is now being concurrently shipped on CPAN as well
as in the core.
- Switched "our" for "use vars" and moved the minimum version back
to 5.004. This may be optimistic.
*** Missing version history to be extracted from Perl changes ***
1.07 Fri Feb 23 1996 by Andreas Koenig
- Gisle sent me a documentation patch that showed me, that the
unless(/^#/) is unnessessary. Applied the patch and deleted the block
checking for "comment" lines. -- All lines are comment lines that do
not match /^1\.\.([0-9]+)/ or /^(not\s+)?ok\b/.
- Ilyaz request to print "ok (empty test case)" whenever we say 1..0
implemented.
- Harness now doesn't abort anymore if we received confused test output,
just warns instead.
1.05 Wed Jan 31 1996 by Andreas Koenig
- More updates on docu and introduced the liberality that the script
output may omit the test numbers.
1.03 Mon January 28 1996 by Andreas Koenig
- Added the statistics for subtests. Updated the documentation.
1.02 by Andreas Koenig
- This version reports a list of the tests that failed accompanied by
some trivial statistics. The older (unnumbered) version stopped
processing after the first failed test.
- Additionally it reports the exit status if there is one.
--- NEW FILE: Point.pm ---
# -*- Mode: cperl; cperl-indent-level: 4 -*-
package Test::Harness::Point;
use strict;
use vars qw($VERSION);
$VERSION = '0.01';
=head1 NAME
Test::Harness::Point - object for tracking a single test point
=head1 SYNOPSIS
One Test::Harness::Point object represents a single test point.
=head1 CONSTRUCTION
=head2 new()
my $point = new Test::Harness::Point;
Create a test point object.
=cut
sub new {
my $class = shift;
my $self = bless {}, $class;
return $self;
}
my $test_line_regex = qr/
^
(not\ )? # failure?
ok\b
(?:\s+(\d+))? # optional test number
\s*
(.*) # and the rest
/ox;
=head1 from_test_line( $line )
Constructor from a TAP test line, or empty return if the test line
is not a test line.
=cut
sub from_test_line {
my $class = shift;
my $line = shift or return;
# We pulverize the line down into pieces in three parts.
my ($not, $number, $extra) = ($line =~ $test_line_regex ) or return;
my $point = $class->new;
$point->set_number( $number );
$point->set_ok( !$not );
if ( $extra ) {
my ($description,$directive) = split( /(?:[^\\]|^)#/, $extra, 2 );
$description =~ s/^- //; # Test::More puts it in there
$point->set_description( $description );
if ( $directive ) {
$point->set_directive( $directive );
}
} # if $extra
return $point;
} # from_test_line()
=head1 ACCESSORS
Each of the following fields has a getter and setter method.
=over 4
=item * ok
=item * number
=cut
sub ok { my $self = shift; $self->{ok} }
sub set_ok {
my $self = shift;
my $ok = shift;
$self->{ok} = $ok ? 1 : 0;
}
sub pass {
my $self = shift;
return ($self->ok || $self->is_todo || $self->is_skip) ? 1 : 0;
}
sub number { my $self = shift; $self->{number} }
sub set_number { my $self = shift; $self->{number} = shift }
sub description { my $self = shift; $self->{description} }
sub set_description {
my $self = shift;
$self->{description} = shift;
$self->{name} = $self->{description}; # history
}
sub directive { my $self = shift; $self->{directive} }
sub set_directive {
my $self = shift;
my $directive = shift;
$directive =~ s/^\s+//;
$directive =~ s/\s+$//;
$self->{directive} = $directive;
my ($type,$reason) = ($directive =~ /^\s*(\S+)(?:\s+(.*))?$/);
$self->set_directive_type( $type );
$reason = "" unless defined $reason;
$self->{directive_reason} = $reason;
}
sub set_directive_type {
my $self = shift;
$self->{directive_type} = lc shift;
$self->{type} = $self->{directive_type}; # History
}
sub set_directive_reason {
my $self = shift;
$self->{directive_reason} = shift;
}
sub directive_type { my $self = shift; $self->{directive_type} }
sub type { my $self = shift; $self->{directive_type} }
sub directive_reason{ my $self = shift; $self->{directive_reason} }
sub reason { my $self = shift; $self->{directive_reason} }
sub is_todo {
my $self = shift;
my $type = $self->directive_type;
return $type && ( $type eq 'todo' );
}
sub is_skip {
my $self = shift;
my $type = $self->directive_type;
return $type && ( $type eq 'skip' );
}
sub diagnostics {
my $self = shift;
return @{$self->{diagnostics}} if wantarray;
return join( "\n", @{$self->{diagnostics}} );
}
sub add_diagnostic { my $self = shift; push @{$self->{diagnostics}}, @_ }
1;
More information about the dslinux-commit
mailing list