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