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