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