xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test-Harness/t/unicode.t (revision d13be5d47e4149db2549a9828e244d59dbc43f15) 
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
13    # TODO: Investigate failure on 5.8.0
14    plan skip_all => "unicode on Perl <= 5.8.0"
15      unless $] > 5.008;
16
17    plan skip_all => "PERL_UNICODE set"
18      if defined $ENV{PERL_UNICODE};
19
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
100for 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}
126