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