From: Nicholas Clark Date: Sat, 16 Oct 2004 12:57:39 +0000 (+0000) Subject: The second half of Perl_vwarner is actually a straight cut&paste job X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d13b0d777d6d58b6258c1f4aebb7ed97a4ad3301;p=p5sagit%2Fp5-mst-13.2.git The second half of Perl_vwarner is actually a straight cut&paste job from Perl_vwarn, so convert it into a (tail) call to Perl_vwarn. cut&paste is bad, m'kay. p4raw-id: //depot/perl@23374 --- diff --git a/util.c b/util.c index 396a40c..44e1cee 100644 --- a/util.c +++ b/util.c @@ -1361,19 +1361,19 @@ Perl_warner(pTHX_ U32 err, const char* pat,...) void Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) { - char *message; - HV *stash; - GV *gv; - CV *cv; - SV *msv; - STRLEN msglen; - I32 utf8 = 0; + if (ckDEAD(err)) { + char *message; + HV *stash; + GV *gv; + CV *cv; + SV *msv; + STRLEN msglen; + I32 utf8 = 0; - msv = vmess(pat, args); - message = SvPV(msv, msglen); - utf8 = SvUTF8(msv); + msv = vmess(pat, args); + message = SvPV(msv, msglen); + utf8 = SvUTF8(msv); - if (ckDEAD(err)) { if (PL_diehook) { /* sv_2cv might call Perl_croak() */ SV *olddiehook = PL_diehook; @@ -1411,36 +1411,7 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) my_failure_exit(); } else { - if (PL_warnhook) { - /* sv_2cv might call Perl_warn() */ - SV *oldwarnhook = PL_warnhook; - ENTER; - SAVESPTR(PL_warnhook); - PL_warnhook = Nullsv; - cv = sv_2cv(oldwarnhook, &stash, &gv, 0); - LEAVE; - if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) { - dSP; - SV *msg; - - ENTER; - save_re_context(); - msg = newSVpvn(message, msglen); - SvFLAGS(msg) |= utf8; - SvREADONLY_on(msg); - SAVEFREESV(msg); - - PUSHSTACKi(PERLSI_WARNHOOK); - PUSHMARK(sp); - XPUSHs(msg); - PUTBACK; - call_sv((SV*)cv, G_DISCARD); - POPSTACK; - LEAVE; - return; - } - } - write_to_stderr(message, msglen); + Perl_vwarn(aTHX_ pat, args); } }