Commit | Line | Data |
f675c333 |
1 | # -*- Mode: cperl; cperl-indent-level: 4 -*- |
2 | package Test::Harness::Point; |
3 | |
4 | use strict; |
5 | use vars qw($VERSION); |
6 | $VERSION = '0.01'; |
7 | |
8 | =head1 NAME |
9 | |
10 | Test::Harness::Point - object for tracking a single test point |
11 | |
12 | =head1 SYNOPSIS |
13 | |
14 | One Test::Harness::Point object represents a single test point. |
15 | |
16 | =head1 CONSTRUCTION |
17 | |
18 | =head2 new() |
19 | |
20 | my $point = new Test::Harness::Point; |
21 | |
22 | Create a test point object. |
23 | |
24 | =cut |
25 | |
26 | sub new { |
27 | my $class = shift; |
28 | my $self = bless {}, $class; |
29 | |
30 | return $self; |
31 | } |
32 | |
f675c333 |
33 | =head1 from_test_line( $line ) |
34 | |
35 | Constructor from a TAP test line, or empty return if the test line |
36 | is not a test line. |
37 | |
38 | =cut |
39 | |
40 | sub from_test_line { |
41 | my $class = shift; |
42 | my $line = shift or return; |
43 | |
44 | # We pulverize the line down into pieces in three parts. |
20f9f807 |
45 | my ($not, $number, $extra) = ($line =~ /^(not )?ok\b(?:\s+(\d+))?\s*(.*)/) or return; |
f675c333 |
46 | |
47 | my $point = $class->new; |
48 | $point->set_number( $number ); |
49 | $point->set_ok( !$not ); |
50 | |
51 | if ( $extra ) { |
52 | my ($description,$directive) = split( /(?:[^\\]|^)#/, $extra, 2 ); |
53 | $description =~ s/^- //; # Test::More puts it in there |
54 | $point->set_description( $description ); |
55 | if ( $directive ) { |
56 | $point->set_directive( $directive ); |
57 | } |
58 | } # if $extra |
59 | |
60 | return $point; |
61 | } # from_test_line() |
62 | |
63 | =head1 ACCESSORS |
64 | |
65 | Each of the following fields has a getter and setter method. |
66 | |
67 | =over 4 |
68 | |
69 | =item * ok |
70 | |
71 | =item * number |
72 | |
73 | =cut |
74 | |
75 | sub ok { my $self = shift; $self->{ok} } |
76 | sub set_ok { |
77 | my $self = shift; |
78 | my $ok = shift; |
79 | $self->{ok} = $ok ? 1 : 0; |
80 | } |
81 | sub pass { |
82 | my $self = shift; |
83 | |
84 | return ($self->ok || $self->is_todo || $self->is_skip) ? 1 : 0; |
85 | } |
86 | |
87 | sub number { my $self = shift; $self->{number} } |
88 | sub set_number { my $self = shift; $self->{number} = shift } |
89 | |
90 | sub description { my $self = shift; $self->{description} } |
91 | sub set_description { |
92 | my $self = shift; |
93 | $self->{description} = shift; |
94 | $self->{name} = $self->{description}; # history |
95 | } |
96 | |
97 | sub directive { my $self = shift; $self->{directive} } |
98 | sub set_directive { |
99 | my $self = shift; |
100 | my $directive = shift; |
101 | |
102 | $directive =~ s/^\s+//; |
103 | $directive =~ s/\s+$//; |
104 | $self->{directive} = $directive; |
105 | |
106 | my ($type,$reason) = ($directive =~ /^\s*(\S+)(?:\s+(.*))?$/); |
107 | $self->set_directive_type( $type ); |
108 | $reason = "" unless defined $reason; |
109 | $self->{directive_reason} = $reason; |
110 | } |
111 | sub set_directive_type { |
112 | my $self = shift; |
113 | $self->{directive_type} = lc shift; |
114 | $self->{type} = $self->{directive_type}; # History |
115 | } |
116 | sub set_directive_reason { |
117 | my $self = shift; |
118 | $self->{directive_reason} = shift; |
119 | } |
120 | sub directive_type { my $self = shift; $self->{directive_type} } |
121 | sub type { my $self = shift; $self->{directive_type} } |
122 | sub directive_reason{ my $self = shift; $self->{directive_reason} } |
123 | sub reason { my $self = shift; $self->{directive_reason} } |
124 | sub is_todo { |
125 | my $self = shift; |
126 | my $type = $self->directive_type; |
127 | return $type && ( $type eq 'todo' ); |
128 | } |
129 | sub is_skip { |
130 | my $self = shift; |
131 | my $type = $self->directive_type; |
132 | return $type && ( $type eq 'skip' ); |
133 | } |
134 | |
135 | sub diagnostics { |
136 | my $self = shift; |
137 | return @{$self->{diagnostics}} if wantarray; |
138 | return join( "\n", @{$self->{diagnostics}} ); |
139 | } |
140 | sub add_diagnostic { my $self = shift; push @{$self->{diagnostics}}, @_ } |
141 | |
142 | |
143 | 1; |