File Coverage

blib/lib/Test/Class/Sugar.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Test::Class::Sugar;
2              
3 2     2   4875 use Devel::Declare ();
  2         39073  
  2         76  
4 2     2   2668 use Devel::Declare::Context::Simple;
  2         36495  
  2         61  
5 2     2   18 use B::Hooks::EndOfScope;
  2         10  
  2         12  
6 2     2   1559 use Test::Class::Sugar::Context;
  2         4  
  2         87  
7 2     2   1118 use Test::Class::Sugar::CodeGenerator;
  0            
  0            
8             use Carp qw/croak/;
9              
10             use namespace::clean;
11              
12             our $VERSION = '0.0400';
13              
14             my %PARSER_FOR = (
15             testclass => '_parse_testclass',
16             startup => '_parse_inner_keyword',
17             setup => '_parse_inner_keyword',
18             test => '_parse_inner_keyword',
19             teardown => '_parse_inner_keyword',
20             shutdown => '_parse_inner_keyword',
21             );
22              
23             use Sub::Exporter -setup => {
24             exports => [qw/testclass startup setup test teardown shutdown/],
25             groups => {default => [qw/testclass/],
26             inner => [qw/startup setup test teardown shutdown/]},
27             installer => sub {
28             my ($args, $to_export) = @_;
29             my $pack = $args->{into};
30             unless (@$to_export) {
31             unshift @$to_export, 'testclass', \&testclass;
32             }
33             foreach my $name (@$to_export) {
34             my $parser_called = defined $PARSER_FOR{$name} ? $PARSER_FOR{$name} : '-NOTHING-';
35             if (my $parser = __PACKAGE__->can($parser_called)) {
36             Devel::Declare->setup_for(
37             $pack,
38             { $name => { const => sub { $parser->($pack, $args->{col}{defaults}, @_) } } },
39             );
40             }
41             }
42             Sub::Exporter::default_installer(@_);
43             },
44             collectors => [qw/defaults/],
45             };
46              
47             sub _test_generator {
48             my($ctx, $name, $plan) = @_;
49             Test::Class::Sugar::CodeGenerator->new(
50             context => $ctx,
51             name => $name,
52             plan => $plan,
53             );
54             }
55              
56             sub _testclass_generator {
57             my($ctx, $classname, $defaults, $options) = @_;
58              
59             foreach my $key (keys %$defaults) {
60             defined $options->{$key} ? () : ($options->{$key} = $defaults->{$key});
61             }
62              
63             my $ret = Test::Class::Sugar::CodeGenerator->new(
64             context => $ctx,
65             options => $options,
66             );
67             $ret->classname($classname) if $classname;
68             return $ret;
69             }
70              
71              
72             sub _parse_inner_keyword {
73             my $pack = shift;
74             my $defaults = shift;
75              
76             local $Carp::Internal{'Devel::Declare'} = 1;
77              
78             my $ctx = Test::Class::Sugar::Context->new->init(@_);
79             my $preamble = '';
80              
81             $ctx->skip_declarator;
82              
83             my $name = $ctx->strip_test_name
84             || croak "Can't make a test without a name";
85             my $plan = $ctx->strip_plan;
86              
87             _test_generator($ctx, $name, $plan)->install_test();
88              
89             return;
90             }
91              
92             sub _parse_testclass {
93             my $pack = shift;
94             my $defaults = shift;
95              
96             local $Carp::Internal{'Devel::Declare'} = 1;
97              
98             my $ctx = Test::Class::Sugar::Context->new->init(@_);
99              
100             $ctx->skip_declarator;
101             my $classname = $ctx->strip_testclass_name;
102             _testclass_generator($ctx, $classname, $defaults, $ctx->strip_options)
103             ->install_testclass;
104             }
105              
106             sub testclass (&) {}
107              
108             sub startup (&) {}
109             sub setup (&) {}
110             sub test (&) { croak "Should not be called" }
111             sub teardown (&) {}
112             sub shutdown (&) {}
113              
114             1;
115             __END__
116              
117             =head1 NAME
118              
119             Test::Class::Sugar - Helper syntax for writing Test::Class tests
120              
121             =head1 SYNOPSIS
122              
123             use Test::Class::Sugar;
124              
125             testclass exercises Person {
126             # Test::Most has been magically included
127             # 'warnings' and 'strict' are turned on
128              
129             startup >> 1 {
130             use_ok $test->subject;
131             }
132              
133             test autonaming {
134             is ref($test), 'Test::Person';
135             }
136              
137             test the naming of parts {
138             is $test->current_method, 'test_the_naming_of_parts';
139             }
140              
141             test multiple assertions >> 2 {
142             is ref($test), 'Test::Person';
143             is $test->current_method, 'test_multiple_assertions';
144             }
145             }
146              
147             Test::Class->runtests;
148              
149             =head1 DESCRIPTION
150              
151             Test::Class::Sugar provides a new syntax for setting up your Test::Class based
152             tests. The idea is that we bundle up all the tedious boilerplate involved in
153             writing a class in favour of getting to the meat of what you're testing. We
154             made warranted assumptions about what you want to do, and we do them for
155             you. So, when you write
156              
157             testclass exercises Person {
158             ...
159             }
160              
161             What Perl sees, after Test::Class::Sugar has done its work, is roughly:
162              
163             {
164             package Test::Person;
165             use base qw/Test::Class/;
166             use strict; use warnings;
167             require Person;
168              
169             sub subject { 'Person' };
170              
171             ...
172             }
173              
174             Some of the assumptions we made are overrideable, others aren't. Yet. Most of
175             them will be though. See L</Changing Assumptions> for details
176              
177             =head2 Why you shouldn't use Test::Class::Sugar
178              
179             Test::Class::Sugar is very new, mostly untested and is inadvertently hostile
180             to you if you confuse its parser. Don't use it if you want to live.
181              
182             =head2 Why you should use Test::Class::Sugar
183              
184             It's so shiny! Test::Class::Sugar was written to scratch an itch I had
185             when writing some tests for a L<MooseX::Declare> based module. Switching from
186             the implementation code to the test code was like shifting from fifth to first
187             gear in one fell swoop. Not fun. This is my attempt to sprinkle some
188             C<Devel::Declare> magic dust over the testing experience.
189              
190             =head2 Bear this in mind:
191              
192             B<Test::Class::Sugar is not a source filter>
193              
194             I know it looks like a source filter in the right light, but it isn't. Source
195             filters fall down because only perl can parse Perl, so it's easy to confuse
196             them. Devel::Declare based modules work by letting perl parse Perl until it
197             comes across a new keyword, at which point it temporarily hands parsing duty
198             over to a new parser which has the job of parsing the little language
199             introduced by the keyword, turning it into real Perl, and handing the
200             responsibility for parsing that back to Perl. Obviously, it's still possible
201             for that to screw things up royally, but there are fewer opportunities to fuck
202             up.
203              
204             We now return you to your regularly scheduled documentation.
205              
206             =head1 SYNTAX
207              
208             Essentially, Test::Class::Sugar adds some new keywords to perl. Here's what
209             they do, and what they expect.
210              
211             (Syntax is described in the semi-standard half-arsed Backus-Naur Form
212             beloved of crappy language documentation efforts everywhere. If you can't read
213             it by now, find someone who can and blackmail them into writing a BNF free
214             tutorial and I for one will thank you for it.)
215              
216             =over
217              
218             =item B<testclass>
219              
220             testclass NAME?
221             ( exercises CLASS
222             | extends CLASS (, CLASS)*
223             | uses HELPER (, HELPER)*
224             )*
225              
226             Where B<NAME> is is an optional test class name - the sort of thing you're
227             used to writing after C<package>. You don't have to name your C<testclass>,
228             but if you don't supply a name, you MUST supply an exercises clause.
229              
230             =over
231              
232             =item exercises CLASS
233              
234             You can supply at most one C<exercises> clause. This specifies the class under
235             test. We use it to autoname the class if you haven't provided a NAME of your
236             own (the default name of the class would be C<< Test::<CLASS> >>). Also, if
237             you supply an exercises clause, the class will be autorequired and your test
238             class will have a C<subject> helper method, which will return the name of the
239             class under test.
240              
241             =item extends CLASS (, CLASS)*
242              
243             Sometimes, you don't want to inherit directly from B<Test::Class>. If that's
244             the case, add an C<extends> clause, and your worries will be over. The extends
245             clause supports, but emphatically does not encourage, multiple
246             inheritance. Friends don't let friends do multiple inheritance, but
247             Test::Class::Sugar's not a friend, it's a robot servant which knows nothing of
248             Asimov's Laws. If you insist on asking it for a length of rope with a loop at
249             the end and a rickety stepladder on which to stand, it will be all too happy to
250             assist.
251              
252             =item uses HELPER (, HELPER)*
253              
254             Ah, the glory that is the C<uses> clause. If you don't provide a uses clause,
255             Test::Class::Sugar will assume that you want to use L<Test::Most> as your
256             testing only testing helper library. If you would rather use, say,
257             L<Test::More> then you can do:
258              
259             testclass ExampleTest uses -More {...}
260              
261             Hang on, C<-More>, what's that about? It's a simple shortcut. Instead of
262             making you write C<uses Test::This, Test::That, Test::TheOther>, you can write
263             C<uses -This, -That, -TheOther> and we'll expand the C<-> into C<Test::> and
264             do the right thing.
265              
266             Note that, if you need to do anything special in the way of import arguments,
267             you should do the C<use> yourself. We're all about the 80:20 rule here.
268              
269             =back
270              
271             =item B<test>
272              
273             test WORD ( WORD )* (>> PLAN)? { ... }
274              
275             I may be fooling myself, but I hope its mostly obvious what this does. Here's a few
276             examples to show you what's happening:
277              
278             test with multiple subtests >> 3 {...}
279             test with no_plan >> no_plan {...}
280             test 'a complicated description with "symbols" in it' {...}
281              
282             Gets translated to:
283              
284             sub test_with_multiple_subtests : Test(3) {...}
285             sub test_with_no_plan : Test(no_plan) {...}
286             sub a_complicated_description_with_symbols_in_it : Test {...}
287              
288             C<< >> PLAN >> is used to declare the number of subtests run by a given
289             message. It's not the most obvious choice I know, but I gave up on trying to
290             use C<:> after losing a few rounds with Perl over loop labels.
291              
292             See L<Test::Class|Test::Class/Test> for details of C<PLAN>'s semantics.
293              
294             =head2 Lifecycle Methods
295              
296             =item B<startup>
297              
298             =item B<setup>
299              
300             =item B<teardown>
301              
302             =item B<shutdown>
303              
304             (startup|setup|teardown|shutdown) ( WORD )* (>> PLAN)? { ... }
305              
306             These lifecycle helpers work in pretty much the same way as L</test>, but with
307             the added wrinkle that, if you don't supply a name, they generate method names
308             derived from the name of the test class and the name of the helper, so, for
309             instance:
310              
311             testclass Test::Lifecycle::Autonaming {
312             setup { ... }
313             }
314              
315             is equivalent to writing:
316              
317             testclass Test::Lifecycle::Autonaming {
318             setup 'setup_Test_Lifecycle_Autonaming' {...}
319             }
320              
321             Other than that, the lifecycle helpers behave as described in
322             L<Test::Class|Test::Class/Test>. In particular, you can still give them names,
323             so
324              
325             testclass {
326             setup with a name {...}
327             }
328              
329             works just fine.
330              
331             =back
332              
333             =head2 Changing Assumptions
334              
335             There are several aspects of Test::Class::Sugar's policy that you may disagree
336             with. If you do, you can adjust them by passing a 'defaults' hash at use
337             time. For example:
338              
339             use Test::Class::Sugar defaults => { prefix => TestSuite };
340              
341             Here's a list of the possible default settings and what they affect.
342              
343             =over
344              
345             =item prefix
346              
347             Changes the prefix used for autogenerating test class names from C<Test::> to whatever you specify, so:
348              
349             use Test::Class::Sugar defaults => { prefix => TestSuite };
350              
351             testclass exercises Something {
352             ...
353             }
354              
355             will build a test class called C<TestSuite::Something>
356              
357             =item test_instance
358              
359             B<COMING SOON>
360              
361             Prefer C<$self> to C<$test> in your test methods? Then the C<test_instance> default is your friend. Just do
362              
363             use Test::Class::Sugar defaults => { test_instance => '$self' }
364              
365             and all manner of things shall be well.
366              
367              
368              
369             =item uses
370              
371             B<< COMING SOON, BUT PROBABLY LATER THAN C<test_instance> >>
372              
373             Bored of adding the same old C<uses> clause to your every testclass? Fix it at use time like so:
374              
375             use Test::Class::Sugar
376             defaults => {
377             uses => [qw/Test::More Moose/]
378             };
379              
380             =back
381              
382             =head1 DIAGNOSTICS
383              
384             Right now, Test::Class::Sugar's diagnostics range from the confusing to the
385             downright misleading. Expect progress on this in the future, tuit supply
386             permitting.
387              
388             Patches welcome.
389              
390             =head1 BUGS AND LIMITATIONS
391              
392             =head2 Known bugs
393              
394             =over
395              
396             =item Screwy line numbers
397              
398             Test::Class::Sugar can screw up the accord between the line perl thinks some
399             code is on and the line the code is I<actually> on. This makes debugging test
400             classes harder than it should be. Our error reporting is bad enough already
401             without making things worse.
402              
403             =back
404              
405             =head2 Unknown bugs
406              
407             There's bound to be some.
408              
409             =head2 We still don't play well with MooseX::Declare
410              
411             It would be useful to pinch some of L<MooseX::Declare>'s magic for writing
412             helper methods. Something like:
413              
414             helper whatever ($arg) {
415             lives_ok { $test->subject->new($arg) }
416             }
417              
418             could be rather handy.
419              
420              
421             =head2 Patches welcome.
422              
423             Please report any bugs or feature requests to me. It's unlikely you'll get any
424             response if you use L<http://rt.cpan.org> though. Your best course of action
425             is to fork the project L<http://www.github.com/pdcawley/test-class-sugar>,
426             write at least one failing test (Write something in C<testclass> form that
427             should work, but doesn't. If you can arrange for it to fail gracefully, then
428             please do, but if all you do is write something that blows up spectacularly,
429             that's good too. Failing/exploding tests are like manna to a maintenance
430             programmer.
431              
432             =head1 AUTHOR
433              
434             Piers Cawley C<< <pdcawley@bofh.org.uk> >>
435              
436             =head1 ACKNOWLEDGEMENTS
437              
438             Thanks to Adrian Howard for the original Test::Class, and to Adam Kennedy for
439             taking on the maintenance of it.
440              
441             Thanks to my contributors:
442              
443             Hans Dieter Pearcey for documentation fixes and Joel Bernstein for doing the
444             boring work of making this all work with Perl 5.8 (which means I can start
445             using this at work!)
446              
447             =head1 LICENCE AND COPYRIGHT
448              
449             Copyright (c) 2009, Piers Cawley C<< <pdcawley@bofh.org.uk> >>. All rights reserved.
450              
451             This module is free software; you can redistribute it and/or
452             modify it under the same terms as Perl itself. See L<perlartistic>.
453              
454              
455             =head1 DISCLAIMER OF WARRANTY
456              
457             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
458             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
459             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
460             PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
461             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
462             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
463             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
464             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
465             NECESSARY SERVICING, REPAIR, OR CORRECTION.
466              
467             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
468             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
469             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
470             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
471             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
472             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
473             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
474             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
475             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
476             SUCH DAMAGES.