Update to Test-Simple Alpha 068 blead
authorChad Granum <chad.granum@dreamhost.com>
Thu, 30 Oct 2014 22:31:35 +0000 (15:31 -0700)
committerJames E Keenan <jkeenan@cpan.org>
Thu, 30 Oct 2014 23:42:32 +0000 (19:42 -0400)
 * performance enhancements
 * bug fixes
 * comaptability improvements

24 files changed:
MANIFEST
cpan/Test-Simple/lib/Test/Builder.pm
cpan/Test-Simple/lib/Test/Builder/Module.pm
cpan/Test-Simple/lib/Test/Builder/Tester.pm
cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm
cpan/Test-Simple/lib/Test/More.pm
cpan/Test-Simple/lib/Test/Simple.pm
cpan/Test-Simple/lib/Test/Stream.pm
cpan/Test-Simple/lib/Test/Stream/ArrayBase.pm
cpan/Test-Simple/lib/Test/Stream/ArrayBase/Meta.pm
cpan/Test-Simple/lib/Test/Stream/Event/Subtest.pm
cpan/Test-Simple/lib/Test/Stream/Exporter.pm
cpan/Test-Simple/lib/Test/Stream/Exporter/Meta.pm
cpan/Test-Simple/lib/Test/Tester.pm
cpan/Test-Simple/lib/Test/use/ok.pm
cpan/Test-Simple/lib/ok.pm
cpan/Test-Simple/t/Behavior/skip_all_in_subtest.load [new file with mode: 0644]
cpan/Test-Simple/t/Behavior/skip_all_in_subtest.t [new file with mode: 0644]
cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t
cpan/Test-Simple/t/Legacy/fork.t
cpan/Test-Simple/t/Legacy/fork_in_subtest.t
cpan/Test-Simple/t/Legacy/skip.t
cpan/Test-Simple/t/Legacy/subtest/fork.t
cpan/Test-Simple/t/Test-Stream-Carp.t

index 3f188a9..1c2467b 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2306,6 +2306,8 @@ cpan/Test-Simple/t/Behavior/MonkeyPatching_ok.t                   Test::Simple Test
 cpan/Test-Simple/t/Behavior/MonkeyPatching_plan.t                      Test::Simple Test
 cpan/Test-Simple/t/Behavior/Munge.t                    Test::Simple Test
 cpan/Test-Simple/t/Behavior/NotTB15.t                  Test::Simple Test
+cpan/Test-Simple/t/Behavior/skip_all_in_subtest.load                   Test::Simple Test
+cpan/Test-Simple/t/Behavior/skip_all_in_subtest.t                      Test::Simple Test
 cpan/Test-Simple/t/Behavior/Tester2_subtest.t                  Test::Simple Test
 cpan/Test-Simple/t/Behavior/threads_with_taint_mode.t                  Test::Simple Test
 cpan/Test-Simple/t/Behavior/todo.t                     Test::Simple Test
index 54e392d..5cc66c2 100644 (file)
@@ -4,7 +4,7 @@ use 5.008001;
 use strict;
 use warnings;
 
-our $VERSION = '1.301001_065';
+our $VERSION = '1.301001_068';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 use Test::More::Tools;
@@ -13,12 +13,15 @@ use Test::Stream qw/ -internal STATE_LEGACY STATE_PLAN STATE_COUNT /;
 use Test::Stream::Toolset;
 use Test::Stream::Context;
 use Test::Stream::Carp qw/confess/;
+use Test::Stream::Meta qw/MODERN/;
 
 use Test::Stream::Util qw/try protect unoverload_str is_regex/;
 use Scalar::Util qw/blessed reftype/;
 
 BEGIN {
-    Test::Stream->shared->set_use_legacy(1);
+    my $meta = Test::Stream::Meta->is_tester('main');
+    Test::Stream->shared->set_use_legacy(1)
+        unless $meta && $meta->[MODERN];
 }
 
 # The mostly-singleton, and other package vars.
index d7936da..6705348 100644 (file)
@@ -7,7 +7,7 @@ use Test::Builder 0.99;
 require Exporter;
 our @ISA = qw(Exporter);
 
-our $VERSION = '1.301001_065';
+our $VERSION = '1.301001_068';
 $VERSION = eval $VERSION;      ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 
index ae98639..df4788f 100644 (file)
@@ -1,7 +1,7 @@
 package Test::Builder::Tester;
 
 use strict;
-our $VERSION = '1.301001_065';
+our $VERSION = '1.301001_068';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 use Test::Builder 1.301001;
index c205551..fdbcf2d 100644 (file)
@@ -1,7 +1,7 @@
 package Test::Builder::Tester::Color;
 
 use strict;
-our $VERSION = '1.301001_065';
+our $VERSION = '1.301001_068';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 require Test::Builder::Tester;
index 5aea2de..70e8e98 100644 (file)
@@ -4,7 +4,7 @@ use 5.008001;
 use strict;
 use warnings;
 
-our $VERSION = '1.301001_065';
+our $VERSION = '1.301001_068';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 use Test::Stream::Carp qw/croak carp/;
@@ -16,7 +16,8 @@ use Test::More::DeepCheck::Strict;
 use Test::Stream '-internal';
 use Test::Stream::Util qw/protect try spoof/;
 use Test::Stream::Toolset;
-use Test::Stream::Meta qw/MODERN/;
+
+use Test::Builder;
 
 use Test::Stream::Exporter;
 our $TODO;
@@ -50,10 +51,7 @@ Test::Stream::Exporter->cleanup;
     $Test::Builder::Level ||= 1;
 }
 
-sub builder {
-    protect { require Test::Builder };
-    return Test::Builder->new;
-}
+sub builder { Test::Builder->new }
 
 sub before_import {
     my $class = shift;
@@ -61,8 +59,6 @@ sub before_import {
 
     my $meta = init_tester($importer);
 
-    protect {require Test::Builder} unless $meta->[MODERN];
-
     my $context = context(1);
     my $other   = [];
     my $idx     = 0;
index 59c7a28..b26ffd7 100644 (file)
@@ -5,7 +5,7 @@ use 5.008001;
 use strict;
 use warnings;
 
-our $VERSION = '1.301001_065';
+our $VERSION = '1.301001_068';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 use Test::Stream '-internal';
index ac9eaf3..fb616f0 100644 (file)
@@ -2,7 +2,7 @@ package Test::Stream;
 use strict;
 use warnings;
 
-our $VERSION = '1.301001_065';
+our $VERSION = '1.301001_068';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 use Test::Stream::Threads;
@@ -10,14 +10,13 @@ use Test::Stream::IOSets;
 use Test::Stream::Util qw/try/;
 use Test::Stream::Carp qw/croak confess carp/;
 use Test::Stream::Meta qw/MODERN ENCODING init_tester/;
-use Encode();
 
 use Test::Stream::ArrayBase(
     accessors => [qw{
         no_ending no_diag no_header
         pid tid
         state
-        subtests subtest_todo
+        subtests subtest_todo subtest_exception
         subtest_tap_instant
         subtest_tap_delayed
         mungers
@@ -33,28 +32,30 @@ use Test::Stream::ArrayBase(
     }],
 );
 
-use constant STATE_COUNT   => 0;
-use constant STATE_FAILED  => 1;
-use constant STATE_PLAN    => 2;
-use constant STATE_PASSING => 3;
-use constant STATE_LEGACY  => 4;
-use constant STATE_ENDED   => 5;
+sub STATE_COUNT()   { 0 }
+sub STATE_FAILED()  { 1 }
+sub STATE_PLAN()    { 2 }
+sub STATE_PASSING() { 3 }
+sub STATE_LEGACY()  { 4 }
+sub STATE_ENDED()   { 5 }
 
-use constant OUT_STD  => 0;
-use constant OUT_ERR  => 1;
-use constant OUT_TODO => 2;
+sub OUT_STD()  { 0 }
+sub OUT_ERR()  { 1 }
+sub OUT_TODO() { 2 }
 
 use Test::Stream::Exporter;
 exports qw/
     OUT_STD OUT_ERR OUT_TODO
     STATE_COUNT STATE_FAILED STATE_PLAN STATE_PASSING STATE_LEGACY STATE_ENDED
 /;
-
 default_exports qw/ cull tap_encoding /;
+Test::Stream::Exporter->cleanup;
 
 sub tap_encoding {
     my ($encoding) = @_;
 
+    require Encode;
+
     croak "encoding '$encoding' is not valid, or not available"
         unless $encoding eq 'legacy' || Encode::find_encoding($encoding);
 
@@ -72,7 +73,6 @@ sub cull {
     $ctx->stream->fork_cull();
 }
 
-Test::Stream::Exporter->cleanup;
 sub before_import {
     my $class = shift;
     my ($importer, $list) = @_;
@@ -89,8 +89,6 @@ sub before_import {
     my $idx    = 0;
     my $stream = $class->shared;
 
-    $stream->use_fork;
-
     while ($idx <= $#{$list}) {
         my $item = $list->[$idx++];
         next unless $item;
@@ -130,6 +128,9 @@ sub before_import {
             $stream->io_sets->init_encoding($encoding);
             $meta->[ENCODING] = $encoding;
         }
+        elsif ($item eq 'enable_fork') {
+            $stream->use_fork;
+        }
         else {
             push @$other => $item;
         }
@@ -431,6 +432,7 @@ sub send {
             push @{$self->[STATE]} => [0, 0, undef, 1];
             push @{$self->[SUBTESTS]} => [];
             push @{$self->[SUBTEST_TODO]} => $e->context->in_todo;
+            push @{$self->[SUBTEST_EXCEPTION]} => undef;
 
             return $e;
         }
@@ -441,11 +443,12 @@ sub send {
             confess "Child pop left the stream without a state!" unless @{$self->[STATE]};
 
             $e = Test::Stream::Event::Subtest->new_from_pairs(
-                context => $e->context,
-                created => $e->created,
-                events  => $events,
-                state   => $state,
-                name    => $e->name,
+                context   => $e->context,
+                created   => $e->created,
+                events    => $events,
+                state     => $state,
+                name      => $e->name,
+                exception => pop @{$self->[SUBTEST_EXCEPTION]},
             );
         }
     }
@@ -581,12 +584,18 @@ sub _finalize_event {
         $cache->{state}->[STATE_PLAN] = $e;
         return unless $e->directive;
         return unless $e->directive eq 'SKIP';
+
+        $self->[SUBTEST_EXCEPTION]->[-1] = $e if $e->in_subtest;
+
         die $e if $e->in_subtest || !$self->[EXIT_ON_DISRUPTION];
         exit 0;
     }
     elsif (!$cache->{do_tap} && $e->isa('Test::Stream::Event::Bail')) {
         $self->[BAILED_OUT] = $e;
         $self->[NO_ENDING]  = 1;
+
+        $self->[SUBTEST_EXCEPTION]->[-1] = $e if $e->in_subtest;
+
         die $e if $e->in_subtest || !$self->[EXIT_ON_DISRUPTION];
         exit 255;
     }
@@ -680,10 +689,9 @@ Test::Stream - A modern infrastructure for testing.
 
 =head1 FEATURES
 
-When you load Test::Stream inside your test file you activate forking support,
-and prevent Test::More from turning on some expensive legacy support. You will
-also get warnings if your code, or any other code you load uses deprecated or
-discouraged practices.
+When you load Test::Stream inside your test file you prevent Test::More from
+turning on some expensive legacy support. You will also get warnings if your
+code, or any other code you load uses deprecated or discouraged practices.
 
 =head1 IMPORT ARGUMENTS
 
@@ -715,6 +723,12 @@ Show events within subtest AFTER the subtest event itself is complete.
 
 Show events as they happen, then also display them after.
 
+=item 'enable_fork'
+
+Turns on support for code that forks. This is nto activated by default because
+it adds ~30ms to the Test::More compile-time, which can really add up in large
+test suites. Turn it on only when needed.
+
 =item 'utf8'
 
 Set the TAP encoding to utf8
index 967a070..1be5569 100644 (file)
@@ -52,11 +52,8 @@ sub apply_to {
         $ab_meta->baseclass();
     }
 
-    if ($args{accessors}) {
-        $ab_meta->add_accessor($_) for @{$args{accessors}};
-    }
-
-    1;
+    $ab_meta->add_accessors(@{$args{accessors}})
+        if $args{accessors};
 }
 
 sub new {
index 0a1eca5..a283afd 100644 (file)
@@ -60,36 +60,61 @@ sub subclass {
     }
 }
 
-sub add_accessor {
+my $IDX = -1;
+my (@CONST, @GET, @SET);
+_GROW(20);
+
+sub _GROW {
+    my ($max) = @_;
+    return if $max <= $IDX;
+    for (($IDX + 1) .. $max) {
+        # Var per sub for inlining/constant stuff.
+        my $c  = $_;
+        my $gi = $_;
+        my $si = $_;
+
+        $CONST[$_] = sub() { $c };
+        $GET[$_]   = sub   { $_[0]->[$gi] };
+        $SET[$_]   = sub { $_[0]->[$si] = $_[1] };
+    }
+    $IDX = $max;
+}
+
+*add_accessor = \&add_accessors;
+sub add_accessors {
     my $self = shift;
-    my ($name) = @_;
 
     confess "Cannot add accessor, metadata is locked due to a subclass being initialized ($self->{parent}).\n"
         if $self->{locked};
 
-    confess "field '$name' already defined!"
-        if exists $self->{fields}->{$name};
+    my $ex_meta = Test::Stream::Exporter::Meta->get($self->{package});
 
-    my $idx = $self->{index}++;
-    $self->{fields}->{$name} = $idx;
+    for my $name (@_) {
+        confess "field '$name' already defined!"
+            if exists $self->{fields}->{$name};
 
-    my $const = uc $name;
-    my $gname = lc $name;
-    my $sname = "set_$gname";
+        my $idx = $self->{index}++;
+        $self->{fields}->{$name} = $idx;
 
-    eval qq|
-        package $self->{package};
-        sub $gname { \$_[0]->[$idx] }
-        sub $sname { \$_[0]->[$idx] = \$_[1] }
-        sub $const() { $idx }
-        1
-    | || confess $@;
+        _GROW($IDX + 10) if $idx > $IDX;
 
-    # Add the constant as an optional export
-    my $ex_meta = Test::Stream::Exporter::Meta->get($self->{package});
-    $ex_meta->add($const);
+        my $const = uc $name;
+        my $gname = lc $name;
+        my $sname = "set_$gname";
+
+        {
+            no strict 'refs';
+            *{"$self->{package}\::$const"} = $CONST[$idx];
+            *{"$self->{package}\::$gname"} = $GET[$idx];
+            *{"$self->{package}\::$sname"} = $SET[$idx];
+        }
+
+        $ex_meta->{exports}->{$const} = $CONST[$idx];
+        push @{$ex_meta->{polist}} => $const;
+    }
 }
 
+
 1;
 
 __END__
index 57d1cbf..ec54743 100644 (file)
@@ -17,7 +17,7 @@ sub init {
     $self->[REAL_BOOL] = $self->[STATE]->[STATE_PASSING] && $self->[STATE]->[STATE_COUNT];
     $self->[EVENTS] ||= [];
 
-    if (my $le = $self->[EVENTS]->[-1]) {
+    if (my $le = $self->[EXCEPTION]) {
         my $is_skip = $le->isa('Test::Stream::Event::Plan');
         $is_skip &&= $le->directive;
         $is_skip &&= $le->directive eq 'SKIP';
@@ -28,8 +28,6 @@ sub init {
             $self->[CONTEXT]->set_skip($skip);
             $self->[REAL_BOOL] = 1;
         }
-
-        $self->[EXCEPTION] = $le if $is_skip || $le->isa('Test::Stream::Event::Bail');
     }
 
     push @{$self->[DIAG]} => '  No tests run for subtest.'
index 0f70a55..9de74e9 100644 (file)
@@ -47,13 +47,14 @@ sub export_to {
     my $class = shift;
     my ($dest, @imports) = @_;
 
-    my $meta = export_meta($class)
+    my $meta = Test::Stream::Exporter::Meta->get($class)
         || confess "$class is not an exporter!?";
 
     my (@include, %exclude);
     for my $import (@imports) {
-        if ($import =~ m/^!(.*)$/) {
-            $exclude{$1}++;
+        if (substr($import, 0, 1) eq '!') {
+            $import =~ s/^!//g;
+            $exclude{$import}++;
         }
         else {
             push @include => $import;
@@ -62,10 +63,11 @@ sub export_to {
 
     @include = $meta->default unless @include;
 
+    my $exports = $meta->exports;
     for my $name (@include) {
         next if $exclude{$name};
 
-        my $ref = $meta->exports->{$name}
+        my $ref = $exports->{$name}
             || croak "$class does not export $name";
 
         no strict 'refs';
@@ -95,7 +97,7 @@ sub exports {
     my $meta = export_meta($caller) ||
         confess "$caller is not an exporter!?";
 
-    $meta->add($_) for @_;
+    $meta->add_bulk(@_);
 }
 
 sub default_export {
@@ -114,7 +116,7 @@ sub default_exports {
     my $meta = export_meta($caller) ||
         confess "$caller is not an exporter!?";
 
-    $meta->add_default($_) for @_;
+    $meta->add_default_bulk(@_);
 }
 
 1;
index fc055be..e3de004 100644 (file)
@@ -40,6 +40,39 @@ sub add_default {
     $self->{default}->{$name} = 1;
 }
 
+sub add_bulk {
+    my $self = shift;
+    for my $name (@_) {
+        confess "$name is already exported"
+            if $self->exports->{$name};
+
+        my $ref = package_sym($self->{package}, CODE => $name)
+            || confess "No reference or package sub found for '$name' in '$self->{package}'";
+
+        $self->{exports}->{$name} = $ref;
+    }
+
+    push @{$self->{polist}} => @_;
+}
+
+sub add_default_bulk {
+    my $self = shift;
+
+    for my $name (@_) {
+        confess "$name is already exported"
+            if $self->exports->{$name};
+
+        my $ref = package_sym($self->{package}, CODE => $name)
+            || confess "No reference or package sub found for '$name' in '$self->{package}'";
+
+        $self->{exports}->{$name} = $ref;
+        $self->{default}->{$name} = 1;
+    }
+
+    push @{$self->{polist}} => @_;
+    push @{$self->{pdlist}} => @_;
+}
+
 my %EXPORT_META;
 
 sub new {
index 62a9001..6f0edad 100644 (file)
@@ -15,7 +15,7 @@ require Exporter;
 
 use vars qw( @ISA @EXPORT $VERSION );
 
-our $VERSION = '1.301001_065';
+our $VERSION = '1.301001_068';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 @EXPORT  = qw( run_tests check_tests check_test cmp_results show_space );
index 26417bb..a5b4aab 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use 5.005;
 
-our $VERSION = '1.301001_065';
+our $VERSION = '1.301001_068';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 1;
index a8c8dc4..927b006 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 use Test::More 1.301001 ();
 use Test::Stream::Carp qw/croak/;
 
-our $VERSION = '1.301001_065';
+our $VERSION = '1.301001_068';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 sub import {
diff --git a/cpan/Test-Simple/t/Behavior/skip_all_in_subtest.load b/cpan/Test-Simple/t/Behavior/skip_all_in_subtest.load
new file mode 100644 (file)
index 0000000..241ce14
--- /dev/null
@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Carp qw/confess/;
+
+use Test::More skip_all => "Cause I feel like it";
+
+confess "Should not see this!";
diff --git a/cpan/Test-Simple/t/Behavior/skip_all_in_subtest.t b/cpan/Test-Simple/t/Behavior/skip_all_in_subtest.t
new file mode 100644 (file)
index 0000000..c66901a
--- /dev/null
@@ -0,0 +1,16 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+subtest my_subtest => sub {
+    my $file = __FILE__;
+    $file =~ s/\.t$/.load/;
+    do $file;
+    note "Got: $@";
+    fail($@);
+};
+
+done_testing;
index bcd7156..5e20d81 100644 (file)
@@ -16,6 +16,9 @@ my $Can_Fork = $Config{d_fork}
 if (!$Can_Fork) {
     $b->plan('skip_all' => "This system cannot fork");
 }
+elsif ($^O eq 'MSWin32' && $] == 5.010000) {
+    $b->plan('skip_all' => "5.10 has fork/threading issues that break fork on win32");
+}
 else {
     $b->plan('tests' => 2);
 }
index fd895b4..ad02824 100644 (file)
@@ -19,6 +19,9 @@ my $Can_Fork = $Config{d_fork} ||
 if( !$Can_Fork ) {
     plan skip_all => "This system cannot fork";
 }
+elsif ($^O eq 'MSWin32' && $] == 5.010000) {
+    plan 'skip_all' => "5.10 has fork/threading issues that break fork on win32";
+}
 else {
     plan tests => 1;
 }
index 3ed851a..b89cc5c 100644 (file)
@@ -10,14 +10,19 @@ BEGIN {
                     $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
                    );
 
-    unless( $Can_Fork ) {
+    if( !$Can_Fork ) {
         require Test::More;
         Test::More::plan(skip_all => "This system cannot fork");
         exit 0;
     }
+    elsif ($^O eq 'MSWin32' && $] == 5.010000) {
+        require Test::More;
+        Test::More::plan('skip_all' => "5.10 has fork/threading issues that break fork on win32");
+        exit 0;
+    }
 }
 
-use Test::Stream;
+use Test::Stream 'enable_fork';
 use Test::More;
 # This just goes to show how silly forking inside a subtest would actually
 # be....
index 6a0612a..18d5541 100644 (file)
@@ -7,15 +7,16 @@ BEGIN {
     }
 }
 
-use Test::More tests => 16;
-
 BEGIN {
     require warnings;
     if( eval "warnings->can('carp')" ) {
-        plan skip_all => 'Modern::Open is installed, which breaks this test';
+        require Test::More;
+        Test::More::plan( skip_all => 'Modern::Open is installed, which breaks this test' );
     }
 }
 
+use Test::More tests => 16;
+
 # If we skip with the same name, Test::Harness will report it back and
 # we won't get lots of false bug reports.
 my $Why = "Just testing the skip interface.";
index 0191e78..76e9493 100644 (file)
@@ -15,6 +15,9 @@ my $Can_Fork = $Config{d_fork} ||
 if( !$Can_Fork ) {
     plan 'skip_all' => "This system cannot fork";
 }
+elsif ($^O eq 'MSWin32' && $] == 5.010000) {
+    plan 'skip_all' => "5.10 has fork/threading issues that break fork on win32";
+}
 else {
     plan 'tests' => 1;
 }
index e599cb4..037d23f 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 BEGIN {
     require Test::Stream::Threads;
     if ($INC{'Carp.pm'}) {
-        print "1..0 # Carp is already loaded before we even begin.\n";
+        print "1..0 # SKIP: Carp is already loaded before we even begin.\n";
         exit 0;
     }
 }