Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
compat	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
data	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
lib	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
proverc	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
sample-tests	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
source_tests	[ DIR ]	drwxr-xr-x	2016-10-10 18:24
subclass_tests	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
aggregator.t	9.35 KB	-r--r--r--	2014-12-27 11:48
bailout.t	3.12 KB	-r--r--r--	2014-12-27 11:48
base.t	4.68 KB	-r--r--r--	2014-12-27 11:48
callbacks.t	2.57 KB	-r--r--r--	2014-12-27 11:48
console.t	1.06 KB	-r--r--r--	2014-12-27 11:48
errors.t	4.64 KB	-r--r--r--	2014-12-27 11:48
file.t	13.61 KB	-r--r--r--	2014-12-27 11:48
glob-to-regexp.t	988 B	-r--r--r--	2014-12-27 11:48
grammar.t	11.55 KB	-r--r--r--	2014-12-27 11:48
harness-bailout.t	1.19 KB	-r--r--r--	2014-12-27 11:48
harness-subclass.t	1.58 KB	-r--r--r--	2014-12-27 11:48
harness.t	28.38 KB	-r--r--r--	2014-12-27 11:48
iterator_factory.t	4.8 KB	-r--r--r--	2014-12-27 11:48
iterators.t	5.68 KB	-r--r--r--	2014-12-27 11:48
multiplexer.t	4.53 KB	-r--r--r--	2014-12-27 11:48
nested.t	860 B	-r--r--r--	2014-12-27 11:48
nofork-mux.t	119 B	-r--r--r--	2014-12-27 11:48
nofork.t	1.55 KB	-r--r--r--	2014-12-27 11:48
object.t	772 B	-r--r--r--	2014-12-27 11:48
parse.t	30.97 KB	-r--r--r--	2014-12-27 11:48
parser-config.t	731 B	-r--r--r--	2014-12-27 11:48
parser-subclass.t	2.2 KB	-r--r--r--	2014-12-27 11:48
perl5lib.t	1.13 KB	-r--r--r--	2014-12-27 11:48
premature-bailout.t	2.32 KB	-r--r--r--	2014-12-27 11:48
process.t	1015 B	-r--r--r--	2014-12-27 11:48
prove.t	47.6 KB	-r--r--r--	2014-12-27 11:49
proveenv.t	338 B	-r--r--r--	2014-12-27 11:49
proverc.t	472 B	-r--r--r--	2014-12-27 11:48
proverun.t	4.14 KB	-r--r--r--	2014-12-27 11:48
proveversion.t	763 B	-r--r--r--	2014-12-27 11:48
regression.t	111.62 KB	-r--r--r--	2014-12-27 11:48
results.t	7.68 KB	-r--r--r--	2014-12-27 11:48
scheduler.t	5.33 KB	-r--r--r--	2014-12-27 11:48
source.t	8.21 KB	-r--r--r--	2014-12-27 11:48
source_handler.t	12.32 KB	-r--r--r--	2014-12-27 11:48
spool.t	3.12 KB	-r--r--r--	2014-12-27 11:48
state.t	7.7 KB	-r--r--r--	2014-12-27 11:48
state_results.t	4.95 KB	-r--r--r--	2014-12-27 11:48
streams.t	6.33 KB	-r--r--r--	2014-12-27 11:48
taint.t	1.3 KB	-r--r--r--	2014-12-27 11:49
testargs.t	4.95 KB	-r--r--r--	2014-12-27 11:48
unicode.t	3.73 KB	-r--r--r--	2014-12-27 11:48
yamlish-output.t	2.44 KB	-r--r--r--	2014-12-27 11:48
yamlish-writer.t	7.17 KB	-r--r--r--	2014-12-27 11:48
yamlish.t	15.01 KB	-r--r--r--	2014-12-27 11:48

Rename

#!/usr/bin/perl -w

use strict;
use warnings;
use lib 't/lib';
use Test::More;
use TAP::Parser;

my @schedule;
my %make_test;

BEGIN {

# TODO: Investigate failure on 5.8.0
    plan skip_all => "unicode on Perl <= 5.8.0"
      unless $] > 5.008;

plan skip_all => "PERL_UNICODE set"
      if defined $ENV{PERL_UNICODE};

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";
                }
            }
        }
    }
}