git.maemo.org Git - dh-make-perl/blob - dev/i386/libtest-harness-perl/libtest-harness-perl-3.12/t/unicode.t

   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 {
  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
 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 }