root/lang/perl/Test-Declare/trunk/lib/Test/Declare.pm @ 9550

Revision 9550, 4.2 kB (checked in by nekokak, 7 years ago)

lang/perl/Test-Declare: use Test::Warn;

Line 
1package Test::Declare;
2use strict;
3use warnings;
4use base 'Exporter';
5
6our $VERSION = '0.02';
7
8my @test_more_exports;
9my @test_more_method;
10BEGIN {
11    @test_more_method = qw(
12        use_ok require_ok
13        eq_array eq_hash eq_set
14        can_ok
15    );
16    @test_more_exports = (qw(
17        skip todo todo_skip
18        pass fail
19        plan
20        diag
21        BAIL_OUT
22        $TODO
23    ),@test_more_method);
24}
25
26use Test::More import => \@test_more_exports;
27use Test::Exception;
28use Test::Warn;
29use Test::Deep;
30
31my @test_wrappe_method = qw(
32    cmp_ok ok dies_ok throws_ok
33    is isnt is_deeply like unlike
34    isa_ok cmp_deeply re cmp_bag
35    prints_ok stderr_ok
36    warning_like warnings_like warning_is warnings_are
37);
38
39my @test_method = (@test_wrappe_method, @test_more_method);
40
41our @EXPORT = (@test_more_exports, @test_wrappe_method, qw/
42    init cleanup run test describe blocks
43/);
44
45my $test_block_name;
46sub test ($$) { ## no critic
47    $test_block_name = shift;
48    shift->();
49}
50
51{
52    no strict 'refs'; ## no critic
53    for my $sub (qw/init cleanup/) {
54        *{"Test\::Declare\::$sub"} = sub (&) {
55            shift->();
56        };
57    }
58}
59
60sub run (&) { shift } ## no critic
61
62sub describe ($$) { ## no critic
63    shift; shift->();
64}
65
66use PPI;
67sub PPI::Document::find_test_blocks {
68    my $self = shift;
69    my $blocks = $self->find(
70        sub {
71            $_[1]->isa('PPI::Token::Word')
72            and
73            grep { $_[1]->{content} eq $_ } @test_method
74        }
75    )||[];
76    return @$blocks
77}
78sub blocks {
79    my @caller = caller;
80    my $file = $caller[1];
81    my $doc = PPI::Document->new($file) or die $!;
82    return scalar( $doc->find_test_blocks );
83}
84
85## Test::More wrapper
86{
87    no strict 'refs'; ## no critic
88    for my $sub (qw/is is_deeply like isa_ok isnt unlike/) {
89        *{"Test\::Declare\::$sub"} = sub ($$;$) {
90            my ($actual, $expected, $name) = @_;
91            my $test_more_code = "Test\::More"->can($sub);
92            goto $test_more_code, $actual, $expected, $name||$test_block_name;
93        }
94    }
95
96}
97
98sub cmp_ok ($$$;$) { ## no critic
99    my ($actual, $operator, $expected, $name) = @_;
100    my $test_more_code = "Test\::More"->can('cmp_ok');
101    goto $test_more_code, $actual, $operator, $expected, $name||$test_block_name;
102}
103
104sub ok ($;$) { ## no critic
105    my ($test, $name) = @_;
106    my $test_more_code = "Test\::More"->can('ok');
107    goto $test_more_code, $test, $name||$test_block_name;
108}
109
110## original method
111use IO::Scalar;
112sub prints_ok (&$;$) { ## no critic
113    my ($code, $expected, $name) = @_;
114
115    tie *STDOUT, 'IO::Scalar', \my $stdout;
116        $code->();
117        like($stdout, qr/$expected/, $name||$test_block_name);
118    untie *STDOUT;
119}
120sub stderr_ok (&$;$) { ## no critic
121    my ($code, $expected, $name) = @_;
122
123    tie *STDERR, 'IO::Scalar', \my $stderr;
124        $code->();
125        like($stderr, qr/$expected/, $name||$test_block_name);
126    untie *STDERR;
127}
128
1291;
130
131__END__
132=head1 NAME
133
134Test::Declare - declarative testing
135
136=head1 SYNOPSIS
137
138    use strict;
139    use warnings;
140    use Test::Declare;
141    plan tests => blocks;
142   
143    describe 'foo bar test' => run {
144        init {
145            # init..
146        };
147        test 'foo is bar?' => run {
148            is foo, bar;
149        };
150        cleanup {
151            # cleanup..
152        };
153    };
154
155=head1 DESCRIPTION
156
157Test::More and Test::Exception and Test::Deep wrapper module.
158
159=head1 METHOD
160
161=head2 describe
162    outline setting.
163
164=head2 blocks
165    get test block count.
166
167=head2 init
168    definition of init block.
169
170=head2 test
171    definition of test block.
172
173=head2 run
174    run test code.
175
176=head2 cleanup
177    definition of cleanup block.
178
179=head1 BUGS AND LIMITATIONS
180
181No bugs have been reported.
182
183=head1 SEE ALSO
184
185This test module's core modules
186
187L<Test::More> and L<Test::Exception> and L<Test::Deep> and L<PPI>
188
189Test::Declare's sample tests
190
191L<DBIx::Class::TableNames> 's 01_table_names.t
192
193L<DBIx::Class::ProxyTable> 's 01_proxy.t
194
195=head1 AUTHOR
196
197Atsushi Kobayashi  C<< <nekokak __at__ gmail.com> >>
198
199=head1 LICENCE AND COPYRIGHT
200
201Copyright (c) 2008, Atsushi Kobayashi C<< <nekokak __at__ gmail.com> >>. All rights reserved.
202
203This module is free software; you can redistribute it and/or
204modify it under the same terms as Perl itself. See L<perlartistic>.
205
Note: See TracBrowser for help on using the browser.