Commit | Line | Data |
4c375968 |
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 | } |