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