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