1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
#!/usr/bin/perl
use strict;
use warnings;
{
package My::Extract;
use base 'Test::Inline::Extract';
# This extracts the SYNOPSIS in addition to code specifically
# marked for testing
my $search = qr/
(?:^|\n) # After the beginning of the string, or a newline
( # ... start capturing
# EITHER
package\s+ # A package
[^\W\d]\w*(?:(?:\'|::)[^\W\d]\w*)* # ... with a name
\s*; # And a statement terminator
|
=head1[ \t]+SYNOPSIS\n
.*?
(?=\n=)
| # OR
=for[ \t]+example[ \t]+begin\n # ... when we find a =for example begin
.*? # ... and keep capturing
\n=for[ \t]+example[ \t]+end\s*? # ... until the =for example end
(?:\n|$) # ... at the end of file or a newline
| # OR
=begin[ \t]+(?:test|testing)(?:-SETUP)? # ... when we find a =begin test or testing
.*? # ... and keep capturing
\n=end[ \t]+(?:test|testing)(?:-SETUP)? # ... until an =end tag
.*?
(?:\n|$) # ... at the end of file or a newline
) # ... and stop capturing
/isx;
sub _elements {
my $self = shift;
my @elements = ();
while ( $self->{source} =~ m/$search/go ) {
my $elt = $1;
# A hack to turn the SYNOPSIS into something Test::Inline
# doesn't barf on
if ( $elt =~ s/=head1[ \t]+SYNOPSIS/=begin testing-SETUP\n\n{/ ) {
$elt .= "}\n\n=end testing-SETUP";
}
# It seems like search.cpan doesn't like a name with
# spaces after =begin. bleah, what a mess.
$elt =~ s/testing-SETUP/testing SETUP/g;
push @elements, $elt;
}
# If we have just one element it's a SYNOPSIS, so there's no
# tests.
return unless @elements > 1;
if ( @elements && $self->{source} =~ /=head1 NAME\n\n(Moose::Cookbook\S+)/ ) {
unshift @elements, 'package ' . $1 . ';';
}
(List::Util::first { /^=/ } @elements) ? \@elements : '';
}
}
{
package My::Content;
use base 'Test::Inline::Content::Default';
sub process {
my $self = shift;
my $base = $self->SUPER::process(@_);
$base =~ s/(\$\| = 1;)/use Test::Exception;\n$1/;
return $base;
}
}
use File::Find::Rule;
use Test::Inline;
my $target = 't/000_recipes';
for my $t_file ( File::Find::Rule->file->name(qr/^moose_cookbook_\.t$/)->in($target) ) {
unlink $t_file or die "Cannot unlink $t_file: $!";
}
my $inline = Test::Inline->new(
verbose => 1,
readonly => 1,
output => $target,
ExtractHandler => 'My::Extract',
ContentHandler => 'My::Content',
);
for my $pod (
File::Find::Rule->file->name(qr/\.pod$/)->in('lib/Moose/Cookbook') ) {
$inline->add($pod);
}
$inline->save;
|
