From bd6653b86a7807510f14ea3d0fa8ace7ab8f9374 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 17 Jul 2012 21:59:30 -0700 Subject: [PATCH] Refactor t/op/die.t to use test.pl instead of making TAP by hand. [With a few whitespace tweaks] --- t/op/die.t | 86 ++++++++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 56 insertions(+), 30 deletions(-) diff --git a/t/op/die.t b/t/op/die.t index a51333f..0ed4983 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' ); } -- 2.7.4