diff options
author | Father Chrysostomos <sprout@cpan.org> | 2012-05-27 00:11:31 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2012-06-07 08:18:53 -0700 |
commit | ef5fe392ebd662891a80860e9ba74cc961823c81 (patch) | |
tree | fa5984135d374f119a866aa18708f0d7926485cd /pp_sys.c | |
parent | 6954f42f948dcf1dba2014aa06dd5c33b7561992 (diff) | |
download | perl-ef5fe392ebd662891a80860e9ba74cc961823c81.tar.gz |
Make warn handle magic vars (fixes [perl #97480])
pp_warn was checking flags before calling get-magic, resulting in sev-
eral bugs that I fixed all at once::
• warn now calls get-magic exactly once on its argument, when there
is just one argument (it always worked correctly for multiple)
[perl #97480].
• warn calls get-magic exactly once on $@ when falling back to it,
instead of zero times.
• A tied variable returning an object that stringifies as an empty
string is no longer ignored if the tied variable was not ROK
before FETCH.
• A tied $@ containing a string, or $@ aliased to $1, is no
longer ignored.
• A tied $@ that last returned a reference but will return a string on
the next FETCH now gets "\t...caught" appended.
Diffstat (limited to 'pp_sys.c')
-rw-r--r-- | pp_sys.c | 23 |
1 files changed, 16 insertions, 7 deletions
@@ -438,20 +438,29 @@ PP(pp_warn) } else { exsv = TOPs; + if (SvGMAGICAL(exsv)) exsv = sv_mortalcopy(exsv); } if (SvROK(exsv) || (SvPV_const(exsv, len), len)) { /* well-formed exception supplied */ } - else if (SvROK(ERRSV)) { - exsv = ERRSV; - } - else if (SvPOK(ERRSV) && SvCUR(ERRSV)) { - exsv = sv_mortalcopy(ERRSV); - sv_catpvs(exsv, "\t...caught"); - } else { + SvGETMAGIC(ERRSV); + if (SvROK(ERRSV)) { + if (SvGMAGICAL(ERRSV)) { + exsv = sv_newmortal(); + sv_setsv_nomg(exsv, ERRSV); + } + else exsv = ERRSV; + } + else if (SvPOKp(ERRSV) && SvCUR(ERRSV)) { + exsv = sv_newmortal(); + sv_setsv_nomg(exsv, ERRSV); + sv_catpvs(exsv, "\t...caught"); + } + else { exsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP); + } } if (SvROK(exsv) && !PL_warnhook) Perl_warn(aTHX_ "%"SVf, SVfARG(exsv)); |