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


  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);

  my %total = $strap->total_results;

  # Altering the behavior of the strap  UNIMPLEMENTED
  my $verbose_output = $strap->dump_verbose();


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


=head2 new()

  my $strap = Test::Harness::Straps->new;

Initialize a new strap.


sub new {
    my $class = shift;
    my $self  = bless {}, $class;


    return $self;

=head2 $strap->_init


Initialize the internal state of a strap to make it ready for parsing.


sub _init {
    my($self) = shift;

    $self->{_is_vms}   = ( $^O eq 'VMS' );
    $self->{_is_win32} = ( $^O =~ /^(MS)?Win32$/ );
    $self->{_is_macos} = ( $^O eq 'MacOS' );


=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


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->{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;


    my $linetype;
    my $point = Test::Harness::Point->from_test_line( $line );
    if ( $point ) {
        $linetype = 'test';

        $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->{bonus}++ if $point->ok;
        elsif ( $point->is_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';


        $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.


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.


sub analyze_file {
    my($self, $file) = @_;

    unless( -e $file ) {
        $self->{error} = "$file does not exist";

    unless( -r $file ) {
        $self->{error} = "$file is not readable";

    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";

    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;


    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>.


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.


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.


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.


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>.


    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.


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()


This restores the original value of the C<PERL5LIB> environment variable.
Necessary on VMS, otherwise a no-op.


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 #).


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.


# 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

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.


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>


Resets things like C<< $strap->{max} >> , C<< $strap->{skip_all} >>,
etc. so it's ready to parse the next file.


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

  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.


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



sub _def_or_blank {
    return $_[0] if defined $_[0];
    return "";


--- NEW FILE: TAP.pod ---
=head1 NAME

Test::Harness::TAP - Documentation for the TAP format


TAP, the Test Anything Protocol, is Perl's simple text-based interface
between testing modules such as Test::More and the test harness

=head1 TODO

Exit code of the process.


TAP's general format is:

    ok 1 Description # Directive
    # Diagnostic
    ok 47 Description
    ok 48 Description
    more tests....

For example, a test file's output might look like:

    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


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.


=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,


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

=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

    not ok
    not 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.


To summarize:

=over 4

=item * ok/not ok (required)

=item * Test number (recommended)

=item * Description (recommended)

=item * Directive (only when necessary)



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


=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

    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.


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.

    # 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

=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.

    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.

    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.

    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
    # +------+------+------+------+
    # |      |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

=head1 AUTHORS

Andy Lester, based on the original Test::Harness documentation by Michael Schwern.


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.


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>.


--- 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


  use Test::Harness::Iterator;
  my $it = Test::Harness::Iterator->new(\*TEST);
  my $it = Test::Harness::Iterator->new(\@array);

  my $line = $it->next;



This is a simple iterator wrapper for arrays and filehandles.

=head2 new()

Create an iterator.

=head2 next()

Iterate through it, of course.


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



  use Test::Harness::Assert;

  assert( EXPR, $name );


A simple assert routine since we don't have Carp::Assert handy.

B<For internal use by Test::Harness ONLY!>


=head2 C<assert()>

  assert( EXPR, $name );

If the expression is false the program aborts.


sub assert ($;$) {
    my($assert, $name) = @_;

    unless( $assert ) {
        require Carp;
        my $msg = 'Assert failed';
        $msg .= " - '$name'" if defined $name;
        $msg .= '!';


=head1 AUTHOR

Michael G Schwern C<< <schwern at pobox.com> >>

=head1 SEE ALSO




--- NEW FILE: Changes ---
Revision history for Perl extension Test::Harness

2.56 Wed Sep 28 16:04:00 CDT 2005
    * Incorporate bleadperl patch to fix Test::Harness on VMS.

2.54 Wed Sep 28 09:52:19 CDT 2005
    * Test counts were wrong, so wouldn't install on Perls < 5.8.0.

2.53_02 Thu Aug 25 21:37:01 CDT 2005
    * 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.

    * Fix calls to podusage() to not use the DATA typeglob.  Thanks sungo.

2.53_01 Sun Jul 10 10:45:27 CDT 2005
    * 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

    * The Test::Harness timer is now off by default.  Set HARNESS_TIMER
      true if you want it.  Added --timer flag to prove.

    * 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
    * Added some includes in t/strap-analyze.t to make Cygwin happy.

2.49_02 Tue Jun 21 09:54:44 CDT 2005
    * Added some includes in t/test_harness.t to make Cygwin happy.

2.49_01 Fri Jun 10 15:37:31 CDT 2005
    * Now shows elapsed time in 1000ths of a second if Time::HiRes
      is available.

    * 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
    * Test::Harness now requires Perl 5.005_03 or above.

    * Fixed incorrect "confused by tests in wrong order" error in 2.47_02.

2.47_02 Tue Mar  1 23:15:47 CST 2005
    * Test directives for skip tests used to be anything that matches
      /^skip/i, like the word "skipped", but now it must match

    * 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
    * 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.

    * 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.

    * 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

2.45_02 Fri Dec 31 14:57:33 CST 2004
    * 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
    * Test::Harness now requires Perl 5.004_05.

    * We no longer try to print a stack if a coredump is detected.

    * 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.

    * Added Test::Harness->strap() method to access the internal strap.

    * 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
    * 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
    * Added more debug output if $Test::Harness::Debug is on.

    * Test::Harness now removes default paths from the paths that it
      sets in PERL5LIB.  This fixes RT #5649.  Thanks, Schwern.

    * 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.

    * Added workaround for local $ENV{} bug on Cygwin to
    t/prove-switches.t.  See the following RT tickets for details.


2.42        Wed Apr 28 22:13:11 CDT 2004
    * prove -v now sets TEST_VERBOSE in case your tests rely on them.
    * prove globs the command line, since Win32's shell doesn't.

    * Cross-platform test fixes on t/prove-globbing.t

2.40        Tue Dec 30 20:38:59 CST 2003
    * Test::Harness::Straps should now properly quote on VMS.

    * 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.

    * 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
    * 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
    * Added _command_line() to the Strap API.

    * 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
    * 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
    * 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
    * prove's --blib now works just like the blib pragma.

2.35_01     Wed Nov 12 23:08:45 CST 2003
    * 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.

    * Added -t to prove analogous to Perl's -t.  Removed the --taint

    * 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
    * Allowed prove to run on Perl versions < 5.6.0.

    * 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

    * 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

    * 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

    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
    - 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
    - prove is almost feature-complete.  Removed the handling of
      --exclude for excluding certain tests.  It may go back in the
    - prove -d is now debug.  Dry is prove -D.

2.31_02     Fri Oct 31 23:46:03 CST 2003
    - Added many more switches to prove: -d for dry run, and -b for

    - 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.

    - 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.

    - Added "prove" script to run a test or set of tests through the
      harness.  Thanks to Curtis Poe for the foundation.

    - 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.

    - 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
    - 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.

    - 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
    - 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
    - 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 
    * 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
    - 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.
    * 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
    - 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


One Test::Harness::Point object represents a single test point.


=head2 new()

    my $point = new Test::Harness::Point;

Create a test point object.


sub new {
    my $class = shift;
    my $self  = bless {}, $class;

    return $self;

my $test_line_regex = qr/
    (not\ )?               # failure?
    (?:\s+(\d+))?         # optional test number
    (.*)                  # and the rest

=head1 from_test_line( $line )

Constructor from a TAP test line, or empty return if the test line
is not a test line.


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()


Each of the following fields has a getter and setter method.

=over 4

=item * ok

=item * number


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}}, @_ }


More information about the dslinux-commit mailing list