Change 29858 by [EMAIL PROTECTED] on 2007/01/17 21:17:52
Integrate:
[ 26989]
Call gv_fetchpvn_flags where we already know the length.
[ 27005]
Avoid a warning from the Irix C compiler.
[ 27006]
Silence another Irix compiler warning.
[ 27014]
Silence a warning from the MS compiler about signed/unsigned mismatch.
[ 27056]
Death to magic characters! No pun intended.
[ 27064]
Fix file where internal XS functions are defined
[ 27086]
bcc was issuing a warning about this line in Perl_sv_2cv, so tweak it
to keep it happy.
[ 27089]
Without this Windows and Netware compilers should be complaining
about perl.c having code before a declaration, *but only if compiling
with PERL_TRACK_MEMPOOL*. So, will it fix the smoke failures? Place
bets now.
[ 27093]
Yes, I broke Win32 with change 27089 by having a { in the wrong place.
[ 27102]
Subject: [PATCH] Cleaning up shadowed variables
From: Andy Lester <[EMAIL PROTECTED]>
Date: Sun, 5 Feb 2006 21:56:43 -0600
Message-Id: <[EMAIL PROTECTED]>
[ 27112]
Given that the memory allocated in Perl_bytes_from_utf8 and
Perl_bytes_to_utf8 will immediately be written to, I see no need to
allocate it zeroed.
Affected files ...
... //depot/maint-5.8/perl/doio.c#88 integrate
... //depot/maint-5.8/perl/ext/B/B.xs#22 integrate
... //depot/maint-5.8/perl/hv.c#93 integrate
... //depot/maint-5.8/perl/op.c#158 integrate
... //depot/maint-5.8/perl/perl.c#182 integrate
... //depot/maint-5.8/perl/pp_ctl.c#139 integrate
... //depot/maint-5.8/perl/sv.c#285 integrate
... //depot/maint-5.8/perl/toke.c#132 edit
... //depot/maint-5.8/perl/universal.c#55 integrate
... //depot/maint-5.8/perl/utf8.c#62 integrate
... //depot/maint-5.8/perl/util.c#120 integrate
Differences ...
==== //depot/maint-5.8/perl/ext/B/B.xs#22 (text) ====
Index: perl/ext/B/B.xs
--- perl/ext/B/B.xs#21~29769~ 2007-01-12 03:55:51.000000000 -0800
+++ perl/ext/B/B.xs 2007-01-17 13:17:52.000000000 -0800
@@ -1308,7 +1308,7 @@
MgREGEX(mg)
B::MAGIC mg
CODE:
- if( mg->mg_type == 'r' ) {
+ if(mg->mg_type == PERL_MAGIC_qr) {
RETVAL = MgREGEX(mg);
}
else {
@@ -1321,7 +1321,7 @@
precomp(mg)
B::MAGIC mg
CODE:
- if (mg->mg_type == 'r') {
+ if (mg->mg_type == PERL_MAGIC_qr) {
REGEXP* rx = (REGEXP*)mg->mg_obj;
RETVAL = Nullsv;
if( rx )
==== //depot/maint-5.8/perl/hv.c#93 (text) ====
Index: perl/hv.c
--- perl/hv.c#92~29807~ 2007-01-14 05:09:22.000000000 -0800
+++ perl/hv.c 2007-01-17 13:17:52.000000000 -0800
@@ -595,7 +595,7 @@
}
if (is_utf8) {
- char * const keysave = (char * const)key;
+ char * const keysave = (char *)key;
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
if (is_utf8)
flags |= HVhek_UTF8;
==== //depot/maint-5.8/perl/op.c#158 (text) ====
Index: perl/op.c
--- perl/op.c#157~29809~ 2007-01-14 05:47:07.000000000 -0800
+++ perl/op.c 2007-01-17 13:17:52.000000000 -0800
@@ -4749,8 +4749,8 @@
if (gvcv) {
HV * const stash = GvSTASH(gvcv);
if (stash) {
- const char *name = HvNAME_get(stash);
- if ( strEQ(name,"autouse") ) {
+ const char *redefined_name = HvNAME_get(stash);
+ if ( strEQ(redefined_name,"autouse") ) {
const line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
CopLINE_set(PL_curcop, PL_copline);
==== //depot/maint-5.8/perl/perl.c#182 (text) ====
Index: perl/perl.c
--- perl/perl.c#181~29854~ 2007-01-17 10:52:01.000000000 -0800
+++ perl/perl.c 2007-01-17 13:17:52.000000000 -0800
@@ -1407,17 +1407,19 @@
#if defined(WIN32) || defined(NETWARE)
# if defined(PERL_IMPLICIT_SYS)
+ {
# ifdef NETWARE
- void *host = nw_internal_host;
+ void *host = nw_internal_host;
# else
- void *host = w32_internal_host;
+ void *host = w32_internal_host;
# endif
- PerlMem_free(aTHXx);
+ PerlMem_free(aTHXx);
# ifdef NETWARE
- nw_delete_internal_host(host);
+ nw_delete_internal_host(host);
# else
- win32_delete_internal_host(host);
+ win32_delete_internal_host(host);
# endif
+ }
# else
PerlMem_free(aTHXx);
# endif
==== //depot/maint-5.8/perl/pp_ctl.c#139 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#138~29809~ 2007-01-14 05:47:07.000000000 -0800
+++ perl/pp_ctl.c 2007-01-17 13:17:52.000000000 -0800
@@ -3430,12 +3430,12 @@
/* switch to eval mode */
if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {
- SV * const sv = sv_newmortal();
- Perl_sv_setpvf(aTHX_ sv, "_<(eval %lu)[%s:%"IVdf"]",
+ SV * const temp_sv = sv_newmortal();
+ Perl_sv_setpvf(aTHX_ temp_sv, "_<(eval %lu)[%s:%"IVdf"]",
(unsigned long)++PL_evalseq,
CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
- tmpbuf = SvPVX(sv);
- len = SvCUR(sv);
+ tmpbuf = SvPVX(temp_sv);
+ len = SvCUR(temp_sv);
}
else
#ifdef USE_SNPRINTF
==== //depot/maint-5.8/perl/sv.c#285 (text) ====
Index: perl/sv.c
--- perl/sv.c#284~29856~ 2007-01-17 11:49:29.000000000 -0800
+++ perl/sv.c 2007-01-17 13:17:52.000000000 -0800
@@ -6577,8 +6577,11 @@
GV *gv = NULL;
CV *cv = Nullcv;
- if (!sv)
- return *st = NULL, *gvp = NULL, NULL;
+ if (!sv) {
+ *st = NULL;
+ *gvp = NULL;
+ return NULL;
+ }
switch (SvTYPE(sv)) {
case SVt_PVCV:
*st = CvSTASH(sv);
==== //depot/maint-5.8/perl/toke.c#132 (text) ====
Index: perl/toke.c
--- perl/toke.c#131~29854~ 2007-01-17 10:52:01.000000000 -0800
+++ perl/toke.c 2007-01-17 13:17:52.000000000 -0800
@@ -219,8 +219,11 @@
TOKENTYPE_GVVAL
};
-static struct debug_tokens { const int token, type; const char *name; }
- const debug_tokens[] =
+static struct debug_tokens {
+ const int token;
+ enum token_type type;
+ const char *name;
+} const debug_tokens[] =
{
{ ADDOP, TOKENTYPE_OPNUM, "ADDOP" },
{ ANDAND, TOKENTYPE_NONE, "ANDAND" },
@@ -996,7 +999,8 @@
S_force_ident(pTHX_ register const char *s, int kind)
{
if (s && *s) {
- OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
+ const STRLEN len = strlen(s);
+ OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpvn(s, len));
PL_nextval[PL_nexttoke].opval = o;
force_next(WORD);
if (kind) {
@@ -1004,12 +1008,14 @@
/* XXX see note in pp_entereval() for why we forgo typo
warnings if the symbol must be introduced in an eval.
GSAR 96-10-12 */
- gv_fetchpv(s, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD,
- kind == '$' ? SVt_PV :
- kind == '@' ? SVt_PVAV :
- kind == '%' ? SVt_PVHV :
+ gv_fetchpvn_flags(s, len,
+ PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL)
+ : GV_ADD,
+ kind == '$' ? SVt_PV :
+ kind == '@' ? SVt_PVAV :
+ kind == '%' ? SVt_PVHV :
SVt_PVGV
- );
+ );
}
}
}
@@ -1995,9 +2001,10 @@
case '$':
weight -= seen[un_char] * 10;
if (isALNUM_lazy_if(s+1,UTF)) {
+ int len;
scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE);
- if ((int)strlen(tmpbuf) > 1
- && gv_fetchpv(tmpbuf, 0, SVt_PV))
+ len = (int)strlen(tmpbuf);
+ if (len > 1 && gv_fetchpvn_flags(tmpbuf, len, 0, SVt_PV))
weight -= 100;
else
weight -= 10;
@@ -2129,7 +2136,7 @@
tmpbuf[len] = '\0';
goto bare_package;
}
- indirgv = gv_fetchpv(tmpbuf, 0, SVt_PVCV);
+ indirgv = gv_fetchpvn_flags(tmpbuf, len, 0, SVt_PVCV);
if (indirgv && GvCVu(indirgv))
return 0;
/* filehandle or package name makes it a method */
@@ -2323,13 +2330,13 @@
if (len > 2 &&
(pkgname[len - 2] == ':' && pkgname[len - 1] == ':') &&
- (gv = gv_fetchpv(pkgname, 0, SVt_PVHV)))
+ (gv = gv_fetchpvn_flags(pkgname, len, 0, SVt_PVHV)))
{
return GvHV(gv); /* Foo:: */
}
/* use constant CLASS => 'MyClass' */
- if ((gv = gv_fetchpv(pkgname, 0, SVt_PVCV))) {
+ if ((gv = gv_fetchpvn_flags(pkgname, len, 0, SVt_PVCV))) {
SV *sv;
if (GvCV(gv) && (sv = cv_const_sv(GvCV(gv)))) {
pkgname = SvPV_nolen_const(sv);
@@ -4100,7 +4107,7 @@
GV *hgv = NULL; /* hidden (loser) */
if (PL_expect != XOPERATOR && (*s != ':' || s[1] != ':')) {
CV *cv;
- if ((gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV)) &&
+ if ((gv = gv_fetchpvn_flags(PL_tokenbuf, len, 0, SVt_PVCV)) &&
(cv = GvCVu(gv)))
{
if (GvIMPORTED_CV(gv))
@@ -4194,7 +4201,7 @@
PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
{
if (ckWARN(WARN_BAREWORD)
- && ! gv_fetchpv(PL_tokenbuf, 0, SVt_PVHV))
+ && ! gv_fetchpvn_flags(PL_tokenbuf, len, 0, SVt_PVHV))
Perl_warner(aTHX_ packWARN(WARN_BAREWORD),
"Bareword \"%s\" refers to nonexistent package",
PL_tokenbuf);
@@ -4209,8 +4216,8 @@
But also don't want to "initialise" any placeholder
constants that might already be there into full
blown PVGVs with attached PVCV. */
- gv = gv_fetchpv(PL_tokenbuf, GV_NOADD_NOINIT,
- SVt_PVCV);
+ gv = gv_fetchpvn_flags(PL_tokenbuf, len,
+ GV_NOADD_NOINIT, SVt_PVCV);
}
len = 0;
}
==== //depot/maint-5.8/perl/universal.c#55 (text) ====
Index: perl/universal.c
--- perl/universal.c#54~29802~ 2007-01-13 16:36:51.000000000 -0800
+++ perl/universal.c 2007-01-17 13:17:52.000000000 -0800
@@ -190,7 +190,7 @@
void
Perl_boot_core_UNIVERSAL(pTHX)
{
- const char file[] = __FILE__;
+ static const char file[] = __FILE__;
newXS("UNIVERSAL::isa", XS_UNIVERSAL_isa, (char
*)file);
newXS("UNIVERSAL::can", XS_UNIVERSAL_can, (char
*)file);
==== //depot/maint-5.8/perl/utf8.c#62 (text) ====
Index: perl/utf8.c
--- perl/utf8.c#61~29802~ 2007-01-13 16:36:51.000000000 -0800
+++ perl/utf8.c 2007-01-17 13:17:52.000000000 -0800
@@ -815,7 +815,7 @@
*is_utf8 = 0;
- Newxz(d, (*len) - count + 1, U8);
+ Newx(d, (*len) - count + 1, U8);
s2 = start; start = d;
while (s2 < send) {
U8 c = *s2++;
@@ -851,7 +851,7 @@
U8 *d;
U8 *dst;
- Newxz(d, (*len) * 2 + 1, U8);
+ Newx(d, (*len) * 2 + 1, U8);
dst = d;
while (s < send) {
==== //depot/maint-5.8/perl/util.c#120 (text) ====
Index: perl/util.c
--- perl/util.c#119~29846~ 2007-01-17 03:36:40.000000000 -0800
+++ perl/util.c 2007-01-17 13:17:52.000000000 -0800
@@ -4331,8 +4331,8 @@
fd_set rset;
FD_ZERO(&rset);
- FD_SET(sockets[0], &rset);
- FD_SET(sockets[1], &rset);
+ FD_SET((unsigned int)sockets[0], &rset);
+ FD_SET((unsigned int)sockets[1], &rset);
got = PerlSock_select(max + 1, &rset, NULL, NULL, &waitfor);
if (got != 2 || !FD_ISSET(sockets[0], &rset)
End of Patch.
