Commit | Line | Data |
b965d173 |
1 | #!/usr/bin/perl -w |
2 | |
3 | BEGIN { |
4 | chdir 't' and @INC = '../lib' if $ENV{PERL_CORE}; |
5 | } |
6 | |
7 | use strict; |
8 | use lib 't/lib'; |
9 | |
10 | use Test::More tests => 19; |
11 | use File::Spec; |
12 | use TAP::Parser; |
13 | use TAP::Harness; |
14 | use App::Prove; |
15 | |
f7c69158 |
16 | my $test = File::Spec->catfile( |
17 | ( $ENV{PERL_CORE} ? 'lib' : 't' ), |
18 | 'sample-tests', 'echo' |
19 | ); |
b965d173 |
20 | |
21 | diag( "\n\n", bigness( join ' ', @ARGV ), "\n\n" ) if @ARGV; |
22 | |
23 | sub echo_ok { |
24 | my $options = shift; |
25 | my @args = @_; |
26 | my $parser = TAP::Parser->new( { %$options, test_args => \@args } ); |
27 | my @got = (); |
28 | while ( my $result = $parser->next ) { |
29 | push @got, $result; |
30 | } |
31 | my $plan = shift @got; |
32 | ok $plan->is_plan; |
33 | for (@got) { |
34 | is $_->description, shift(@args), |
35 | join( ', ', keys %$options ) . ": option passed OK"; |
36 | } |
37 | } |
38 | |
39 | for my $args ( [qw( yes no maybe )], [qw( 1 2 3 )] ) { |
40 | echo_ok( { source => $test }, @$args ); |
41 | echo_ok( { exec => [ $^X, $test ] }, @$args ); |
42 | } |
43 | |
44 | { |
45 | my $harness = TAP::Harness->new( |
46 | { verbosity => -9, test_args => [qw( magic hat brigade )] } ); |
47 | my $aggregate = $harness->runtests($test); |
48 | |
49 | is $aggregate->total, 3, "ran the right number of tests"; |
50 | is $aggregate->passed, 3, "and they passed"; |
51 | } |
52 | |
53 | package Test::Prove; |
54 | |
55 | use vars qw(@ISA); |
56 | @ISA = 'App::Prove'; |
57 | |
58 | sub _runtests { |
59 | my $self = shift; |
60 | push @{ $self->{_log} }, [@_]; |
61 | return; |
62 | } |
63 | |
64 | sub get_run_log { |
65 | my $self = shift; |
66 | return $self->{_log}; |
67 | } |
68 | |
69 | package main; |
70 | |
71 | { |
72 | my $app = Test::Prove->new; |
73 | |
74 | $app->process_args( '--norc', $test, '::', 'one', 'two', 'huh' ); |
75 | $app->run(); |
76 | my $log = $app->get_run_log; |
77 | is_deeply $log->[0]->[0]->{test_args}, [ 'one', 'two', 'huh' ], |
78 | "prove args match"; |
79 | } |
80 | |
81 | sub bigness { |
82 | my $str = join '', @_; |
83 | my @cdef = ( |
84 | '0000000000000000', '1818181818001800', '6c6c6c0000000000', |
85 | '36367f367f363600', '0c3f683e0b7e1800', '60660c1830660600', |
86 | '386c6c386d663b00', '0c18300000000000', '0c18303030180c00', |
87 | '30180c0c0c183000', '00187e3c7e180000', '0018187e18180000', |
88 | '0000000000181830', '0000007e00000000', '0000000000181800', |
89 | '00060c1830600000', '3c666e7e76663c00', '1838181818187e00', |
90 | '3c66060c18307e00', '3c66061c06663c00', '0c1c3c6c7e0c0c00', |
91 | '7e607c0606663c00', '1c30607c66663c00', '7e060c1830303000', |
92 | '3c66663c66663c00', '3c66663e060c3800', '0000181800181800', |
93 | '0000181800181830', '0c18306030180c00', '00007e007e000000', |
94 | '30180c060c183000', '3c660c1818001800', '3c666e6a6e603c00', |
95 | '3c66667e66666600', '7c66667c66667c00', '3c66606060663c00', |
96 | '786c6666666c7800', '7e60607c60607e00', '7e60607c60606000', |
97 | '3c66606e66663c00', '6666667e66666600', '7e18181818187e00', |
98 | '3e0c0c0c0c6c3800', '666c7870786c6600', '6060606060607e00', |
99 | '63777f6b6b636300', '6666767e6e666600', '3c66666666663c00', |
100 | '7c66667c60606000', '3c6666666a6c3600', '7c66667c6c666600', |
101 | '3c66603c06663c00', '7e18181818181800', '6666666666663c00', |
102 | '66666666663c1800', '63636b6b7f776300', '66663c183c666600', |
103 | '6666663c18181800', '7e060c1830607e00', '7c60606060607c00', |
104 | '006030180c060000', '3e06060606063e00', '183c664200000000', |
105 | '00000000000000ff', '1c36307c30307e00', '00003c063e663e00', |
106 | '60607c6666667c00', '00003c6660663c00', '06063e6666663e00', |
107 | '00003c667e603c00', '1c30307c30303000', '00003e66663e063c', |
108 | '60607c6666666600', '1800381818183c00', '1800381818181870', |
109 | '6060666c786c6600', '3818181818183c00', '0000367f6b6b6300', |
110 | '00007c6666666600', '00003c6666663c00', '00007c66667c6060', |
111 | '00003e66663e0607', '00006c7660606000', '00003e603c067c00', |
112 | '30307c3030301c00', '0000666666663e00', '00006666663c1800', |
113 | '0000636b6b7f3600', '0000663c183c6600', '00006666663e063c', |
114 | '00007e0c18307e00', '0c18187018180c00', '1818180018181800', |
115 | '3018180e18183000', '316b460000000000' |
116 | ); |
117 | my @chars = unpack( 'C*', $str ); |
118 | my @out = (); |
119 | for my $row ( 0 .. 7 ) { |
120 | for my $char (@chars) { |
121 | next if $char < 32 || $char > 126; |
122 | my $size = scalar(@cdef); |
123 | my $byte = hex( substr( $cdef[ $char - 32 ], $row * 2, 2 ) ); |
124 | my $bits = sprintf( '%08b', $byte ); |
125 | $bits =~ tr/01/ #/; |
126 | push @out, $bits; |
127 | } |
128 | push @out, "\n"; |
129 | } |
130 | return join '', @out; |
131 | } |