1#!/usr/bin/perl -w
2
3use strict;
4use warnings;
5use lib 't/lib';
6use Test::More;
7use TAP::Parser;
8
9my @schedule;
10my %make_test;
11
12BEGIN {
13
14    # TODO: Investigate failure on 5.8.0
15    plan skip_all => "unicode on Perl <= 5.8.0"
16      unless $] > 5.008;
17
18    plan skip_all => "PERL_UNICODE set"
19      if defined $ENV{PERL_UNICODE};
20
21    eval "use File::Temp";
22    plan skip_all => "File::Temp unavailable"
23      if $@;
24
25    eval "use Encode";
26    plan skip_all => "Encode unavailable"
27      if $@;
28
29    # Subs that take the supplied TAP and turn it into a set of args to
30    # supply to TAP::Harness->new. The returned hash includes the
31    # temporary file so that its reference count doesn't go to zero
32    # until we're finished with it.
33    %make_test = (
34        file => sub {
35            my $source = shift;
36            my $tmp    = File::Temp->new;
37            open my $fh, ">$tmp" or die "Can't write $tmp ($!)\n";
38            eval 'binmode( $fh, ":utf8" )';
39            print $fh join( "\n", @$source ), "\n";
40            close $fh;
41
42            open my $taph, "<$tmp" or die "Can't read $tmp ($!)\n";
43            eval 'binmode( $taph, ":utf8" )';
44            return {
45                temp => $tmp,
46                args => { source => $taph },
47            };
48        },
49        script => sub {
50            my $source = shift;
51            my $tmp    = File::Temp->new;
52            open my $fh, ">$tmp" or die "Can't write $tmp ($!)\n";
53            eval 'binmode( $fh, ":utf8" )';
54            print $fh map {"print qq{$_\\n};\n"} @$source;
55            close $fh;
56
57            open my $taph, "<$tmp" or die "Can't read $tmp ($!)\n";
58            return {
59                temp => $tmp,
60                args => { exec => [ $^X, "$tmp" ] },
61            };
62        },
63    );
64
65    @schedule = (
66        {   name   => 'Non-unicode warm up',
67            source => [
68                'TAP version 13',
69                '1..1',
70                'ok 1 Everything is fine',
71            ],
72            expect => [
73                { isa => 'TAP::Parser::Result::Version', },
74                { isa => 'TAP::Parser::Result::Plan', },
75                {   isa         => 'TAP::Parser::Result::Test',
76                    description => "Everything is fine"
77                },
78            ],
79        },
80        {   name   => 'Unicode smiley',
81            source => [
82                'TAP version 13',
83                '1..1',
84
85                # Funky quoting / eval to avoid errors on older Perls
86                eval qq{"ok 1 Everything is fine \\x{263a}"},
87            ],
88            expect => [
89                { isa => 'TAP::Parser::Result::Version', },
90                { isa => 'TAP::Parser::Result::Plan', },
91                {   isa         => 'TAP::Parser::Result::Test',
92                    description => eval qq{"Everything is fine \\x{263a}"}
93                },
94            ],
95        }
96    );
97
98    plan 'no_plan';
99}
100
101for my $test (@schedule) {
102    for my $type ( sort keys %make_test ) {
103        my $name = sprintf( "%s (%s)", $test->{name}, $type );
104        my $args = $make_test{$type}->( $test->{source} );
105
106        my $parser = TAP::Parser->new( $args->{args} );
107        isa_ok $parser, 'TAP::Parser';
108        my @expect = @{ $test->{expect} };
109        while ( my $tok = $parser->next ) {
110            my $exp = shift @expect;
111            for my $item ( sort keys %$exp ) {
112                my $val = $exp->{$item};
113                if ( 'isa' eq $item ) {
114                    isa_ok $tok, $val;
115                }
116                elsif ( 'CODE' eq ref $val ) {
117                    ok $val->($tok), "$name: assertion for $item";
118                }
119                else {
120                    my $got = $tok->$item();
121                    is $got, $val, "$name: value for $item matches";
122                }
123            }
124        }
125    }
126}
127