Change 26787 by [EMAIL PROTECTED] on 2006/01/11 14:47:04
Refactor S_vdie_common so that Perl_vwarn can use it too.
Affected files ...
... //depot/perl/embed.fnc#299 edit
... //depot/perl/embed.h#548 edit
... //depot/perl/proto.h#645 edit
... //depot/perl/util.c#533 edit
Differences ...
==== //depot/perl/embed.fnc#299 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#298~26764~ 2006-01-10 02:51:16.000000000 -0800
+++ perl/embed.fnc 2006-01-11 06:47:04.000000000 -0800
@@ -1403,7 +1403,8 @@
s |SV* |mess_alloc
s |const char *|vdie_croak_common|NULLOK const char *pat|NULLOK va_list
*args \
|NULLOK STRLEN *msglen|NULLOK I32* utf8
-s |void |vdie_common |NULLOK const char *message|STRLEN msglen|I32
utf8
+s |bool |vdie_common |NULLOK const char *message|STRLEN msglen\
+ |I32 utf8|bool warn
sr |char * |write_no_mem
#endif
==== //depot/perl/embed.h#548 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#547~26764~ 2006-01-10 02:51:16.000000000 -0800
+++ perl/embed.h 2006-01-11 06:47:04.000000000 -0800
@@ -3476,7 +3476,7 @@
#define closest_cop(a,b) S_closest_cop(aTHX_ a,b)
#define mess_alloc() S_mess_alloc(aTHX)
#define vdie_croak_common(a,b,c,d) S_vdie_croak_common(aTHX_ a,b,c,d)
-#define vdie_common(a,b,c) S_vdie_common(aTHX_ a,b,c)
+#define vdie_common(a,b,c,d) S_vdie_common(aTHX_ a,b,c,d)
#define write_no_mem() S_write_no_mem(aTHX)
#endif
#endif
==== //depot/perl/proto.h#645 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#644~26764~ 2006-01-10 02:51:16.000000000 -0800
+++ perl/proto.h 2006-01-11 06:47:04.000000000 -0800
@@ -3881,7 +3881,7 @@
STATIC SV* S_mess_alloc(pTHX);
STATIC const char * S_vdie_croak_common(pTHX_ const char *pat, va_list
*args, STRLEN *msglen, I32* utf8);
-STATIC void S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32
utf8);
+STATIC bool S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32
utf8, bool warn);
STATIC char * S_write_no_mem(pTHX)
__attribute__noreturn__;
==== //depot/perl/util.c#533 (text) ====
Index: perl/util.c
--- perl/util.c#532~26780~ 2006-01-11 03:53:07.000000000 -0800
+++ perl/util.c 2006-01-11 06:47:04.000000000 -0800
@@ -1130,23 +1130,25 @@
}
}
-/* Common code used by vcroak, vdie and vwarner */
+/* Common code used by vcroak, vdie, vwarn and vwarner */
-STATIC void
-S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8)
+STATIC bool
+S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8, bool warn)
{
dVAR;
HV *stash;
GV *gv;
CV *cv;
- /* sv_2cv might call Perl_croak() */
- SV * const olddiehook = PL_diehook;
+ SV **const hook = warn ? &PL_warnhook : &PL_diehook;
+ /* sv_2cv might call Perl_croak() or Perl_warner() */
+ SV * const oldhook = *hook;
+
+ assert(oldhook);
- assert(PL_diehook);
ENTER;
- SAVESPTR(PL_diehook);
- PL_diehook = Nullsv;
- cv = sv_2cv(olddiehook, &stash, &gv, 0);
+ SAVESPTR(*hook);
+ *hook = NULL;
+ cv = sv_2cv(oldhook, &stash, &gv, 0);
LEAVE;
if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
dSP;
@@ -1154,7 +1156,11 @@
ENTER;
save_re_context();
- if (message) {
+ if (warn) {
+ SAVESPTR(*hook);
+ *hook = NULL;
+ }
+ if (warn || message) {
msg = newSVpvn(message, msglen);
SvFLAGS(msg) |= utf8;
SvREADONLY_on(msg);
@@ -1164,14 +1170,16 @@
msg = ERRSV;
}
- PUSHSTACKi(PERLSI_DIEHOOK);
+ PUSHSTACKi(warn ? PERLSI_WARNHOOK : PERLSI_DIEHOOK);
PUSHMARK(SP);
XPUSHs(msg);
PUTBACK;
call_sv((SV*)cv, G_DISCARD);
POPSTACK;
LEAVE;
+ return TRUE;
}
+ return FALSE;
}
STATIC const char *
@@ -1200,7 +1208,7 @@
"%p: die/croak: message = %s\ndiehook = %p\n",
thr, message, PL_diehook));
if (PL_diehook) {
- S_vdie_common(aTHX_ message, *msglen, *utf8);
+ S_vdie_common(aTHX_ message, *msglen, *utf8, FALSE);
}
return message;
}
@@ -1330,39 +1338,8 @@
const char * const message = SvPV_const(msv, msglen);
if (PL_warnhook) {
- /* sv_2cv might call Perl_warn() */
- SV * const oldwarnhook = PL_warnhook;
- CV * cv;
- HV * stash;
- GV * gv;
-
- 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;
- SAVESPTR(PL_warnhook);
- PL_warnhook = Nullsv;
- 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;
+ if (vdie_common(message, msglen, utf8, TRUE))
return;
- }
}
write_to_stderr(message, msglen);
@@ -1431,7 +1408,7 @@
if (PL_diehook) {
assert(message);
- S_vdie_common(aTHX_ message, msglen, utf8);
+ S_vdie_common(aTHX_ message, msglen, utf8, FALSE);
}
if (PL_in_eval) {
PL_restartop = die_where(message, msglen);
End of Patch.
