require running the smoker before non-trial releases
[gitmo/Moose.git] / inc / MyInline.pm
CommitLineData
d62bc8fd 1package MyInline;
2
3use strict;
4use warnings;
5
6{
7 package My::Extract;
8
9 use base 'Test::Inline::Extract';
10
11 use List::Util qw( first );
12
13 # This extracts the SYNOPSIS in addition to code specifically
14 # marked for testing
15 my $search = qr/
a4c24596 16 (?:^|\n) # After the beginning of the string, or a newline
17 ( # ... start capturing
18 # EITHER
19 package\s+ # A package
20 [^\W\d]\w*(?:(?:\'|::)[^\W\d]\w*)* # ... with a name
21 \s*; # And a statement terminator
d62bc8fd 22 |
23 =head1[ \t]+SYNOPSIS\n
24 .*?
25 (?=\n=)
a4c24596 26 | # OR
27 =for[ \t]+example[ \t]+begin\n # ... when we find a =for example begin
28 .*? # ... and keep capturing
29 \n=for[ \t]+example[ \t]+end\s*? # ... until the =for example end
30 (?:\n|$) # ... at the end of file or a newline
31 | # OR
32 =begin[ \t]+(?:test|testing)(?:-SETUP)? # ... when we find a =begin test or testing
33 .*? # ... and keep capturing
34 \n=end[ \t]+(?:test|testing)(?:-SETUP)? # ... until an =end tag
d62bc8fd 35 .*?
a4c24596 36 (?:\n|$) # ... at the end of file or a newline
37 ) # ... and stop capturing
38 /isx;
d62bc8fd 39
40 sub _elements {
41 my $self = shift;
42 my @elements = ();
43 while ( $self->{source} =~ m/$search/go ) {
44 my $elt = $1;
45
46 # A hack to turn the SYNOPSIS into something Test::Inline
47 # doesn't barf on
48 if ( $elt =~ s/=head1[ \t]+SYNOPSIS/=begin testing-SETUP\n\n{/ ) {
49 $elt .= "}\n\n=end testing-SETUP";
50 }
51
52 # It seems like search.cpan doesn't like a name with
53 # spaces after =begin. bleah, what a mess.
54 $elt =~ s/testing-SETUP/testing SETUP/g;
55
56 push @elements, $elt;
57 }
58
59 # If we have just one element it's a SYNOPSIS, so there's no
60 # tests.
61 return unless @elements > 2;
62
63 if ( @elements && $self->{source} =~ /=head1 NAME\n\n(Moose::Cookbook\S+)/ ) {
64 unshift @elements, 'package ' . $1 . ';';
65 }
66
67 ( first {/^=/} @elements ) ? \@elements : '';
68 }
69}
70
71{
72 package My::Content;
73
74 use base 'Test::Inline::Content::Default';
75
76 sub process {
77 my $self = shift;
78
79 my $base = $self->SUPER::process(@_);
80
81 $base =~ s/(\$\| = 1;)/use Test::Fatal;\n$1/;
82
83 return $base;
84 }
85}
86
871;