Change 29806 by [EMAIL PROTECTED] on 2007/01/14 12:49:30
Integrate:
[ 26765]
Move initialization of old values prior to moreswitches()
closer to their use and together with 'switches_done'.
[ 26767]
Missing an initialisation, as spotted by Merijn's HP compiler.
[ 26786]
Get rid of the following gcc format warnings by simplifying the
getgroups implementation:
mg.c: In function Perl_magic_get':
mg.c:1008: warning: long unsigned int format, gid_t arg (arg 3)
mg.c:1014: warning: long unsigned int format, gid_t arg (arg 3)
mg.c:1025: warning: long unsigned int format, unsigned int arg (arg 3)
Since we already cast the numeric Gid_t values to an IV it should not
be too risky to also cast the Group_t values. Converting these values
with Gid_t_f wasn't quite right anyway.
[ 26787]
Refactor S_vdie_common so that Perl_vwarn can use it too.
[ 26791]
Make $( and $) list the groups in the order they
are returned from the OS. Linux seems to return
the gids sorted and it seemed wrong for perl to
reverse this order.
[ 26893]
Suppress "statement not reached" warning from the Sun C compiler.
Affected files ...
... //depot/maint-5.8/perl/doio.c#85 integrate
... //depot/maint-5.8/perl/embed.fnc#165 integrate
... //depot/maint-5.8/perl/embed.h#125 integrate
... //depot/maint-5.8/perl/mathoms.c#16 edit
... //depot/maint-5.8/perl/mg.c#121 integrate
... //depot/maint-5.8/perl/proto.h#154 edit
... //depot/maint-5.8/perl/toke.c#128 integrate
... //depot/maint-5.8/perl/util.c#116 integrate
Differences ...
==== //depot/maint-5.8/perl/doio.c#85 (text) ====
Index: perl/doio.c
--- perl/doio.c#84~29804~ 2007-01-14 04:22:41.000000000 -0800
+++ perl/doio.c 2007-01-14 04:49:30.000000000 -0800
@@ -1963,9 +1963,10 @@
Safefree(gary);
return rc;
}
-#endif
+#else
return FALSE;
#endif
+#endif
}
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
==== //depot/maint-5.8/perl/embed.fnc#165 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#164~29804~ 2007-01-14 04:22:41.000000000 -0800
+++ perl/embed.fnc 2007-01-14 04:49:30.000000000 -0800
@@ -1374,7 +1374,8 @@
s |SV* |mess_alloc
xo |const char *|vdie_croak_common|NULLOK const char *pat|NULLOK va_list
*args \
|NULLOK STRLEN *msglen|NULLOK I32* utf8
-xo |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/maint-5.8/perl/embed.h#125 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#124~29804~ 2007-01-14 04:22:41.000000000 -0800
+++ perl/embed.h 2007-01-14 04:49:30.000000000 -0800
@@ -1418,6 +1418,7 @@
#define mess_alloc S_mess_alloc
#endif
#ifdef PERL_CORE
+#define vdie_common S_vdie_common
#define write_no_mem S_write_no_mem
#endif
#endif
@@ -3476,6 +3477,7 @@
#ifdef PERL_CORE
#define closest_cop(a,b) S_closest_cop(aTHX_ a,b)
#define mess_alloc() S_mess_alloc(aTHX)
+#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/maint-5.8/perl/mathoms.c#16 (text) ====
Index: perl/mathoms.c
--- perl/mathoms.c#15~29800~ 2007-01-13 15:25:42.000000000 -0800
+++ perl/mathoms.c 2007-01-14 04:49:30.000000000 -0800
@@ -1204,6 +1204,13 @@
return unpackstring(pat, patend, s, strend, flags);
}
+
+/* Whilst this should really be STATIC, it was not in 5.8.7, hence something
+ may have linked against it. */
+void
+S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8)
+{
+}
#endif /* NO_MATHOMS */
/*
==== //depot/maint-5.8/perl/mg.c#121 (text) ====
Index: perl/mg.c
--- perl/mg.c#120~29804~ 2007-01-14 04:22:41.000000000 -0800
+++ perl/mg.c 2007-01-14 04:49:30.000000000 -0800
@@ -1005,29 +1005,22 @@
break;
case '(':
sv_setiv(sv, (IV)PL_gid);
-#ifdef HAS_GETGROUPS
- Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_gid);
-#endif
goto add_groups;
case ')':
sv_setiv(sv, (IV)PL_egid);
-#ifdef HAS_GETGROUPS
- Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_egid);
-#endif
add_groups:
#ifdef HAS_GETGROUPS
{
Groups_t *gary = NULL;
- I32 num_groups = getgroups(0, gary);
+ I32 i, num_groups = getgroups(0, gary);
Newx(gary, num_groups, Groups_t);
num_groups = getgroups(num_groups, gary);
- while (--num_groups >= 0)
- Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f,
- gary[num_groups]);
+ for (i = 0; i < num_groups; i++)
+ Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]);
Safefree(gary);
}
-#endif
(void)SvIOK_on(sv); /* what a wonderful hack! */
+#endif
break;
case '*':
break;
==== //depot/maint-5.8/perl/proto.h#154 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#153~29804~ 2007-01-14 04:22:41.000000000 -0800
+++ perl/proto.h 2007-01-14 04:49:30.000000000 -0800
@@ -1994,7 +1994,7 @@
STATIC COP* S_closest_cop(pTHX_ COP *cop, const OP *o);
STATIC SV* S_mess_alloc(pTHX);
PERL_CALLCONV const char * vdie_croak_common(pTHX_ const char *pat,
va_list *args, STRLEN *msglen, I32* utf8);
-PERL_CALLCONV void 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/maint-5.8/perl/toke.c#128 (text) ====
Index: perl/toke.c
--- perl/toke.c#127~29804~ 2007-01-14 04:22:41.000000000 -0800
+++ perl/toke.c 2007-01-14 04:49:30.000000000 -0800
@@ -2950,15 +2950,15 @@
}
#endif
if (d) {
- const U32 oldpdb = PL_perldb;
- const bool oldn = PL_minus_n;
- const bool oldp = PL_minus_p;
-
while (*d && !isSPACE(*d)) d++;
while (SPACE_OR_TAB(*d)) d++;
if (*d++ == '-') {
const bool switches_done = PL_doswitches;
+ const U32 oldpdb = PL_perldb;
+ const bool oldn = PL_minus_n;
+ const bool oldp = PL_minus_p;
+
do {
if (*d == 'M' || *d == 'm') {
const char * const m = d;
@@ -4155,6 +4155,7 @@
just_a_word_zero_gv:
gv = NULL;
gvp = NULL;
+ orig_keyword = 0;
}
just_a_word: {
SV *sv;
==== //depot/maint-5.8/perl/util.c#116 (text) ====
Index: perl/util.c
--- perl/util.c#115~29804~ 2007-01-14 04:22:41.000000000 -0800
+++ perl/util.c 2007-01-14 04:49:30.000000000 -0800
@@ -1091,24 +1091,24 @@
}
}
-/* Common code used by vcroak, vdie and vwarner */
+/* Common code used by vcroak, vdie, vwarn and vwarner */
-/* Whilst this should really be STATIC, it was not in 5.8.7, hence something
- may have linked against it. */
-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)
{
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;
@@ -1116,7 +1116,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);
@@ -1126,14 +1130,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;
}
/* Whilst this should really be STATIC, it was not in 5.8.7, hence something
@@ -1163,7 +1169,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);
}
/* Cast because we're not changing function prototypes in maint, and this
function isn't actually static. */
@@ -1292,39 +1298,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);
@@ -1395,7 +1370,7 @@
#endif /* USE_5005THREADS */
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((char *) message, msglen);
End of Patch.
