1#!/usr/bin/perl -w
2
3use strict;
4use warnings;
5use lib 't/lib';
6
7use Test::More tests => 76;
8
9use File::Spec;
10use TAP::Parser;
11use TAP::Parser::Iterator::Array;
12use Config;
13
14sub array_ref_from {
15    my $string = shift;
16    my @lines = split /\n/ => $string;
17    return \@lines;
18}
19
20# we slurp __DATA__ and then reset it so we don't have to duplicate our TAP
21my $offset = tell DATA;
22my $tap = do { local $/; <DATA> };
23seek DATA, $offset, 0;
24
25my $did_setup    = 0;
26my $did_teardown = 0;
27
28my $setup    = sub { $did_setup++ };
29my $teardown = sub { $did_teardown++ };
30
31package NoForkProcess;
32use base qw( TAP::Parser::Iterator::Process );
33
34sub _use_open3 {return}
35
36package main;
37
38my @schedule = (
39    {   name     => 'Process',
40        subclass => 'TAP::Parser::Iterator::Process',
41        source   => {
42            command => [
43                $^X,
44                File::Spec->catfile(
45                    't',
46                    'sample-tests',
47                    'out_err_mix'
48                )
49            ],
50            merge    => 1,
51            setup    => $setup,
52            teardown => $teardown,
53        },
54        after => sub {
55            is $did_setup,    1, "setup called";
56            is $did_teardown, 1, "teardown called";
57        },
58        need_open3 => 15,
59    },
60    {   name     => 'Array',
61        subclass => 'TAP::Parser::Iterator::Array',
62        source   => array_ref_from($tap),
63    },
64    {   name     => 'Stream',
65        subclass => 'TAP::Parser::Iterator::Stream',
66        source   => \*DATA,
67    },
68    {   name     => 'Process (Perl -e)',
69        subclass => 'TAP::Parser::Iterator::Process',
70        source =>
71          { command => [ $^X, '-e', 'print qq/one\ntwo\n\nthree\n/' ] },
72    },
73    {   name     => 'Process (NoFork)',
74        subclass => 'TAP::Parser::Iterator::Process',
75        class    => 'NoForkProcess',
76        source =>
77          { command => [ $^X, '-e', 'print qq/one\ntwo\n\nthree\n/' ] },
78    },
79);
80
81sub _can_open3 {
82    return $Config{d_fork};
83}
84
85for my $test (@schedule) {
86    SKIP: {
87        my $name       = $test->{name};
88        my $need_open3 = $test->{need_open3};
89        skip "No open3", $need_open3 if $need_open3 && !_can_open3();
90        my $subclass = $test->{subclass};
91        my $source   = $test->{source};
92        my $class    = $test->{class};
93        my $iterator
94          = $class
95          ? $class->new($source)
96          : make_iterator($source);
97
98        ok $iterator,     "$name: We should be able to create a new iterator";
99        isa_ok $iterator, 'TAP::Parser::Iterator',
100          '... and the object it returns';
101        isa_ok $iterator, $subclass, '... and the object it returns';
102
103        can_ok $iterator, 'exit';
104        ok !defined $iterator->exit,
105          "$name: ... and it should be undef before we are done ($subclass)";
106
107        can_ok $iterator, 'next';
108        is $iterator->next, 'one',
109          "$name: next() should return the first result";
110
111        is $iterator->next, 'two',
112          "$name: next() should return the second result";
113
114        is $iterator->next, '',
115          "$name: next() should return the third result";
116
117        is $iterator->next, 'three',
118          "$name: next() should return the fourth result";
119
120        ok !defined $iterator->next,
121          "$name: next() should return undef after it is empty";
122
123        is $iterator->exit, 0,
124          "$name: ... and exit should now return 0 ($subclass)";
125
126        is $iterator->wait, 0,
127          "$name: wait should also now return 0 ($subclass)";
128
129        if ( my $after = $test->{after} ) {
130            $after->();
131        }
132    }
133}
134
135{
136
137    # coverage tests for the ctor
138
139    my $iterator = make_iterator( IO::Handle->new );
140
141    isa_ok $iterator, 'TAP::Parser::Iterator::Stream';
142
143    my @die;
144
145    eval {
146        local $SIG{__DIE__} = sub { push @die, @_ };
147        make_iterator( \1 );    # a ref to a scalar
148    };
149
150    is @die, 1, 'coverage of error case';
151
152    like pop @die, qr/Can't iterate with a SCALAR/,
153      '...and we died as expected';
154}
155
156{
157
158    # coverage test for VMS case
159
160    my $iterator = make_iterator(
161        [   'not ',
162            'ok 1 - I hate VMS',
163        ]
164    );
165
166    is $iterator->next, 'not ok 1 - I hate VMS',
167      'coverage of VMS line-splitting case';
168
169    # coverage test for VMS case - nothing after 'not'
170
171    $iterator = make_iterator(
172        [   'not ',
173        ]
174    );
175
176    is $iterator->next, 'not ', '...and we find "not" by itself';
177}
178
179SKIP: {
180    skip "No open3", 4 unless _can_open3();
181
182    # coverage testing for TAP::Parser::Iterator::Process ctor
183
184    my @die;
185
186    eval {
187        local $SIG{__DIE__} = sub { push @die, @_ };
188        make_iterator( {} );
189    };
190
191    is @die, 1, 'coverage testing for TPI::Process';
192
193    like pop @die, qr/Must supply a command to execute/,
194      '...and we died as expected';
195
196    my $parser = make_iterator(
197        {   command => [
198                $^X,
199                File::Spec->catfile( 't', 'sample-tests', 'out_err_mix' )
200            ],
201            merge => 1,
202        }
203    );
204
205    is $parser->{err}, '',    'confirm we set err to empty string';
206    is $parser->{sel}, undef, '...and selector to undef';
207
208    # And then we read from the parser to sidestep the Mac OS / open3
209    # bug which frequently throws an error here otherwise.
210    $parser->next;
211}
212
213sub make_iterator {
214    my $thing = shift;
215    my $ref   = ref $thing;
216    if ( $ref eq 'GLOB' || UNIVERSAL::isa( $ref, 'IO::Handle' ) ) {
217        return TAP::Parser::Iterator::Stream->new($thing);
218    }
219    elsif ( $ref eq 'ARRAY' ) {
220        return TAP::Parser::Iterator::Array->new($thing);
221    }
222    elsif ( $ref eq 'HASH' ) {
223        return TAP::Parser::Iterator::Process->new($thing);
224    }
225    else {
226        die "Can't iterate with a $ref";
227    }
228}
229
230__DATA__
231one
232two
233
234three
235