maint/gen-tests.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use IO::All;
   6
   7 my $mode;
   8
   9 my %tests;
  10
  11 my ($test, $segment, $text);
  12
  13 sub mode::outer {
  14   shift;
  15   my $line = $_[0];
  16   if ($line =~ /^=for test (\S+)(?:\s+(\S+))?/) {
  17     $mode = 'inner';
  18     ($test, $segment) = ($1, $2);
  19     $segment ||= '';
  20     $text = '';
  21   } elsif ($line =~ /^=begin testing/) {
  22     $mode = 'find_comment';
  23     ($test, $segment, $text) = ('', '', '');
  24   }
  25 }
  26
  27 sub mode::find_comment {
  28   shift;
  29   my $line = $_[0];
  30   if ($line =~ /^\#\:\: test (\S+)(?:\s+(\S+))?/) {
  31     $mode = 'inner';
  32     ($test, $segment) = ($1, $2);
  33     $segment ||= '';
  34   }
  35 }
  36
  37 sub mode::inner {
  38   shift;
  39   if ($_[0] =~ /^=/) {
  40     $mode = 'outer';
  41     push(@{$tests{$test}{$segment}||=[]}, $text);
  42   } else {
  43     $text .= $_[0];
  44   }
  45 }
  46
  47
  48 my @lines = io('lib/local/lib.pm')->getlines;
  49
  50 $mode = 'outer';
  51
  52 foreach my $line (@lines) {
  53   #warn "$mode: $line";
  54   mode->$mode($line);
  55 }
  56
  57 foreach my $test (keys %tests) {
  58   my $data = $tests{$test};
  59   my $text = join("\n", q{
  60 use strict;
  61 use warnings;
  62 use Test::More 'no_plan';
  63 use local::lib ();
  64 }, @{$data->{setup}||[]},
  65   map { "{\n$_}\n"; } @{$data->{''}||[]}
  66   );
  67   $text > io("t/${test}.t");
  68 }