diff options
| -rwxr-xr-x | t/op/die.t | 27 | ||||
| -rw-r--r-- | util.c | 16 |
2 files changed, 38 insertions, 5 deletions
diff --git a/t/op/die.t b/t/op/die.t index cf4f8b0555..e9387a23bb 100755 --- a/t/op/die.t +++ b/t/op/die.t @@ -1,6 +1,6 @@ #!./perl -print "1..10\n"; +print "1..13\n"; $SIG{__DIE__} = sub { print ref($_[0]) ? ("ok ",$_[0]->[0]++,"\n") : @_ } ; @@ -35,9 +35,26 @@ eval { print "not " unless ref($@) eq "Out"; print "ok 10\n"; -package Error; +{ + package Error; -sub PROPAGATE { - print "ok ",$_[0]->[0]++,"\n"; - bless [$_[0]->[0]], "Out"; + sub PROPAGATE { + print "ok ",$_[0]->[0]++,"\n"; + bless [$_[0]->[0]], "Out"; + } +} + +{ + # 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"; + 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"; } @@ -1033,6 +1033,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args) CV *cv; SV *msv; STRLEN msglen; + I32 utf8 = 0; DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: die: curstack = %p, mainstack = %p\n", @@ -1047,6 +1048,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args) } else message = SvPV(msv,msglen); + utf8 = SvUTF8(msv); } else { message = Nullch; @@ -1072,6 +1074,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args) save_re_context(); if (message) { msg = newSVpvn(message, msglen); + SvFLAGS(msg) |= utf8; SvREADONLY_on(msg); SAVEFREESV(msg); } @@ -1090,6 +1093,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args) } PL_restartop = die_where(message, msglen); + SvFLAGS(ERRSV) |= utf8; DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: die: restartop = %p, was_in_eval = %d, top_env = %p\n", thr, PL_restartop, was_in_eval, PL_top_env)); @@ -1132,6 +1136,7 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args) CV *cv; SV *msv; STRLEN msglen; + I32 utf8 = 0; if (pat) { msv = vmess(pat, args); @@ -1142,6 +1147,7 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args) } else message = SvPV(msv,msglen); + utf8 = SvUTF8(msv); } else { message = Nullch; @@ -1167,6 +1173,7 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args) save_re_context(); if (message) { msg = newSVpvn(message, msglen); + SvFLAGS(msg) |= utf8; SvREADONLY_on(msg); SAVEFREESV(msg); } @@ -1185,6 +1192,7 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args) } if (PL_in_eval) { PL_restartop = die_where(message, msglen); + SvFLAGS(ERRSV) |= utf8; JMPENV_JUMP(3); } else if (!message) @@ -1245,8 +1253,10 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args) CV *cv; SV *msv; STRLEN msglen; + I32 utf8 = 0; msv = vmess(pat, args); + utf8 = SvUTF8(msv); message = SvPV(msv, msglen); if (PL_warnhook) { @@ -1264,6 +1274,7 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args) ENTER; save_re_context(); msg = newSVpvn(message, msglen); + SvFLAGS(msg) |= utf8; SvREADONLY_on(msg); SAVEFREESV(msg); @@ -1342,9 +1353,11 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) CV *cv; SV *msv; STRLEN msglen; + I32 utf8 = 0; msv = vmess(pat, args); message = SvPV(msv, msglen); + utf8 = SvUTF8(msv); if (ckDEAD(err)) { if (PL_diehook) { @@ -1362,6 +1375,7 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) ENTER; save_re_context(); msg = newSVpvn(message, msglen); + SvFLAGS(msg) |= utf8; SvREADONLY_on(msg); SAVEFREESV(msg); @@ -1376,6 +1390,7 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) } if (PL_in_eval) { PL_restartop = die_where(message, msglen); + SvFLAGS(ERRSV) |= utf8; JMPENV_JUMP(3); } write_to_stderr(message, msglen); @@ -1397,6 +1412,7 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) ENTER; save_re_context(); msg = newSVpvn(message, msglen); + SvFLAGS(msg) |= utf8; SvREADONLY_on(msg); SAVEFREESV(msg); |