summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
Diffstat (limited to 't')
-rw-r--r--t/lib/warnings/pp_ctl18
-rw-r--r--t/op/die_except.t81
-rw-r--r--t/op/die_keeperr.t45
-rw-r--r--t/op/eval.t2
-rw-r--r--t/op/warn.t108
5 files changed, 254 insertions, 0 deletions
diff --git a/t/lib/warnings/pp_ctl b/t/lib/warnings/pp_ctl
index afaf0a78db..9b3f2982e4 100644
--- a/t/lib/warnings/pp_ctl
+++ b/t/lib/warnings/pp_ctl
@@ -205,6 +205,24 @@ DESTROY { die "@{$_[0]} foo bar" }
{ bless ['B'], 'Foo' for 1..10 }
EXPECT
(in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) A foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
+ (in cleanup) B foo bar at - line 4.
(in cleanup) B foo bar at - line 4.
########
# pp_ctl.c
diff --git a/t/op/die_except.t b/t/op/die_except.t
new file mode 100644
index 0000000000..b0fcadb8c8
--- /dev/null
+++ b/t/op/die_except.t
@@ -0,0 +1,81 @@
+#!./perl
+
+print "1..12\n";
+my $test_num = 0;
+sub ok {
+ print $_[0] ? "" : "not ", "ok ", ++$test_num, "\n";
+}
+
+{
+ package End;
+ sub DESTROY { $_[0]->() }
+ sub main::end(&) {
+ my($cleanup) = @_;
+ return bless(sub { $cleanup->() }, "End");
+ }
+}
+
+my($val, $err);
+
+$@ = "t0\n";
+$val = eval {
+ $@ = "t1\n";
+ 1;
+}; $err = $@;
+ok $val == 1;
+ok $err eq "";
+
+$@ = "t0\n";
+$val = eval {
+ $@ = "t1\n";
+ do {
+ die "t3\n";
+ };
+ 1;
+}; $err = $@;
+ok !defined($val);
+ok $err eq "t3\n";
+
+$@ = "t0\n";
+$val = eval {
+ $@ = "t1\n";
+ local $@ = "t2\n";
+ 1;
+}; $err = $@;
+ok $val == 1;
+ok $err eq "";
+
+$@ = "t0\n";
+$val = eval {
+ $@ = "t1\n";
+ local $@ = "t2\n";
+ do {
+ die "t3\n";
+ };
+ 1;
+}; $err = $@;
+ok !defined($val);
+ok $err eq "t3\n";
+
+$@ = "t0\n";
+$val = eval {
+ $@ = "t1\n";
+ my $c = end { $@ = "t2\n"; };
+ 1;
+}; $err = $@;
+ok $val == 1;
+ok $err eq "";
+
+$@ = "t0\n";
+$val = eval {
+ $@ = "t1\n";
+ my $c = end { $@ = "t2\n"; };
+ do {
+ die "t3\n";
+ };
+ 1;
+}; $err = $@;
+ok !defined($val);
+ok $err eq "t3\n";
+
+1;
diff --git a/t/op/die_keeperr.t b/t/op/die_keeperr.t
new file mode 100644
index 0000000000..9b41cb5935
--- /dev/null
+++ b/t/op/die_keeperr.t
@@ -0,0 +1,45 @@
+#!perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ require 'test.pl';
+ plan(20);
+}
+
+sub End::DESTROY { $_[0]->() }
+
+sub end(&) {
+ my($c) = @_;
+ return bless(sub { $c->() }, "End");
+}
+
+foreach my $inx ("", "aabbcc\n", [qw(aa bb cc)]) {
+ foreach my $outx ("", "xxyyzz\n", [qw(xx yy zz)]) {
+ my $warn = "";
+ local $SIG{__WARN__} = sub { $warn .= $_[0] };
+ {
+ $@ = $outx;
+ my $e = end { die $inx if $inx };
+ }
+ ok ref($@) eq ref($outx) && $@ eq $outx;
+ $warn =~ s/ at [^\n]*\n\z//;
+ is $warn, $inx ? "\t(in cleanup) $inx" : "";
+ }
+}
+
+{
+ no warnings "misc";
+ my $warn = "";
+ local $SIG{__WARN__} = sub { $warn .= $_[0] };
+ { my $e = end { die "aa\n"; }; }
+ is $warn, "";
+}
+
+{
+ my $warn = "";
+ local $SIG{__WARN__} = sub { $warn .= $_[0] };
+ { my $e = end { no warnings "misc"; die "aa\n"; }; }
+ is $warn, "\t(in cleanup) aa\n";
+}
+
+1;
diff --git a/t/op/eval.t b/t/op/eval.t
index 98fbc1e51c..ff5004eae5 100644
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -526,6 +526,8 @@ if (eval "use Devel::Peek; 1;") {
my $in = <IN>;
my ($first, $second) = split (/\*\*\*\*\*\*\n/, $in, 2);
$first =~ s/,pNOK//;
+ s/ PV = 0x[0-9a-f]+/ PV = 0x/ foreach $first, $second;
+ s/ LEN = [0-9]+/ LEN = / foreach $first, $second;
$ok = 1 if ($first eq $second);
}
}
diff --git a/t/op/warn.t b/t/op/warn.t
new file mode 100644
index 0000000000..ec3b9ca67f
--- /dev/null
+++ b/t/op/warn.t
@@ -0,0 +1,108 @@
+#!./perl
+#line 3 warn.t
+
+print "1..18\n";
+my $test_num = 0;
+sub ok {
+ print $_[0] ? "" : "not ", "ok ", ++$test_num, "\n";
+}
+
+my @warnings;
+my $wa = []; my $ea = [];
+$SIG{__WARN__} = sub { push @warnings, $_[0] };
+
+@warnings = ();
+$@ = "";
+warn "foo\n";
+ok @warnings==1 && $warnings[0] eq "foo\n";
+
+@warnings = ();
+$@ = "";
+warn "foo", "bar\n";
+ok @warnings==1 && $warnings[0] eq "foobar\n";
+
+@warnings = ();
+$@ = "";
+warn "foo";
+ok @warnings==1 && $warnings[0] eq "foo at warn.t line 26.\n";
+
+@warnings = ();
+$@ = "";
+warn $wa;
+ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
+
+@warnings = ();
+$@ = "";
+warn "";
+ok @warnings==1 &&
+ $warnings[0] eq "Warning: something's wrong at warn.t line 36.\n";
+
+@warnings = ();
+$@ = "";
+warn;
+ok @warnings==1 &&
+ $warnings[0] eq "Warning: something's wrong at warn.t line 42.\n";
+
+@warnings = ();
+$@ = "ERR\n";
+warn "foo\n";
+ok @warnings==1 && $warnings[0] eq "foo\n";
+
+@warnings = ();
+$@ = "ERR\n";
+warn "foo", "bar\n";
+ok @warnings==1 && $warnings[0] eq "foobar\n";
+
+@warnings = ();
+$@ = "ERR\n";
+warn "foo";
+ok @warnings==1 && $warnings[0] eq "foo at warn.t line 58.\n";
+
+@warnings = ();
+$@ = "ERR\n";
+warn $wa;
+ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
+
+@warnings = ();
+$@ = "ERR\n";
+warn "";
+ok @warnings==1 &&
+ $warnings[0] eq "ERR\n\t...caught at warn.t line 68.\n";
+
+@warnings = ();
+$@ = "ERR\n";
+warn;
+ok @warnings==1 &&
+ $warnings[0] eq "ERR\n\t...caught at warn.t line 74.\n";
+
+@warnings = ();
+$@ = $ea;
+warn "foo\n";
+ok @warnings==1 && $warnings[0] eq "foo\n";
+
+@warnings = ();
+$@ = $ea;
+warn "foo", "bar\n";
+ok @warnings==1 && $warnings[0] eq "foobar\n";
+
+@warnings = ();
+$@ = $ea;
+warn "foo";
+ok @warnings==1 && $warnings[0] eq "foo at warn.t line 90.\n";
+
+@warnings = ();
+$@ = $ea;
+warn $wa;
+ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
+
+@warnings = ();
+$@ = $ea;
+warn "";
+ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $ea;
+
+@warnings = ();
+$@ = $ea;
+warn;
+ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $ea;
+
+1;
View Lorry Controller Status