Upgrade to Test-Simple-0.78
authorSteve Peters <steve@fisharerojo.org>
Fri, 29 Feb 2008 04:39:18 +0000 (04:39 +0000)
committerSteve Peters <steve@fisharerojo.org>
Fri, 29 Feb 2008 04:39:18 +0000 (04:39 +0000)
p4raw-id: //depot/perl@33394

18 files changed:
MANIFEST
lib/Test/Builder.pm
lib/Test/Builder/Module.pm
lib/Test/Builder/Tester.pm
lib/Test/More.pm
lib/Test/Simple.pm
lib/Test/Simple/t/dont_overwrite_die_handler.t [new file with mode: 0644]
lib/Test/Simple/t/exit.t
lib/Test/Simple/t/filehandles.t
lib/Test/Simple/t/is_deeply_with_threads.t
lib/Test/Simple/t/maybe_regex.t
lib/Test/Simple/t/reset.t
lib/Test/Simple/t/tbm_doesnt_set_exported_to.t [new file with mode: 0644]
lib/Test/Simple/t/todo.t
lib/Test/Simple/t/utf8.t [new file with mode: 0644]
t/lib/Test/Simple/sample_tests/death.plx
t/lib/Test/Simple/sample_tests/death_with_handler.plx [new file with mode: 0644]
t/lib/Test/Simple/sample_tests/last_minute_death.plx

index 55db224..44df5db 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2708,6 +2708,7 @@ lib/Test/Simple/t/create.t        Test::Simple test
 lib/Test/Simple/t/curr_test.t  Test::Builder->curr_test tests
 lib/Test/Simple/t/details.t    Test::Builder tests
 lib/Test/Simple/t/diag.t       Test::More diag() test
+lib/Test/Simple/t/dont_overwrite_die_handler.t Test::More tests
 lib/Test/Simple/t/eq_set.t     Test::Simple test
 lib/Test/Simple/t/exit.t       Test::Simple test, exit codes
 lib/Test/Simple/t/extra_one.t  Test::Simple test
@@ -2751,6 +2752,7 @@ lib/Test/Simple/t/reset.t Test::Simple test
 lib/Test/Simple/t/simple.t     Test::Simple test, basic stuff
 lib/Test/Simple/t/skipall.t    Test::More test, skip all tests
 lib/Test/Simple/t/skip.t       Test::More test, SKIP tests
+lib/Test/Simple/t/tbm_doesnt_set_exported_to.t Test::Builder::Module test
 lib/Test/Simple/t/tbt_01basic.t        Test::Builder::Tester test
 lib/Test/Simple/t/tbt_02fhrestore.t    Test::Builder::Tester test
 lib/Test/Simple/t/tbt_03die.t  Test::Builder::Tester test
@@ -2765,6 +2767,7 @@ lib/Test/Simple/t/try.t           Test::More test
 lib/Test/Simple/t/undef.t      Test::More test, undefs don't cause warnings
 lib/Test/Simple/t/useing.t     Test::More test, compile test
 lib/Test/Simple/t/use_ok.t     Test::More test, use_ok()
+lib/Test/Simple/t/utf8.t       Test::More test
 lib/Test/t/05_about_verbose.t  See if Test works
 lib/Test/t/fail.t              See if Test works
 lib/Test/t/mix.t               See if Test works
@@ -3665,6 +3668,7 @@ t/lib/strict/subs         Tests of "use strict 'subs'" for strict.t
 t/lib/strict/vars              Tests of "use strict 'vars'" for strict.t
 t/lib/Test/Simple/Catch.pm     Utility module for testing Test::Simple
 t/lib/Test/Simple/sample_tests/death_in_eval.plx       for exit.t
+t/lib/Test/Simple/sample_tests/death_with_handler.plx  for exit.t
 t/lib/Test/Simple/sample_tests/death.plx               for exit.t
 t/lib/Test/Simple/sample_tests/exit.plx                        for exit.t
 t/lib/Test/Simple/sample_tests/extras.plx              for exit.t
index b2bb376..57a57d2 100644 (file)
@@ -73,28 +73,15 @@ Test::Builder - Backend for building test libraries
 =head1 SYNOPSIS
 
   package My::Test::Module;
-  use Test::Builder;
-  require Exporter;
-  @ISA = qw(Exporter);
-  @EXPORT = qw(ok);
+  use base 'Test::Builder::Module';
 
-  my $Test = Test::Builder->new;
-  $Test->output('my_logfile');
-
-  sub import {
-      my($self) = shift;
-      my $pack = caller;
-
-      $Test->exported_to($pack);
-      $Test->plan(@_);
-
-      $self->export_to_level(1, $self, 'ok');
-  }
+  my $CLASS = __PACKAGE__;
 
   sub ok {
       my($test, $name) = @_;
+      my $tb = $CLASS->builder;
 
-      $Test->ok($test, $name);
+      $tb->ok($test, $name);
   }
 
 
@@ -177,7 +164,6 @@ sub reset {
     # hash keys is just asking for pain.  Also, it was documented.
     $Level = 1;
 
-    $self->{Test_Died}    = 0;
     $self->{Have_Plan}    = 0;
     $self->{No_Plan}      = 0;
     $self->{Original_Pid} = $$;
@@ -196,6 +182,8 @@ sub reset {
     $self->{No_Header}  = 0;
     $self->{No_Ending}  = 0;
 
+    $self->{TODO}       = undef;
+
     $self->_dup_stdhandles unless $^C;
 
     return;
@@ -210,25 +198,6 @@ are.  You usually only want to call one of these methods.
 
 =over 4
 
-=item B<exported_to>
-
-  my $pack = $Test->exported_to;
-  $Test->exported_to($pack);
-
-Tells Test::Builder what package you exported your functions to.
-This is important for getting TODO tests right.
-
-=cut
-
-sub exported_to {
-    my($self, $pack) = @_;
-
-    if( defined $pack ) {
-        $self->{Exported_To} = $pack;
-    }
-    return $self->{Exported_To};
-}
-
 =item B<plan>
 
   $Test->plan('no_plan');
@@ -360,6 +329,29 @@ sub skip_all {
     exit(0);
 }
 
+
+=item B<exported_to>
+
+  my $pack = $Test->exported_to;
+  $Test->exported_to($pack);
+
+Tells Test::Builder what package you exported your functions to.
+
+This method isn't terribly useful since modules which share the same
+Test::Builder object might get exported to different packages and only
+the last one will be honored.
+
+=cut
+
+sub exported_to {
+    my($self, $pack) = @_;
+
+    if( defined $pack ) {
+        $self->{Exported_To} = $pack;
+    }
+    return $self->{Exported_To};
+}
+
 =back
 
 =head2 Running tests
@@ -402,6 +394,11 @@ sub ok {
 ERR
 
     my $todo = $self->todo();
+    
+    # Capture the value of $TODO for the rest of this ok() call
+    # so it can more easily be found by other routines.
+    local $self->{TODO} = $todo;
+
     $self->_unoverload_str(\$todo);
 
     my $out;
@@ -583,6 +580,7 @@ sub _is_diag {
         }
     }
 
+    local $Level = $Level + 1;
     return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
          got: %s
     expected: %s
@@ -730,6 +728,8 @@ sub _cmp_diag {
     
     $got    = defined $got    ? "'$got'"    : 'undef';
     $expect = defined $expect ? "'$expect'" : 'undef';
+    
+    local $Level = $Level + 1;
     return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
     %s
         %s
@@ -941,7 +941,18 @@ sub maybe_regex {
     }
 
     return $usable_regex;
-};
+}
+
+
+sub _is_qr {
+    my $regex = shift;
+    
+    # is_regexp() checks for regexes in a robust manner, say if they're
+    # blessed.
+    return re::is_regexp($regex) if defined &re::is_regexp;
+    return ref $regex eq 'Regexp';
+}
+
 
 sub _regex_ok {
     my($self, $this, $regex, $cmp, $name) = @_;
@@ -975,6 +986,8 @@ $code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
     unless( $ok ) {
         $this = defined $this ? "'$this'" : 'undef';
         my $match = $cmp eq '=~' ? "doesn't match" : "matches";
+
+        local $Level = $Level + 1;
         $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
                   %s
     %13s '%s'
@@ -1354,6 +1367,7 @@ sub _autoflush {
 }
 
 
+my($Testout, $Testerr);
 sub _dup_stdhandles {
     my $self = shift;
 
@@ -1361,28 +1375,46 @@ sub _dup_stdhandles {
 
     # Set everything to unbuffered else plain prints to STDOUT will
     # come out in the wrong order from our own prints.
-    _autoflush(\*TESTOUT);
+    _autoflush($Testout);
     _autoflush(\*STDOUT);
-    _autoflush(\*TESTERR);
+    _autoflush($Testerr);
     _autoflush(\*STDERR);
 
-    $self->output(\*TESTOUT);
-    $self->failure_output(\*TESTERR);
-    $self->todo_output(\*TESTOUT);
+    $self->output        ($Testout);
+    $self->failure_output($Testerr);
+    $self->todo_output   ($Testout);
 }
 
 
 my $Opened_Testhandles = 0;
 sub _open_testhandles {
+    my $self = shift;
+    
     return if $Opened_Testhandles;
+    
     # We dup STDOUT and STDERR so people can change them in their
     # test suites while still getting normal test output.
-    open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT:  $!";
-    open(TESTERR, ">&STDERR") or die "Can't dup STDERR:  $!";
+    open( $Testout, ">&STDOUT") or die "Can't dup STDOUT:  $!";
+    open( $Testerr, ">&STDERR") or die "Can't dup STDERR:  $!";
+
+#    $self->_copy_io_layers( \*STDOUT, $Testout );
+#    $self->_copy_io_layers( \*STDERR, $Testerr );
+    
     $Opened_Testhandles = 1;
 }
 
 
+sub _copy_io_layers {
+    my($self, $src, $dest) = @_;
+    
+    $self->_try(sub {
+        require PerlIO;
+        my @layers = PerlIO::get_layers($src);
+        
+        binmode $dest, join " ", map ":$_", @layers if @layers;
+    });
+}
+
 =item carp
 
   $tb->carp(@message);
@@ -1562,9 +1594,10 @@ will be considered 'todo' (see Test::More and Test::Harness for
 details).  Returns the reason (ie. the value of $TODO) if running as
 todo tests, false otherwise.
 
-todo() is about finding the right package to look for $TODO in.  It
-uses the exported_to() package to find it.  If that's not set, it's
-pretty good at guessing the right package to look at based on $Level.
+todo() is about finding the right package to look for $TODO in.  It's
+pretty good at guessing the right package to look at.  It first looks for
+the caller based on C<$Level + 1>, since C<todo()> is usually called inside
+a test function.  As a last resort it will use C<exported_to()>.
 
 Sometimes there is some confusion about where todo() should be looking
 for the $TODO variable.  If you want to be sure, tell it explicitly
@@ -1575,7 +1608,9 @@ what $pack to use.
 sub todo {
     my($self, $pack) = @_;
 
-    $pack = $pack || $self->exported_to || $self->caller($Level);
+    return $self->{TODO} if defined $self->{TODO};
+
+    $pack = $pack || $self->caller(1) || $self->exported_to;
     return 0 unless $pack;
 
     no strict 'refs';   ## no critic
@@ -1591,6 +1626,8 @@ sub todo {
 
 Like the normal caller(), except it reports according to your level().
 
+C<$height> will be added to the level().
+
 =cut
 
 sub caller {
@@ -1675,35 +1712,27 @@ sub _my_exit {
 
 =cut
 
-$SIG{__DIE__} = sub {
-    # We don't want to muck with death in an eval, but $^S isn't
-    # totally reliable.  5.005_03 and 5.6.1 both do the wrong thing
-    # with it.  Instead, we use caller.  This also means it runs under
-    # 5.004!
-    my $in_eval = 0;
-    for( my $stack = 1;  my $sub = (CORE::caller($stack))[3];  $stack++ ) {
-        $in_eval = 1 if $sub =~ /^\(eval\)/;
-    }
-    $Test->{Test_Died} = 1 unless $in_eval;
-};
-
 sub _ending {
     my $self = shift;
 
+    my $real_exit_code = $?;
     $self->_sanity_check();
 
     # Don't bother with an ending if this is a forked copy.  Only the parent
     # should do the ending.
+    if( $self->{Original_Pid} != $$ ) {
+        return;
+    }
+    
     # Exit if plan() was never called.  This is so "require Test::Simple" 
     # doesn't puke.
+    if( !$self->{Have_Plan} ) {
+        return;
+    }
+
     # Don't do an ending if we bailed out.
-    if( ($self->{Original_Pid} != $$)                  or
-       (!$self->{Have_Plan} && !$self->{Test_Died})    or
-       $self->{Bailed_Out}
-      )
-    {
-       _my_exit($?);
-       return;
+    if( $self->{Bailed_Out} ) {
+        return;
     }
 
     # Figure out if we passed or failed and print helpful messages.
@@ -1753,7 +1782,7 @@ Looks like you failed $num_failed test$s of $num_tests$qualifier.
 FAIL
         }
 
-        if( $self->{Test_Died} ) {
+        if( $real_exit_code ) {
             $self->diag(<<"FAIL");
 Looks like your test died just after $self->{Curr_Test}.
 FAIL
@@ -1777,7 +1806,7 @@ FAIL
     elsif ( $self->{Skip_All} ) {
         _my_exit( 0 ) && return;
     }
-    elsif ( $self->{Test_Died} ) {
+    elsif ( $real_exit_code ) {
         $self->diag(<<'FAIL');
 Looks like your test died before it could output anything.
 FAIL
index 82d19c6..514c405 100644 (file)
@@ -7,7 +7,7 @@ use Test::Builder;
 require Exporter;
 our @ISA = qw(Exporter);
 
-our $VERSION = '0.75';
+our $VERSION = '0.78';
 
 # 5.004's Exporter doesn't have export_to_level.
 my $_export_to_level = sub {
@@ -83,6 +83,9 @@ import_extra().
 
 sub import {
     my($class) = shift;
+    
+    # Don't run all this when loading ourself.
+    return 1 if $class eq 'Test::Builder::Module';
 
     my $test = $class->builder;
 
index ef66d66..fdb3fb1 100644 (file)
@@ -1,7 +1,7 @@
 package Test::Builder::Tester;
 
 use strict;
-our $VERSION = "1.12";
+our $VERSION = "1.13";
 
 use Test::Builder;
 use Symbol;
index a33be4c..e5a0a93 100644 (file)
@@ -15,7 +15,7 @@ sub _carp {
 
 
 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.75';
+$VERSION = '0.78';
 $VERSION = eval $VERSION;    # make the alpha version come out as a number
 
 use Test::Builder::Module;
@@ -30,7 +30,7 @@ use Test::Builder::Module;
              plan
              can_ok  isa_ok
              diag
-            BAIL_OUT
+             BAIL_OUT
             );
 
 
index a070133..120893d 100644 (file)
@@ -4,7 +4,7 @@ use 5.004;
 
 use strict 'vars';
 use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '0.75';
+$VERSION = '0.78';
 $VERSION = eval $VERSION;    # make the alpha version come out as a number
 
 use Test::Builder::Module;
diff --git a/lib/Test/Simple/t/dont_overwrite_die_handler.t b/lib/Test/Simple/t/dont_overwrite_die_handler.t
new file mode 100644 (file)
index 0000000..0657a06
--- /dev/null
@@ -0,0 +1,19 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+# Make sure this is in place before Test::More is loaded.
+my $handler_called;
+BEGIN {
+    $SIG{__DIE__} = sub { $handler_called++ };
+}
+
+use Test::More tests => 2;
+
+ok !eval { die };
+is $handler_called, 1, 'existing DIE handler not overridden';
index 6630b64..e85e460 100644 (file)
@@ -25,18 +25,9 @@ if( $^O eq 'MacOS' ) {
     exit 0;
 }
 
-my $test_num = 1;
-# Utility testing functions.
-sub ok ($;$) {
-    my($test, $name) = @_;
-    my $ok = '';
-    $ok .= "not " unless $test;
-    $ok .= "ok $test_num";
-    $ok .= " - $name" if defined $name;
-    $ok .= "\n";
-    print $ok;
-    $test_num++;
-}
+require Test::Builder;
+my $TB = Test::Builder->create();
+$TB->level(0);
 
 
 package main;
@@ -59,10 +50,11 @@ my %Tests = (
              'pre_plan_death.plx'       => ['not zero',    'not zero'],
              'death_in_eval.plx'        => [0,      0],
              'require.plx'              => [0,      0],
-            'exit.plx'                 => [1,      4],
+             'death_with_handler.plx'   => [255,    4],
+             'exit.plx'                 => [1,      4],
             );
 
-print "1..".keys(%Tests)."\n";
+$TB->plan( tests => scalar keys(%Tests) );
 
 eval { require POSIX; &POSIX::WEXITSTATUS(0) };
 if( $@ ) {
@@ -93,12 +85,12 @@ while( my($test_name, $exit_codes) = each %Tests ) {
     my $actual_exit = exitstatus($wait_stat);
 
     if( $exit_code eq 'not zero' ) {
-        My::Test::ok( $actual_exit != 0,
+        $TB->isnt_num( $actual_exit, 0,
                       "$test_name exited with $actual_exit ".
                       "(expected $exit_code)");
     }
     else {
-        My::Test::ok( $actual_exit == $exit_code, 
+        $TB->is_num( $actual_exit, $exit_code, 
                       "$test_name exited with $actual_exit ".
                       "(expected $exit_code)");
     }
index dfea4ba..fed9e1e 100644 (file)
@@ -3,19 +3,16 @@
 BEGIN {
     if( $ENV{PERL_CORE} ) {
         chdir 't';
-        @INC = '../lib';
+        @INC = '../lib', 'lib';
     }
 }
 
+use lib 't/lib';
 use Test::More tests => 1;
+use Dev::Null;
 
 tie *STDOUT, "Dev::Null" or die $!;
 
 print "not ok 1\n";     # this should not print.
 pass 'STDOUT can be mucked with';
 
-
-package Dev::Null;
-
-sub TIEHANDLE { bless {} }
-sub PRINT { 1 }
index cf6b6ba..e7867a5 100644 (file)
@@ -24,7 +24,7 @@ BEGIN {
     }
     
     unless ( $ENV{AUTHOR_TESTING} ) {
-        print "1..0 # Skip: many perls have broken threads\n";
+        print "1..0 # Skip: many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
         exit 0;
     }
 }
index e4d7506..d1927a5 100644 (file)
@@ -11,22 +11,24 @@ BEGIN {
 }
 
 use strict;
-use Test::More tests => 13;
+use Test::More tests => 16;
 
 use Test::Builder;
 my $Test = Test::Builder->new;
 
+my $r = $Test->maybe_regex(qr/^FOO$/i);
+ok(defined $r, 'qr// detected');
+ok(('foo' =~ /$r/), 'qr// good match');
+ok(('bar' !~ /$r/), 'qr// bad match');
+
 SKIP: {
-    skip "qr// added in 5.005", 3 if $] < 5.005;
-
-    # 5.004 can't even see qr// or it pukes in compile.
-    eval q{
-           my $r = $Test->maybe_regex(qr/^FOO$/i);
-           ok(defined $r, 'qr// detected');
-           ok(('foo' =~ /$r/), 'qr// good match');
-           ok(('bar' !~ /$r/), 'qr// bad match');
-          };
-    die $@ if $@;
+    skip "blessed regex checker added in 5.10", 3 if $] < 5.010;
+    
+    my $obj = bless qr/foo/, 'Wibble';
+    my $re = $Test->maybe_regex($obj);
+    ok( defined $re, "blessed regex detected" );
+    ok( ('foo' =~ /$re/), 'blessed qr/foo/ good match' );
+    ok( ('bar' !~ /$re/), 'blessed qr/foo/ bad math' );
 }
 
 {
index 320fd86..5a7b07f 100644 (file)
@@ -16,6 +16,11 @@ chdir 't';
 
 use Test::Builder;
 my $tb = Test::Builder->new;
+
+my %Original_Output;
+$Original_Output{$_} = $tb->$_ for qw(output failure_output todo_output);
+
+
 $tb->plan(tests => 14);
 $tb->level(0);
 
@@ -66,11 +71,11 @@ ok( $tb->level          == 1,           'level' );
 ok( $tb->use_numbers    == 1,           'use_numbers' );
 ok( $tb->no_header      == 0,           'no_header' );
 ok( $tb->no_ending      == 0,           'no_ending' );
-ok( fileno $tb->output         == fileno *Test::Builder::TESTOUT,    
+ok( fileno $tb->output         == fileno $Original_Output{output},    
                                         'output' );
-ok( fileno $tb->failure_output == fileno *Test::Builder::TESTERR,    
+ok( fileno $tb->failure_output == fileno $Original_Output{failure_output},    
                                         'failure_output' );
-ok( fileno $tb->todo_output    == fileno *Test::Builder::TESTOUT,
+ok( fileno $tb->todo_output    == fileno $Original_Output{todo_output},
                                         'todo_output' );
 ok( $tb->current_test   == 0,           'current_test' );
 ok( $tb->summary        == 0,           'summary' );
diff --git a/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t b/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t
new file mode 100644 (file)
index 0000000..f5ad001
--- /dev/null
@@ -0,0 +1,24 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use strict;
+use warnings;
+
+# Can't use Test::More, that would set exported_to()
+use Test::Builder;
+use Test::Builder::Module;
+
+my $TB = Test::Builder->create;
+$TB->plan( tests => 1 );
+$TB->level(0);
+
+$TB->is_eq( Test::Builder::Module->builder->exported_to,
+            undef,
+            'using Test::Builder::Module does not set exported_to()'
+);
\ No newline at end of file
index 6ea51a6..d589c92 100644 (file)
@@ -69,21 +69,20 @@ TODO: {
         # perl gets the line number a little wrong on the first
         # statement inside a block.
         1 == 1;
-#line 82
+#line 73
         todo_skip "Just testing todo_skip";
         fail("So very failed");
     }
     is( $warning, "todo_skip() needs to know \$how_many tests are in the ".
-                  "block at $0 line 82\n",
+                  "block at $0 line 73\n",
         'todo_skip without $how_many warning' );
 }
 
 
-{
+TODO: {
     Test::More->builder->exported_to("Wibble");
-    $Wibble::TODO = '';     # shut up used only once warning
-    TODO: {
-        local $Wibble::TODO = $Why;
-        fail("TODO honors exported_to()");
-    }
-}
\ No newline at end of file
+    
+    local $TODO = "testing \$TODO with an incorrect exported_to()";
+    
+    fail("Just testing todo");
+}
diff --git a/lib/Test/Simple/t/utf8.t b/lib/Test/Simple/t/utf8.t
new file mode 100644 (file)
index 0000000..7640db6
--- /dev/null
@@ -0,0 +1,61 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use strict;
+use warnings;
+
+
+my $have_perlio;
+BEGIN {
+    # All together so Test::More sees the open discipline
+    $have_perlio = eval q[
+        use PerlIO;
+        use open ':std', ':locale';
+        use Test::More;
+        1;
+    ];
+}
+#use Test::More tests => 5;
+use Test::More skip_all => 'Not yet implemented';
+
+SKIP: {
+    skip( "Need PerlIO for this feature", 3 )
+        unless $have_perlio;
+
+    my %handles = (
+        output          => \*STDOUT,
+        failure_output  => \*STDERR,
+        todo_output     => \*STDOUT
+    );
+
+    for my $method (keys %handles) {
+        my $src = $handles{$method};
+        
+        my $dest = Test::More->builder->$method;
+        
+        is_deeply [PerlIO::get_layers($dest)],
+                  [PerlIO::get_layers($src)],
+                  "layers copied to $method";
+    }
+}
+
+SKIP: {
+    skip( "Can't test in general because their locale is unknown", 2 )
+        unless $ENV{AUTHOR_TESTING};
+
+    my $uni = "\x{11e}";
+    
+    my @warnings;
+    local $SIG{__WARN__} = sub {
+        push @warnings, @_;
+    };
+
+    is( $uni, $uni, "Testing $uni" );
+    is_deeply( \@warnings, [] );
+}
\ No newline at end of file
index ef4ba8c..493784c 100644 (file)
@@ -4,10 +4,12 @@ push @INC, 't/lib';
 require Test::Simple::Catch;
 my($out, $err) = Test::Simple::Catch::caught();
 
+require Dev::Null;
+
 Test::Simple->import(tests => 5);
-close STDERR;
+tie *STDERR, 'Dev::Null';
 
 ok(1);
 ok(1);
 ok(1);
-die "Knife?";
+die "This is a test";
diff --git a/t/lib/Test/Simple/sample_tests/death_with_handler.plx b/t/lib/Test/Simple/sample_tests/death_with_handler.plx
new file mode 100644 (file)
index 0000000..2009a0e
--- /dev/null
@@ -0,0 +1,18 @@
+require Test::Simple;
+
+push @INC, 't/lib';
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+
+Test::Simple->import(tests => 2);
+
+# Test we still get the right exit code despite having a die
+# handler.
+$SIG{__DIE__} = sub {};
+
+require Dev::Null;
+tie *STDERR, 'Dev::Null';
+
+ok(1);
+ok(1);
+die "This is a test";
index ef86a63..fe8451e 100644 (file)
@@ -5,7 +5,9 @@ require Test::Simple::Catch;
 my($out, $err) = Test::Simple::Catch::caught();
 
 Test::Simple->import(tests => 5);
-close STDERR;
+
+require Dev::Null;
+tie *STDERR, 'Dev::Null';
 
 ok(1);
 ok(1);
@@ -13,4 +15,4 @@ ok(1);
 ok(1);
 ok(1);
 
-die "Almost there...";
+die "This is a test";