Add test - custom error class is causing a warning from make_immutable
[gitmo/Moose.git] / inc / MyInline.pm
1 package MyInline;
2
3 use strict;
4 use 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/
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
22                 |
23                         =head1[ \t]+SYNOPSIS\n
24                         .*?
25                         (?=\n=)
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
35                         .*?
36             (?:\n|$)                              # ... at the end of file or a newline
37         )                                  # ... and stop capturing
38         /isx;
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
87 1;