summaryrefslogtreecommitdiff
path: root/t/op/die.t
diff options
context:
space:
mode:
authorColin Kuskie <colink@perldreamer.com>2012-07-17 21:59:30 -0700
committerNicholas Clark <nick@ccl4.org>2012-08-30 15:38:05 +0200
commitbd6653b86a7807510f14ea3d0fa8ace7ab8f9374 (patch)
treeb97e78f2d728cbb58d1764b6547cd482356d7a57 /t/op/die.t
parentba495c01e84f3a93c5b0fd5fb1064683ada8bab7 (diff)
downloadperl-bd6653b86a7807510f14ea3d0fa8ace7ab8f9374.tar.gz
Refactor t/op/die.t to use test.pl instead of making TAP by hand.
[With a few whitespace tweaks]
Diffstat (limited to 't/op/die.t')
-rw-r--r--t/op/die.t86
1 files changed, 56 insertions, 30 deletions
diff --git a/t/op/die.t b/t/op/die.t
index a51333f9eb..0ed4983a18 100644
--- a/t/op/die.t
+++ b/t/op/die.t
@@ -1,65 +1,92 @@
#!./perl
-print "1..15\n";
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+}
-$SIG{__DIE__} = sub { print ref($_[0]) ? ("ok ",$_[0]->[0]++,"\n") : @_ } ;
+plan tests => 14;
-$err = "#[\000]\nok 1\n";
-eval {
- die $err;
-};
+{
+ local $SIG{__DIE__} = sub { is( $_[0], "[\000]\n", 'Embedded null passed to signal handler' )};
-print "not " unless $@ eq $err;
-print "ok 2\n";
+ $err = "[\000]\n";
+ eval {
+ die $err;
+ };
+ is( $@, $err, 'Embedded null passed back into $@' );
+}
-$x = [3];
-eval { die $x; };
+{
+ local $SIG{__DIE__} = sub { isa_ok( $_[0], 'ARRAY', 'pass an array ref as an argument' ); };
+ $x = [3];
+ eval { die $x; };
+
+ $SIG{__DIE__} = sub { $_[0]->[0]++; } ;
+ $x = [3];
+ eval { die $x; };
+ is( $x->[0], 4, 'actual array, not a copy, passed to signal handler' );
+}
-print "not " unless $x->[0] == 4;
-print "ok 4\n";
+$SIG{__DIE__} = 'DEFAULT';
eval {
eval {
- die [ 5 ];
+ die "Horribly\n";
};
die if $@;
};
-eval {
+like($@, '^Horribly', 'die with no args propagates $@');
+like($@, 'propagated', '... and appends a phrase');
+
+{
+ local $SIG{__DIE__} = sub { $_[0]->[0]++ };
+
eval {
- die bless [ 7 ], "Error";
+ eval {
+ die [ 5 ];
+ };
+ die if $@;
};
- die if $@;
-};
-print "not " unless ref($@) eq "Out";
-print "ok 10\n";
+ is($@->[0], 7, 'die with no arguments propagates $@, but leaves references alone');
+}
{
package Error;
sub PROPAGATE {
- print "ok ",$_[0]->[0]++,"\n";
bless [$_[0]->[0]], "Out";
}
}
+eval {
+ eval {
+ die bless [ 7 ], "Error";
+ };
+ isa_ok( $@, 'Error', '$@ is an Error object' );
+ die if $@;
+};
+
+isa_ok( $@, 'Out', 'returning a different object than what was passed in, via PROPAGATE' );
+
{
# die/warn and utf8
use utf8;
local $SIG{__DIE__};
my $msg = "ce ºtii tu, bã ?\n";
- eval { die $msg }; print "not " unless $@ eq $msg;
- print "ok 11\n";
+ eval { die $msg };
+ is( $@, $msg, "Literal passed to die" );
our $err;
local $SIG{__WARN__} = $SIG{__DIE__} = sub { $err = shift };
- eval { die $msg }; print "not " unless $err eq $msg;
- print "ok 12\n";
- eval { warn $msg }; print "not " unless $err eq $msg;
- print "ok 13\n";
+ eval { die $msg };
+ is( $err, $msg, 'die handler with utf8' );
+ eval { warn $msg };
+ is( $err, $msg, 'warn handler with utf8' );
eval qq/ use strict; \$\x{3b1} /;
- print "not " unless $@ =~ /Global symbol "\$\x{3b1}"/;
- print "ok 14\n";
+ like( $@, qr/Global symbol "\$\x{3b1}"/, 'utf8 symbol names show up in $@' );
}
# [perl #36470] got uninit warning if $@ was undef
@@ -69,6 +96,5 @@ print "ok 10\n";
local $SIG{__DIE__};
local $SIG{__WARN__} = sub { $ok = 0 };
eval { undef $@; die };
- print "not " unless $ok;
- print "ok 15\n";
+ is( $ok, 1, 'no warnings if $@ is undef' );
}