# -*- Mode: cperl; cperl-indent-level: 4 -*-
package TAPx::Harness::Compatible::Point;
use strict;
use vars qw($VERSION);
$VERSION = '0.50_07';
=head1 NAME
TAPx::Harness::Compatible::Point - object for tracking a single test point
=head1 SYNOPSIS
One TAPx::Harness::Compatible::Point object represents a single test point.
=head1 CONSTRUCTION
=head2 new()
my $point = new TAPx::Harness::Compatible::Point;
Create a test point object.
=cut
sub new {
my $class = shift;
my $self = bless {}, $class;
return $self;
}
=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 =~ /^(not )?ok\b(?:\s+(\d+))?\s*(.*)/ )
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
=back
=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;
=head1 TO DOCUMENT
=over
=item add_diagnostic
TODO: Document add_diagnostic
=item description
TODO: Document description
=item diagnostics
TODO: Document diagnostics
=item directive
TODO: Document directive
=item directive_reason
TODO: Document directive_reason
=item directive_type
TODO: Document directive_type
=item from_test_line
TODO: Document from_test_line
=item is_skip
TODO: Document is_skip
=item is_todo
TODO: Document is_todo
=item pass
TODO: Document pass
=item reason
TODO: Document reason
=item set_description
TODO: Document set_description
=item set_directive
TODO: Document set_directive
=item set_directive_reason
TODO: Document set_directive_reason
=item set_directive_type
TODO: Document set_directive_type
=item set_number
TODO: Document set_number
=item set_ok
TODO: Document set_ok
=item type
TODO: Document type
=back