13 # TODO: Investigate failure on 5.8.0
14 plan skip_all => "unicode on Perl <= 5.8.0"
17 plan skip_all => "PERL_UNICODE set"
18 if defined $ENV{PERL_UNICODE};
20 eval "use File::Temp";
21 plan skip_all => "File::Temp unavailable"
25 plan skip_all => "Encode unavailable"
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.
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";
41 open my $taph, "<$tmp" or die "Can't read $tmp ($!)\n";
42 eval 'binmode( $taph, ":utf8" )';
45 args => { source => $taph },
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;
56 open my $taph, "<$tmp" or die "Can't read $tmp ($!)\n";
59 args => { exec => [ $^X, "$tmp" ] },
65 { name => 'Non-unicode warm up',
69 'ok 1 Everything is fine',
72 { isa => 'TAP::Parser::Result::Version', },
73 { isa => 'TAP::Parser::Result::Plan', },
74 { isa => 'TAP::Parser::Result::Test',
75 description => "Everything is fine"
79 { name => 'Unicode smiley',
84 # Funky quoting / eval to avoid errors on older Perls
85 eval qq{"ok 1 Everything is fine \\x{263a}"},
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}"}
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} );
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 ) {
115 elsif ( 'CODE' eq ref $val ) {
116 ok $val->($tok), "$name: assertion for $item";
119 my $got = $tok->$item();
120 is $got, $val, "$name: value for $item matches";