Change 30006 by [EMAIL PROTECTED] on 2007/01/26 12:19:35
Integrate:
[ 27853]
stop PL_op and PL_curpad referring to different pads at start of doeval
(this could make find_uninit_var do Bad Things)
[ 28523]
Fix a signed/unsigned warning
[ 28524]
Add a macro to remove duplicated code
Subject: Re: cut-and-paste findings for blead 28504
From: SADAHIRO Tomoyuki <[EMAIL PROTECTED]>
Date: Sun, 09 Jul 2006 13:47:04 +0900
Message-Id: <[EMAIL PROTECTED]>
[ 28534]
Silence empty if-statement warning.
[ 28535]
Fix another empty if-statement warning
[ 28541]
Subject: [PATCH] Re: [perl #39634] gcc 3.3 has problems with
__attribute__((unused))
From: Andy Dougherty <[EMAIL PROTECTED]>
Date: Mon, 10 Jul 2006 13:16:27 -0400 (EDT)
Message-ID: <[EMAIL PROTECTED]>
[ 28565]
Clear up a few more warnings from blead.
[ 28578]
Subject: [PATCH] various safety/portability tweaks
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Sat, 15 Jul 2006 13:14:32 +0300
Message-ID: <[EMAIL PROTECTED]>
[ 28583]
Subject: [PATCH] comment update for scan_const
From: SADAHIRO Tomoyuki <[EMAIL PROTECTED]>
Date: Sat, 15 Jul 2006 20:16:01 +0900
Message-Id: <[EMAIL PROTECTED]>
[ 28585]
[PATCH] Re: [PATCH] various safety/portability tweaks
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Sat, 15 Jul 2006 22:15:29 +0300
Message-ID: <[EMAIL PROTECTED]>
Fix for change #28578.
Affected files ...
... //depot/maint-5.8/perl/doio.c#97 integrate
... //depot/maint-5.8/perl/op.c#185 integrate
... //depot/maint-5.8/perl/perl.c#195 integrate
... //depot/maint-5.8/perl/perl.h#140 integrate
... //depot/maint-5.8/perl/pp_ctl.c#162 integrate
... //depot/maint-5.8/perl/pp_sort.c#46 integrate
... //depot/maint-5.8/perl/pp_sys.c#133 integrate
... //depot/maint-5.8/perl/reentr.c#18 integrate
... //depot/maint-5.8/perl/reentr.pl#26 integrate
... //depot/maint-5.8/perl/sv.c#324 integrate
... //depot/maint-5.8/perl/toke.c#153 integrate
... //depot/maint-5.8/perl/universal.c#61 integrate
... //depot/maint-5.8/perl/util.c#133 integrate
Differences ...
==== //depot/maint-5.8/perl/doio.c#97 (text) ====
Index: perl/doio.c
--- perl/doio.c#96~29996~ 2007-01-26 01:54:13.000000000 -0800
+++ perl/doio.c 2007-01-26 04:19:35.000000000 -0800
@@ -2290,7 +2290,7 @@
STRLEN len;
const char *mbuf = SvPV_const(mstr, len);
- const I32 n = (len > msize) ? msize : len;
+ const I32 n = ((I32)len > msize) ? msize : (I32)len;
Copy(mbuf, shm + mpos, n, char);
if (n < msize)
memzero(shm + mpos + n, msize - n);
==== //depot/maint-5.8/perl/op.c#185 (text) ====
Index: perl/op.c
--- perl/op.c#184~29999~ 2007-01-26 03:02:10.000000000 -0800
+++ perl/op.c 2007-01-26 04:19:35.000000000 -0800
@@ -2079,7 +2079,7 @@
Perl_fold_constants(pTHX_ register OP *o)
{
register OP *curop;
- I32 type = o->op_type;
+ volatile I32 type = o->op_type;
SV *sv = NULL;
int ret = 0;
I32 oldscope;
==== //depot/maint-5.8/perl/perl.c#195 (text) ====
Index: perl/perl.c
--- perl/perl.c#194~29999~ 2007-01-26 03:02:10.000000000 -0800
+++ perl/perl.c 2007-01-26 04:19:35.000000000 -0800
@@ -5159,7 +5159,7 @@
if (addoldvers) {
for (incver = incverlist; *incver; incver++) {
/* .../xxx if -d .../xxx */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, libdir,
*incver);
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, (void
*)libdir, *incver);
subdir = S_incpush_if_exists(aTHX_ subdir);
}
}
==== //depot/maint-5.8/perl/perl.h#140 (text) ====
Index: perl/perl.h
--- perl/perl.h#139~29999~ 2007-01-26 03:02:10.000000000 -0800
+++ perl/perl.h 2007-01-26 04:19:35.000000000 -0800
@@ -2524,9 +2524,11 @@
# define HASATTRIBUTE_PURE
# endif
# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
- /* This actually works for gcc-3.3, but not for g++-3.3. */
# define HASATTRIBUTE_UNUSED
# endif
+# if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus)
+# define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */
+# endif
# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
# define HASATTRIBUTE_WARN_UNUSED_RESULT
# endif
==== //depot/maint-5.8/perl/pp_ctl.c#162 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#161~29995~ 2007-01-26 01:31:24.000000000 -0800
+++ perl/pp_ctl.c 2007-01-26 04:19:35.000000000 -0800
@@ -2799,6 +2799,7 @@
/* set up a scratch pad */
CvPADLIST(PL_compcv) = pad_new(padnew_SAVE);
+ PL_op = NULL; /* avoid PL_op and PL_curpad referring to different CVs */
SAVEMORTALIZESV(PL_compcv); /* must remain until end of current
statement */
==== //depot/maint-5.8/perl/pp_sort.c#46 (text) ====
Index: perl/pp_sort.c
--- perl/pp_sort.c#45~29997~ 2007-01-26 02:30:23.000000000 -0800
+++ perl/pp_sort.c 2007-01-26 04:19:35.000000000 -0800
@@ -1852,6 +1852,8 @@
? amagic_call(left, right, CAT2(meth,_amg), 0) \
: NULL;
+#define SORT_NORMAL_RETURN_VALUE(val) (((val) > 0) ? 1 : ((val) ? -1 : 0))
+
static I32
S_amagic_ncmp(pTHX_ register SV *a, register SV *b)
{
@@ -1859,15 +1861,11 @@
if (tmpsv) {
if (SvIOK(tmpsv)) {
const I32 i = SvIVX(tmpsv);
- if (i > 0)
- return 1;
- return i? -1 : 0;
+ return SORT_NORMAL_RETURN_VALUE(i);
}
else {
const NV d = SvNV(tmpsv);
- if (d > 0)
- return 1;
- return d ? -1 : 0;
+ return SORT_NORMAL_RETURN_VALUE(d);
}
}
return S_sv_ncmp(aTHX_ a, b);
@@ -1880,15 +1878,11 @@
if (tmpsv) {
if (SvIOK(tmpsv)) {
const I32 i = SvIVX(tmpsv);
- if (i > 0)
- return 1;
- return i? -1 : 0;
+ return SORT_NORMAL_RETURN_VALUE(i);
}
else {
const NV d = SvNV(tmpsv);
- if (d > 0)
- return 1;
- return d ? -1 : 0;
+ return SORT_NORMAL_RETURN_VALUE(d);
}
}
return S_sv_i_ncmp(aTHX_ a, b);
@@ -1901,15 +1895,11 @@
if (tmpsv) {
if (SvIOK(tmpsv)) {
const I32 i = SvIVX(tmpsv);
- if (i > 0)
- return 1;
- return i? -1 : 0;
+ return SORT_NORMAL_RETURN_VALUE(i);
}
else {
const NV d = SvNV(tmpsv);
- if (d > 0)
- return 1;
- return d? -1 : 0;
+ return SORT_NORMAL_RETURN_VALUE(d);
}
}
return sv_cmp(str1, str2);
@@ -1922,15 +1912,11 @@
if (tmpsv) {
if (SvIOK(tmpsv)) {
const I32 i = SvIVX(tmpsv);
- if (i > 0)
- return 1;
- return i? -1 : 0;
+ return SORT_NORMAL_RETURN_VALUE(i);
}
else {
const NV d = SvNV(tmpsv);
- if (d > 0)
- return 1;
- return d? -1 : 0;
+ return SORT_NORMAL_RETURN_VALUE(d);
}
}
return sv_cmp_locale(str1, str2);
==== //depot/maint-5.8/perl/pp_sys.c#133 (text) ====
Index: perl/pp_sys.c
--- perl/pp_sys.c#132~29993~ 2007-01-26 01:15:17.000000000 -0800
+++ perl/pp_sys.c 2007-01-26 04:19:35.000000000 -0800
@@ -3526,7 +3526,8 @@
*s++ = '\\';
*s++ = *filename++;
}
- strcpy(s, " 2>&1");
+ if (s - cmdline < size)
+ my_strlcpy(s, " 2>&1", size - (s - cmdline));
myfp = PerlProc_popen(cmdline, "r");
Safefree(cmdline);
==== //depot/maint-5.8/perl/reentr.c#18 (text) ====
Index: perl/reentr.c
--- perl/reentr.c#17~29804~ 2007-01-14 04:22:41.000000000 -0800
+++ perl/reentr.c 2007-01-26 04:19:35.000000000 -0800
@@ -527,6 +527,8 @@
}
va_end(ap);
+#else
+ PERL_UNUSED_ARG(f);
#endif
return retptr;
}
==== //depot/maint-5.8/perl/reentr.pl#26 (text) ====
Index: perl/reentr.pl
--- perl/reentr.pl#25~26575~ 2006-01-02 07:26:23.000000000 -0800
+++ perl/reentr.pl 2007-01-26 04:19:35.000000000 -0800
@@ -1141,6 +1141,8 @@
}
va_end(ap);
+#else
+ PERL_UNUSED_ARG(f);
#endif
return retptr;
}
==== //depot/maint-5.8/perl/sv.c#324 (text) ====
Index: perl/sv.c
--- perl/sv.c#323~30003~ 2007-01-26 03:36:22.000000000 -0800
+++ perl/sv.c 2007-01-26 04:19:35.000000000 -0800
@@ -2716,7 +2716,7 @@
/* some Xenix systems wipe out errno here */
#ifdef apollo
if (SvNVX(sv) == 0.0)
- (void)strcpy(s,"0");
+ my_strlcpy(s, "0", SvLEN(sv));
else
#endif /*apollo*/
{
@@ -2725,7 +2725,7 @@
errno = olderrno;
#ifdef FIXNEGATIVEZERO
if (*s == '-' && s[1] == '0' && !s[2])
- strcpy(s,"0");
+ my_strlcpy(s, "0", SvLEN(s));
#endif
while (*s) s++;
#ifdef hcx
@@ -3648,8 +3648,10 @@
if (SvPVX_const(sv))
SvPV_free(sv);
+#ifdef DEBUGGING
if (flags & SV_HAS_TRAILING_NUL)
assert(ptr[len] == '\0');
+#endif
allocate = (flags & SV_HAS_TRAILING_NUL)
? len + 1: PERL_STRLEN_ROUNDUP(len + 1);
==== //depot/maint-5.8/perl/toke.c#153 (text) ====
Index: perl/toke.c
--- perl/toke.c#152~29999~ 2007-01-26 03:02:10.000000000 -0800
+++ perl/toke.c 2007-01-26 04:19:35.000000000 -0800
@@ -1350,12 +1350,12 @@
Extracts a pattern, double-quoted string, or transliteration. This
is terrifying code.
- It looks at lex_inwhat and PL_lex_inpat to find out whether it's
+ It looks at PL_lex_inwhat and PL_lex_inpat to find out whether it's
processing a pattern (PL_lex_inpat is true), a transliteration
- (lex_inwhat & OP_TRANS is true), or a double-quoted string.
+ (PL_lex_inwhat == OP_TRANS is true), or a double-quoted string.
- Returns a pointer to the character scanned up to. Iff this is
- advanced from the start pointer supplied (ie if anything was
+ Returns a pointer to the character scanned up to. If this is
+ advanced from the start pointer supplied (i.e. if anything was
successfully parsed), will leave an OP for the substring scanned
in yylval. Caller must intuit reason for not parsing further
by looking at the next characters herself.
@@ -1364,21 +1364,23 @@
backslashes:
double-quoted style: \r and \n
regexp special ones: \D \s
- constants: \x3
- backrefs: \1 (deprecated in substitution replacements)
+ constants: \x31
+ backrefs: \1
case and quoting: \U \Q \E
stops on @ and $, but not for $ as tail anchor
In transliterations:
characters are VERY literal, except for - not at the start or end
- of the string, which indicates a range. scan_const expands the
- range to the full set of intermediate characters.
+ of the string, which indicates a range. If the range is in bytes,
+ scan_const expands the range to the full set of intermediate
+ characters. If the range is in utf8, the hyphen is replaced with
+ a certain range mark which will be handled by pmtrans() in op.c.
In double-quoted strings:
backslashes:
double-quoted style: \r and \n
- constants: \x3
- backrefs: \1 (deprecated)
+ constants: \x31
+ deprecated backrefs: \1 (in substitution replacements)
case and quoting: \U \Q \E
stops on @ and $
@@ -1386,31 +1388,35 @@
It stops processing as soon as it finds an embedded $ or @ variable
and leaves it to the caller to work out what's going on.
- @ in pattern could be: @foo, @{foo}, @$foo, @'foo, @::foo.
+ embedded arrays (whether in pattern or not) could be:
+ @foo, @::foo, @'foo, @{foo}, @$foo, @+, @-.
+
+ $ in double-quoted strings must be the symbol of an embedded scalar.
$ in pattern could be $foo or could be tail anchor. Assumption:
it's a tail anchor if $ is the last thing in the string, or if it's
- followed by one of ")| \n\t"
+ followed by one of "()| \r\n\t"
\1 (backreferences) are turned into $1
The structure of the code is
while (there's a character to process) {
- handle transliteration ranges
- skip regexp comments
- skip # initiated comments in //x patterns
- check for embedded @foo
+ handle transliteration ranges
+ skip regexp comments /(?#comment)/ and codes /(?{code})/
+ skip #-initiated comments in //x patterns
+ check for embedded arrays
check for embedded scalars
if (backslash) {
- leave intact backslashes from leave (below)
- deprecate \1 in strings and sub replacements
+ leave intact backslashes from leaveit (below)
+ deprecate \1 in substitution replacements
handle string-changing backslashes \l \U \Q \E, etc.
switch (what was escaped) {
- handle - in a transliteration (becomes a literal -)
- handle \132 octal characters
- handle 0x15 hex characters
- handle \cV (control V)
- handle printf backslashes (\f, \r, \n, etc)
+ handle \- in a transliteration (becomes a literal -)
+ handle \132 (octal characters)
+ handle \x15 and \x{1234} (hex characters)
+ handle \N{name} (named characters)
+ handle \cV (control characters)
+ handle printf-style backslashes (\f, \r, \n, etc)
} (end switch)
} (end if backslash)
} (end while character to read)
==== //depot/maint-5.8/perl/universal.c#61 (text) ====
Index: perl/universal.c
--- perl/universal.c#60~30004~ 2007-01-26 03:57:08.000000000 -0800
+++ perl/universal.c 2007-01-26 04:19:35.000000000 -0800
@@ -68,9 +68,11 @@
SV** const svp = (SV**)hv_fetch(hv, name, len, FALSE);
if (svp) {
SV * const sv = *svp;
+#ifdef DEBUGGING
if (sv != &PL_sv_undef)
DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package
%s\n",
name, hvname) );
+#endif
return (sv == &PL_sv_yes);
}
}
==== //depot/maint-5.8/perl/util.c#133 (text) ====
Index: perl/util.c
--- perl/util.c#132~29999~ 2007-01-26 03:02:10.000000000 -0800
+++ perl/util.c 2007-01-26 04:19:35.000000000 -0800
@@ -4805,7 +4805,7 @@
{
const STRLEN len =
my_snprintf(buf,
- PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+ sizeof(buf),
# ifdef PERL_MEM_LOG_TIMESTAMP
"%10d.%06d: "
# endif
@@ -4850,7 +4850,7 @@
{
const STRLEN len =
my_snprintf(buf,
- PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+ sizeof(buf),
# ifdef PERL_MEM_LOG_TIMESTAMP
"%10d.%06d: "
# endif
@@ -4896,7 +4896,7 @@
{
const STRLEN len =
my_snprintf(buf,
- PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+ sizeof(buf),
# ifdef PERL_MEM_LOG_TIMESTAMP
"%10d.%06d: "
# endif
@@ -5037,17 +5037,17 @@
(void)clearenv();
# elif defined(HAS_UNSETENV)
int bsiz = 80; /* Most envvar names will be shorter than this. */
- char *buf = (char*)safesysmalloc(bsiz * sizeof(char));
+ int bufsiz = bsiz * sizeof(char); /* sizeof(char) paranoid? */
+ char *buf = (char*)safesysmalloc(bufsiz);
while (*environ != NULL) {
char *e = strchr(*environ, '=');
int l = e ? e - *environ : strlen(*environ);
if (bsiz < l + 1) {
(void)safesysfree(buf);
- bsiz = l + 1;
- buf = (char*)safesysmalloc(bsiz * sizeof(char));
+ bsiz = l + 1; /* + 1 for the \0. */
+ buf = (char*)safesysmalloc(bufsiz);
}
- strncpy(buf, *environ, l);
- *(buf + l) = '\0';
+ my_strlcpy(buf, *environ, l + 1);
(void)unsetenv(buf);
}
(void)safesysfree(buf);
End of Patch.
