File Coverage

blib/lib/Test/Proto.pm
Criterion Covered Total %
statement 67 69 97.1
branch 14 16 87.5
condition 2 3 66.6
subroutine 26 26 100.0
pod 10 10 100.0
total 119 124 95.9


line stmt bran cond sub pod time code
1             package Test::Proto;
2              
3 4     4   66620 use 5.008;
  4         78  
  4         155  
4 4     4   22 use strict;
  4         6  
  4         132  
5 4     4   22 use warnings;
  4         9  
  4         142  
6 4     4   1242 use Test::Proto::Base;
  4         9  
  4         123  
7 4     4   2111 use Test::Proto::ArrayRef;
  4         13  
  4         146  
8 4     4   2551 use Test::Proto::HashRef;
  4         28  
  4         143  
9 4     4   2417 use Test::Proto::CodeRef;
  4         12  
  4         134  
10 4     4   2418 use Test::Proto::Object;
  4         14  
  4         154  
11 4     4   2327 use Test::Proto::Series;
  4         12  
  4         96  
12 4     4   2288 use Test::Proto::Repeatable;
  4         12  
  4         110  
13 4     4   2476 use Test::Proto::Alternation;
  4         10  
  4         101  
14 4     4   2126 use Test::Proto::Compare;
  4         11  
  4         103  
15 4     4   2240 use Test::Proto::Compare::Numeric;
  4         10  
  4         116  
16 4     4   22 use Test::Proto::Common ();
  4         7  
  4         72  
17 4     4   19 use Scalar::Util qw(blessed refaddr);
  4         6  
  4         235  
18 4     4   18 use base "Exporter";
  4         6  
  4         2883  
19             our @EXPORT_OK = qw(&p &pArray &pHash &pCode &pObject &pSeries &pRepeatable &pAlternation &c &cNumeric); # symbols to export on request
20             our %EXPORT_TAGS = (all => [@EXPORT_OK]);
21              
22             =head1 NAME
23              
24             Test::Proto - OO test script golf sugar
25              
26             =head1 VERSION
27              
28             Version 0.027
29              
30             =cut
31              
32             our $VERSION = '0.027'; #~ must keep in sync with $Test::Proto::Base::VERSION;
33              
34             =head1 SYNOPSIS
35              
36             This module provides an expressive interface for validating deep structures and objects.
37              
38             use Test::Proto ':all';
39            
40             pArray ->contains_only(pSeries('', pHash),
41             "ArrayRef must contain only an empty string followed by a hashref")
42             ->ok(["", {a=>'b'}]);
43             # provides diagnostics, including subtests as TAP, using Test::Builder
44            
45             p ->like(qr/^\d+$/, 'looks like a positive integer')
46             ->unlike(qr/^0\d+$/, 'no leading zeros')
47             ->validate('123');
48             # returns an object with a true value
49            
50             pObject ->is_a('XML::LibXML::Node', 'must inherit from XML::LibXML::Node')
51             ->is_a('XML::LibXML::Element', 'what it really is')
52             ->method_exists('findnodes', 'must have the findnodes method')
53             ->method_scalar_context('localName', [],
54             p->like(qr/blockquote|li|p/, 'We can add normal text here')
55             )
56             ->ok(XML::LibXML::Element->new('li'));
57             # have a look at the nested prototype in try_can
58              
59             The idea behind Test::Proto is that test scripts for code written on modern, OO principles should themselves resemble the target code rather than sequential code.
60              
61             Tests for deep structures and objects tend should not be repetitive and should be flexible. Test::Proto allows you to create objects "protoypes" intended to test structures which conform to a known type.
62              
63             As in the example above, the way it works is: you create a prototype object, add test cases to the prototype using method calls, and then validate your string/arryref/object/etc. against the prototype using the validate or ok method.
64              
65             NB: The meaning of "prototype" used here is not related to subroutine prototypes (declaring the arguments expected by a given function or method).
66              
67             =head1 FUNCTIONS
68              
69             =head2 p
70              
71             p
72             p('foo')
73             p(['bar'])
74             p({foo=>'bar'})
75              
76             Returns a basic prototype. See L. If an argument is passed, upgrades the argument and uses the resulting prototype.
77              
78             =cut
79              
80             sub p {
81 6 100   6 1 524 return Test::Proto::Common::upgrade( $_[0] ) if 1 == scalar @_;
82 1         13 return Test::Proto::Base->new(@_);
83             }
84              
85             =head2 pArray
86              
87             Returns a prototype for an array/ArrayRef. See L.
88              
89             =cut
90              
91             sub pArray {
92 2 100   2 1 990 return Test::Proto::Common::upgrade( $_[0] ) if 1 == scalar @_;
93 1         31 return Test::Proto::ArrayRef->new(@_)->array;
94             }
95              
96             =head2 pHash
97              
98             Returns a prototype for a hash/HashRef. See L.
99              
100             =cut
101              
102             sub pHash {
103 2 100   2 1 15 return Test::Proto::Common::upgrade( $_[0] ) if 1 == scalar @_;
104 1         40 return Test::Proto::HashRef->new(@_)->hash;
105             }
106              
107             =head2 pCode
108              
109             Returns a prototype for a CodeRef. See L.
110              
111             =cut
112              
113             sub pCode {
114 1     1 1 30 return Test::Proto::CodeRef->new(@_);
115             }
116              
117             =head2 pObject
118              
119             pObject
120             pObject('IO::Handle') # tests with is_a
121              
122             Returns a prototype for an object. See L.
123              
124             =cut
125              
126             sub pObject {
127 10 100   10 1 730 if ( 1 == scalar @_ ) {
128 9         320 my $p = Test::Proto::Object->new()->blessed;
129 9 100 66     137 if ( !ref $_[0] ) {
    50          
    50          
130 2         16 $p->is_a( $_[0] );
131             }
132             elsif ( ( blessed $_[0] ) and $_[0]->isa('Test::Proto::Base') ) {
133 0         0 $p->is_also( $_[0] );
134             }
135             elsif ( ref $_[0] =~ /^(?:HASH|ARRAY)$/ ) {
136 0         0 $p->is_also( Test::Proto::Common::upgrade( $_[0] ) );
137             }
138             else {
139 7 100       41 $p->refaddr( refaddr $_[0] ) if blessed $_[0];
140             }
141 9         66 return $p;
142             }
143             else {
144 1         31 return Test::Proto::Object->new(@_)->blessed;
145             }
146             }
147              
148             =head2 pSeries
149              
150             Returns a series object for use in validating lists. See L.
151              
152             =cut
153              
154             sub pSeries {
155 1     1 1 460 return Test::Proto::Series->new(@_);
156             }
157              
158             =head2 pRepeatable
159              
160             Returns a repeatable series object for use in validating lists. See L.
161              
162             =cut
163              
164             sub pRepeatable {
165 1     1 1 469 return Test::Proto::Repeatable->new(@_);
166             }
167              
168             =head2 pAlternation
169              
170             Returns an alternation for use in validating lists. See L.
171              
172             =cut
173              
174             sub pAlternation {
175 1     1 1 471 return Test::Proto::Alternation->new(@_);
176             }
177              
178             =head2 c
179              
180             Returns a comparison object (string, by default). See L.
181              
182             =cut
183              
184             sub c {
185 1     1 1 9 return Test::Proto::Compare->new(@_);
186             }
187              
188             =head2 cNumeric
189              
190             Returns a numeric comparison object. See L.
191              
192             =cut
193              
194             sub cNumeric {
195 1     1 1 487 return Test::Proto::Compare::Numeric->new(@_);
196             }
197              
198             =head1 AUTHOR
199              
200             Begun by Daniel Perrett, C<< >>
201              
202             =head1 CONTRIBUTORS
203              
204             Michael Schwern
205              
206             =head1 SEE ALSO
207              
208             L
209              
210             L
211              
212             L
213              
214             L
215              
216             L
217              
218             =head1 BUGS
219              
220             Please report any bugs or feature requests to the github issues tracker at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
221              
222              
223             =head1 SUPPORT
224              
225             You can find documentation for this module with the perldoc command.
226              
227             perldoc Test::Proto
228              
229             You can also look for information at:
230              
231             =over 4
232              
233             =item * Github (please report bugs here)
234              
235             L
236              
237             =item * MetaCPAN
238              
239             L
240              
241             =item * AnnoCPAN: Annotated CPAN documentation
242              
243             L
244              
245             =item * Search CPAN
246              
247             L
248              
249             =back
250              
251              
252             =head1 LICENSE AND COPYRIGHT
253              
254             Copyright 2012-2013 Daniel Perrett.
255              
256             This program is free software; you can redistribute it and/or modify it
257             under the terms of either: the GNU General Public License as published
258             by the Free Software Foundation; or the Artistic License.
259              
260             See http://dev.perl.org/licenses/ for more information.
261              
262              
263             =cut
264              
265             return 1; # module loaded ok