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   if (shift =~ /^=for test (\S+)(?:\s+(\S+))?/) {
  16     $mode = 'inner';
  17     ($test, $segment) = ($1, $2);
  18     $segment ||= '';
  19     $text = '';
  20   }
  21 }
  22
  23 sub mode::inner {
  24   shift;
  25   if ($_[0] =~ /^=/) {
  26     $mode = 'outer';
  27     push(@{$tests{$test}{$segment}||=[]}, $text);
  28   } else {
  29     $text .= $_[0];
  30   }
  31 }
  32
  33
  34 my @lines = io('lib/local/lib.pm')->getlines;
  35
  36 $mode = 'outer';
  37
  38 foreach my $line (@lines) {
  39   #warn "$mode: $line";
  40   mode->$mode($line);
  41 }
  42
  43 foreach my $test (keys %tests) {
  44   my $data = $tests{$test};
  45   my $text = join("\n", q{
  46 use strict;
  47 use warnings;
  48 use Test::More 'no_plan';
  49 use local::lib ();
  50 }, @{$data->{setup}||[]},
  51   map { "{\n$_}\n"; } @{$data->{''}||[]}
  52   );
  53   $text > io("t/${test}.t");
  54 }