From: Dave Rolsky Date: Wed, 29 Dec 2010 15:35:22 +0000 (-0500) Subject: Move pod test extraction to code that can be reused by dzil and Makefile.PL X-Git-Tag: 1.9900~3^2~20 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d62bc8fd72a70cec4aa22e794af221451e281b80;p=gitmo%2FMoose.git Move pod test extraction to code that can be reused by dzil and Makefile.PL The cookbook tests will be extracted every time the dev-only Makefile.PL is run. --- diff --git a/.gitignore b/.gitignore index b8bab15..d2b18c7 100644 --- a/.gitignore +++ b/.gitignore @@ -5,7 +5,7 @@ /MANIFEST.bak /blib/ /pm_to_blib -/t/000_recipes/* +/t/002_recipes/* /.build .* !.gitignore diff --git a/Makefile.PL b/Makefile.PL index 5359a20..6eb0b0f 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -7,6 +7,7 @@ use ExtUtils::MakeMaker; use lib 'inc'; use MMHelper; +use MyInline; warn <<'EOF'; @@ -20,6 +21,8 @@ warn <<'EOF'; EOF +system( $^X, 'author/extract-inline-tests', '--quiet' ); + eval MMHelper::my_package_subs(); WriteMakefile( diff --git a/author/extract-inline-tests b/author/extract-inline-tests new file mode 100755 index 0000000..9a186d9 --- /dev/null +++ b/author/extract-inline-tests @@ -0,0 +1,46 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use lib 'inc'; +use File::Find::Rule; +use Getopt::Long; +use MyInline; +use Test::Inline; + +my $quiet; +GetOptions( 'quiet' => \$quiet ); + +my $inline = Test::Inline->new( + verbose => !$quiet, + ExtractHandler => 'My::Extract', + ContentHandler => 'My::Content', + OutputHandler => 'My::Output', +); + +for my $pod ( + File::Find::Rule->file->name(qr/\.pod$/)->in('lib/Moose/Cookbook') ) { + $inline->add($pod); +} + +$inline->save; + +{ + + package My::Output; + + use File::Slurp qw( write_file ); + + sub write { + my $class = shift; + my $name = shift; + my $content = shift; + + $name =~ s/^moose_cookbook_//; + + write_file( "t/002_recipes/$name", $content ); + + return 1; + } +} diff --git a/inc/ExtractInlineTests.pm b/inc/ExtractInlineTests.pm index 753ea22..bf0f547 100644 --- a/inc/ExtractInlineTests.pm +++ b/inc/ExtractInlineTests.pm @@ -8,6 +8,7 @@ use File::Basename qw( basename ); use File::Find::Rule; use File::Spec; use File::Temp qw( tempdir ); +use inc::MyInline; use Test::Inline; sub gather_files { @@ -30,85 +31,6 @@ sub gather_files { } { - 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 > 2; - - 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::Fatal;\n$1/; - - return $base; - } -} - -{ package My::Output; sub new { diff --git a/inc/MyInline.pm b/inc/MyInline.pm new file mode 100644 index 0000000..3ab70c8 --- /dev/null +++ b/inc/MyInline.pm @@ -0,0 +1,87 @@ +package MyInline; + +use strict; +use warnings; + +{ + package My::Extract; + + use base 'Test::Inline::Extract'; + + use List::Util qw( first ); + + # 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 > 2; + + if ( @elements && $self->{source} =~ /=head1 NAME\n\n(Moose::Cookbook\S+)/ ) { + unshift @elements, 'package ' . $1 . ';'; + } + + ( 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::Fatal;\n$1/; + + return $base; + } +} + +1;