author/extract-inline-tests

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use 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
  30                         =begin[ \t]+(?:test|testing)\b        # ... when we find a =begin test or testing
  31                         .*?                                   # ... and keep capturing
  32                         \n=end[ \t]+(?:test|testing)\s*?      # ... until an =end tag
  33                         (?:\n|$)                              # ... at the end of file or a newline
  34                 )                                  # ... and stop capturing
  35                 /isx;
  36
  37     sub _elements {
  38         my $self     = shift;
  39         my @elements = ();
  40         while ( $self->{source} =~ m/$search/go ) {
  41             my $elt = $1;
  42
  43             # A hack to turn the SYNOPSIS into something Test::Inline
  44             # doesn't barf on
  45             if ( $elt =~ s/=head1[ \t]+SYNOPSIS/=begin testing SETUP\n\n{/ ) {
  46                 $elt .= "}\n\n=end testing SETUP";
  47             }
  48
  49             push @elements, $elt;
  50         }
  51
  52         # If we have just one element it's a SYNOPSIS, so there's no
  53         # tests.
  54         return unless @elements > 1;
  55
  56         if ( @elements && $self->{source} =~ /=head1 NAME\n\n(Moose::Cookbook\S+)/ ) {
  57             unshift @elements, 'package ' . $1 . ';';
  58         }
  59
  60         (List::Util::first { /^=/ } @elements) ? \@elements : '';
  61     }
  62 }
  63
  64 {
  65     package My::Content;
  66
  67     use base 'Test::Inline::Content::Default';
  68
  69     sub process {
  70         my $self = shift;
  71
  72         my $base = $self->SUPER::process(@_);
  73
  74         $base =~ s/(\$\| = 1;)/use Test::Exception;\n$1/;
  75
  76         return $base;
  77     }
  78 }
  79
  80 use File::Find::Rule;
  81 use Test::Inline;
  82
  83
  84 my $target = 't/000_recipes';
  85
  86 for my $t_file ( File::Find::Rule->file->name(qr/^moose_cookbook_\.t$/)->in($target) ) {
  87     unlink $t_file or die "Cannot unlink $t_file: $!";
  88 }
  89
  90 my $inline = Test::Inline->new(
  91     verbose        => 1,
  92     readonly       => 1,
  93     output         => $target,
  94     ExtractHandler => 'My::Extract',
  95     ContentHandler => 'My::Content',
  96 );
  97
  98 for my $pod (
  99     File::Find::Rule->file->name(qr/\.pod$/)->in('lib/Moose/Cookbook') ) {
 100     $inline->add($pod);
 101 }
 102
 103 $inline->save;