diff options
| author | Zefram <zefram@fysh.org> | 2010-04-23 01:52:47 +0100 |
|---|---|---|
| committer | Zefram <zefram@fysh.org> | 2010-04-23 01:52:47 +0100 |
| commit | c5df3096702d4a814b3774dff243e7eb74814257 (patch) | |
| tree | 93ec4463179fc3bf3e5ee20be2afa863b1d3a66a /t | |
| parent | 96d9b9cd40f1d98fda790eb12b5cdbeef8b48a81 (diff) | |
| download | perl-c5df3096702d4a814b3774dff243e7eb74814257.tar.gz | |
SV-based interfaces for dieing and warning
New functions croak_sv(), die_sv(), mess_sv(), and warn_sv(), each act
much like their _sv-less counterparts, but take a single SV argument
instead of sprintf-like format and args. They will accept RVs, passing
them through as such. This means there's no more need to clobber ERRSV
in order to throw a structured exception.
pp_warn() and pp_die() are rewritten to use the _sv interfaces.
This fixes part of [perl #74538]. It also means that a structured
warning object will be passed through to $SIG{__WARN__} instead of
being stringified, thus bringing warn in line with die with respect to
structured exception objects.
The new functions and their existing counterparts are all fully
documented.
Diffstat (limited to 't')
| -rw-r--r-- | t/op/warn.t | 108 |
1 files changed, 108 insertions, 0 deletions
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; |