1 files changed, 120 insertions, 0 deletions
diff --git a/lib/Test/Harness/t/unicode.t b/lib/Test/Harness/t/unicode.t
new file mode 100644
index 0000000000..837a053fcc
--- /dev/null
+++ b/lib/Test/Harness/t/unicode.t
@@ -0,0 +1,120 @@
+#!/usr/bin/perl -w
+
+use strict;
+use lib 't/lib';
+use Test::More;
+use TAP::Parser;
+
+my @schedule;
+my %make_test;
+
+BEGIN {
+    plan skip_all => "unicode on Perl < 5.8.0"
+      unless $] > 5.008;
+
+    eval "use File::Temp";
+    plan skip_all => "File::Temp unavailable"
+      if $@;
+
+    eval "use Encode";
+    plan skip_all => "Encode unavailable"
+      if $@;
+
+    # Subs that take the supplied TAP and turn it into a set of args to
+    # supply to TAP::Harness->new. The returned hash includes the
+    # temporary file so that its reference count doesn't go to zero
+    # until we're finished with it.
+    %make_test = (
+        file => sub {
+            my $source = shift;
+            my $tmp    = File::Temp->new;
+            open my $fh, ">$tmp" or die "Can't write $tmp ($!)\n";
+            eval 'binmode( $fh, ":utf8" )';
+            print $fh join( "\n", @$source ), "\n";
+            close $fh;
+
+            open my $taph, "<$tmp" or die "Can't read $tmp ($!)\n";
+            eval 'binmode( $taph, ":utf8" )';
+            return {
+                temp => $tmp,
+                args => { source => $taph },
+            };
+        },
+        script => sub {
+            my $source = shift;
+            my $tmp    = File::Temp->new;
+            open my $fh, ">$tmp" or die "Can't write $tmp ($!)\n";
+            eval 'binmode( $fh, ":utf8" )';
+            print $fh map {"print qq{$_\\n};\n"} @$source;
+            close $fh;
+
+            open my $taph, "<$tmp" or die "Can't read $tmp ($!)\n";
+            return {
+                temp => $tmp,
+                args => { exec => [ $^X, "$tmp" ] },
+            };
+        },
+    );
+
+    @schedule = (
+        {   name   => 'Non-unicode warm up',
+            source => [
+                'TAP version 13',
+                '1..1',
+                'ok 1 Everything is fine',
+            ],
+            expect => [
+                { isa => 'TAP::Parser::Result::Version', },
+                { isa => 'TAP::Parser::Result::Plan', },
+                {   isa         => 'TAP::Parser::Result::Test',
+                    description => "Everything is fine"
+                },
+            ],
+        },
+        {   name   => 'Unicode smiley',
+            source => [
+                'TAP version 13',
+                '1..1',
+
+                # Funky quoting / eval to avoid errors on older Perls
+                eval qq{"ok 1 Everything is fine \\x{263a}"},
+            ],
+            expect => [
+                { isa => 'TAP::Parser::Result::Version', },
+                { isa => 'TAP::Parser::Result::Plan', },
+                {   isa         => 'TAP::Parser::Result::Test',
+                    description => eval qq{"Everything is fine \\x{263a}"}
+                },
+            ],
+        }
+    );
+
+    plan 'no_plan';
+}
+
+for my $test (@schedule) {
+    for my $type ( sort keys %make_test ) {
+        my $name = sprintf( "%s (%s)", $test->{name}, $type );
+        my $args = $make_test{$type}->( $test->{source} );
+
+        my $parser = TAP::Parser->new( $args->{args} );
+        isa_ok $parser, 'TAP::Parser';
+        my @expect = @{ $test->{expect} };
+        while ( my $tok = $parser->next ) {
+            my $exp = shift @expect;
+            for my $item ( sort keys %$exp ) {
+                my $val = $exp->{$item};
+                if ( 'isa' eq $item ) {
+                    isa_ok $tok, $val;
+                }
+                elsif ( 'CODE' eq ref $val ) {
+                    ok $val->($tok), "$name: assertion for $item";
+                }
+                else {
+                    my $got = $tok->$item();
+                    is $got, $val, "$name: value for $item matches";
+                }
+            }
+        }
+    }
+}