Change 33813 by [EMAIL PROTECTED] on 2008/05/10 16:43:45
Integrate:
[ 33614]
Integrate:
[ 33239]
in unpack, () groups in scalar context were still returning a list,
resulting in garbage on the stack, which could manifest as a SEGV
(Bug 50256)
[ 33296]
Subject: [PATCH] Unused var in perlio.c (revised)
From: "Jerry D. Hedden" <[EMAIL PROTECTED]>
Date: Tue, 12 Feb 2008 10:00:18 -0500
Message-ID: <[EMAIL PROTECTED]>
[ 33301]
Subject: [PATCH] PERL_MAGIC_uvar_elem should be 'u' in dump.c
From: "Vincent Pit" <[EMAIL PROTECTED]>
Date: Wed, 13 Feb 2008 11:10:11 +0100 (CET)
Message-ID: <[EMAIL PROTECTED]>
[ 33334]
Enable caching of strxfrm() results also for readonly SVs as
returned e.g. by "keys %hash". This speeds up sorting of lots
of hash keys significantly. See also:
Subject: Slowdown of "sort keys %hash" under "use locale"
From: Marcus Holland-Moritz <[EMAIL PROTECTED]>
Date: Fri, 15 Feb 2008 17:00:15 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 33388]
Do the memory debug header fixup earlier to avoid valgrind screaming
under -Dm. Also, temporarily disable memory logging during thread
memory freeing, as otherwise we try to log using memory we already
freed.
[ 33407]
Subject: [PATCH] for -M:Foo, extended and revised
From: "Robin Barker" <[EMAIL PROTECTED]>
Date: Wed, 27 Feb 2008 19:19:54 -0000
Message-ID: <[EMAIL PROTECTED]>
[ 33408]
Subject: Re: interrupting system() with signal depends on signal
handler
From: Steffen Ullrich <[EMAIL PROTECTED]>
Date: Tue, 26 Feb 2008 19:43:00 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 33495]
Subject: [perl #51636] segmentation fault with array ties
From: [EMAIL PROTECTED] (via RT) <[EMAIL PROTECTED]>
Date: Wed, 12 Mar 2008 02:59:45 -0700
Message-ID: <[EMAIL PROTECTED]>
[ 33595]
Subject: [PATCH] do not use SVTYPEMASK to prevent cleaning of PL_fdpid
and PL_strtab
From: Gerard Goossen <[EMAIL PROTECTED]>
Message-ID: <[EMAIL PROTECTED]>
Date: Wed, 26 Mar 2008 14:07:13 +0100
[ 33596]
Fix compiler warning about comparison of pointer types.
[except change 33495, which turns out to be in some code that MRO
added]
Affected files ...
... //depot/maint-5.8/perl/dump.c#86 integrate
... //depot/maint-5.8/perl/perl.c#230 integrate
... //depot/maint-5.8/perl/perlio.c#121 integrate
... //depot/maint-5.8/perl/pp_pack.c#62 integrate
... //depot/maint-5.8/perl/sv.c#383 integrate
... //depot/maint-5.8/perl/t/op/pack.t#32 integrate
... //depot/maint-5.8/perl/t/run/switches.t#10 integrate
... //depot/maint-5.8/perl/util.c#164 integrate
Differences ...
==== //depot/maint-5.8/perl/dump.c#86 (text) ====
Index: perl/dump.c
--- perl/dump.c#85~33465~ 2008-03-10 14:18:14.000000000 -0700
+++ perl/dump.c 2008-05-10 09:43:45.000000000 -0700
@@ -981,7 +981,7 @@
{ PERL_MAGIC_qr, "qr(r)" },
{ PERL_MAGIC_sigelem, "sigelem(s)" },
{ PERL_MAGIC_taint, "taint(t)" },
- { PERL_MAGIC_uvar_elem, "uvar_elem(v)" },
+ { PERL_MAGIC_uvar_elem, "uvar_elem(u)" },
{ PERL_MAGIC_vec, "vec(v)" },
{ PERL_MAGIC_vstring, "v-string(V)" },
{ PERL_MAGIC_utf8, "utf8(w)" },
==== //depot/maint-5.8/perl/perl.c#230 (text) ====
Index: perl/perl.c
--- perl/perl.c#229~33454~ 2008-03-08 15:09:00.000000000 -0800
+++ perl/perl.c 2008-05-10 09:43:45.000000000 -0700
@@ -1203,18 +1203,11 @@
}
/* Now absolutely destruct everything, somehow or other, loops or no. */
- SvFLAGS(PL_fdpid) |= SVTYPEMASK; /* don't clean out pid table
now */
- SvFLAGS(PL_strtab) |= SVTYPEMASK; /* don't clean out strtab now */
/* the 2 is for PL_fdpid and PL_strtab */
- while (PL_sv_count > 2 && sv_clean_all())
+ while (sv_clean_all() > 2)
;
- SvFLAGS(PL_fdpid) &= ~SVTYPEMASK;
- SvFLAGS(PL_fdpid) |= SVt_PVAV;
- SvFLAGS(PL_strtab) &= ~SVTYPEMASK;
- SvFLAGS(PL_strtab) |= SVt_PVHV;
-
AvREAL_off(PL_fdpid); /* no surviving entries */
SvREFCNT_dec(PL_fdpid); /* needed in io_close() */
PL_fdpid = NULL;
@@ -1434,10 +1427,17 @@
*/
const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL");
if (!s || atoi(s) == 0) {
+ const U32 old_debug = PL_debug;
/* Emulate the PerlHost behaviour of free()ing all memory allocated
in this
thread at thread exit. */
+ if (DEBUG_m_TEST) {
+ PerlIO_puts(Perl_debug_log, "Disabling memory debugging as we "
+ "free this thread's memory\n");
+ PL_debug &= ~ DEBUG_m_FLAG;
+ }
while(aTHXx->Imemory_debug_header.next !=
&(aTHXx->Imemory_debug_header))
safesysfree(sTHX + (char *)(aTHXx->Imemory_debug_header.next));
+ PL_debug = old_debug;
}
}
#endif
@@ -3092,6 +3092,7 @@
Perl_moreswitches(pTHX_ char *s)
{
UV rschar;
+ const char option = *s; /* used to remember option in -m/-M code */
switch (*s) {
case '0':
@@ -3290,6 +3291,7 @@
const char *end;
SV *sv;
const char *use = "use ";
+ bool colon = FALSE;
/* -M-foo == 'no foo' */
/* Leading space on " no " is deliberate, to make both
possibilities the same length. */
@@ -3297,19 +3299,30 @@
sv = newSVpvn(use,4);
start = s;
/* We allow -M'Module qw(Foo Bar)' */
- while(isALNUM(*s) || *s==':') ++s;
+ while(isALNUM(*s) || *s==':') {
+ if( *s++ == ':' ) {
+ if( *s == ':' )
+ s++;
+ else
+ colon = TRUE;
+ }
+ }
+ if (s == start)
+ Perl_croak(aTHX_ "Module name required with -%c option",
+ option);
+ if (colon)
+ Perl_croak(aTHX_ "Invalid module name %.*s with -%c option: "
+ "contains single ':'",
+ s - start, start, option);
end = s + strlen(s);
if (*s != '=') {
sv_catpvn(sv, start, end - start);
- if (*(start-1) == 'm') {
+ if (option == 'm') {
if (*s != '\0')
Perl_croak(aTHX_ "Can't use '%c' after -mname", *s);
sv_catpvs( sv, " ()");
}
} else {
- if (s == start)
- Perl_croak(aTHX_ "Module name required with -%c option",
- s[-1]);
sv_catpvn(sv, start, s-start);
/* Use NUL as q''-delimiter. */
sv_catpvs(sv, " split(/,/,q\0");
@@ -3321,7 +3334,7 @@
Perl_av_create_and_push(aTHX_ &PL_preambleav, sv);
}
else
- Perl_croak(aTHX_ "Missing argument to -%c", *(s-1));
+ Perl_croak(aTHX_ "Missing argument to -%c", option);
return s;
case 'n':
PL_minus_n = TRUE;
==== //depot/maint-5.8/perl/perlio.c#121 (text) ====
Index: perl/perlio.c
--- perl/perlio.c#120~33593~ 2008-03-28 12:45:31.000000000 -0700
+++ perl/perlio.c 2008-05-10 09:43:45.000000000 -0700
@@ -4118,6 +4118,9 @@
PerlIOBuf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
{
PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
+#ifndef DEBUGGING
+ PERL_UNUSED_ARG(cnt);
+#endif
if (!b->buf)
PerlIO_get_base(f);
b->ptr = ptr;
==== //depot/maint-5.8/perl/pp_pack.c#62 (text) ====
Index: perl/pp_pack.c
--- perl/pp_pack.c#61~33497~ 2008-03-12 11:44:49.000000000 -0700
+++ perl/pp_pack.c 2008-05-10 09:43:45.000000000 -0700
@@ -1288,6 +1288,7 @@
symptr->previous = &savsym;
symptr->level++;
PUTBACK;
+ if (len && unpack_only_one) len = 1;
while (len--) {
symptr->patptr = savsym.grpbeg;
if (utf8) symptr->flags |= FLAG_PARSE_UTF8;
==== //depot/maint-5.8/perl/sv.c#383 (text) ====
Index: perl/sv.c
--- perl/sv.c#382~33600~ 2008-03-29 09:07:55.000000000 -0700
+++ perl/sv.c 2008-05-10 09:43:45.000000000 -0700
@@ -471,6 +471,10 @@
static void
do_clean_all(pTHX_ SV *sv)
{
+ if (sv == (SV*) PL_fdpid || sv == (SV *)PL_strtab) {
+ /* don't clean pid table and strtab */
+ return;
+ }
DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at
0x%"UVxf"\n", PTR2UV(sv)) ));
SvFLAGS(sv) |= SVf_BREAK;
SvREFCNT_dec(sv);
@@ -5677,11 +5681,6 @@
Safefree(mg->mg_ptr);
s = SvPV_const(sv, len);
if ((xf = mem_collxfrm(s, len, &xlen))) {
- if (SvREADONLY(sv)) {
- SAVEFREEPV(xf);
- *nxp = xlen;
- return xf + sizeof(PL_collation_ix);
- }
if (! mg) {
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW(sv))
==== //depot/maint-5.8/perl/t/op/pack.t#32 (xtext) ====
Index: perl/t/op/pack.t
--- perl/t/op/pack.t#31~32379~ 2007-11-17 12:42:55.000000000 -0800
+++ perl/t/op/pack.t 2008-05-10 09:43:45.000000000 -0700
@@ -14,7 +14,7 @@
"Signed/unsigned pack modifiers not available on this perl";
my $only510 = 414;
-plan tests => 14283 + ($] > 5.009 ? $only510 : 0);
+plan tests => 14284 + ($] > 5.009 ? $only510 : 0);
use strict;
# use warnings qw(FATAL all);
@@ -2031,3 +2031,8 @@
is(unpack('@!4 a*', "\x{301}\x{302}\x{303}\x{304}\x{305}"),
"\x{303}\x{304}\x{305}", 'Test basic utf8 @!');
}
+{
+ #50256
+ my ($v) = split //, unpack ('(B)*', 'ab');
+ is($v, 0); # Doesn't SEGV :-)
+}
==== //depot/maint-5.8/perl/t/run/switches.t#10 (text) ====
Index: perl/t/run/switches.t
--- perl/t/run/switches.t#9~32379~ 2007-11-17 12:42:55.000000000 -0800
+++ perl/t/run/switches.t 2008-05-10 09:43:45.000000000 -0700
@@ -11,7 +11,7 @@
BEGIN { require "./test.pl"; }
-plan(tests => 59);
+plan(tests => 65);
use Config;
@@ -194,6 +194,34 @@
);
is( $r, '<swtest><foo><bar>', '-m with import parameters' );
push @tmpfiles, $filename;
+
+ is( runperl( switches => [ '-MTie::Hash' ], stderr => 1, prog => 1 ),
+ '', "-MFoo::Bar allowed" );
+
+ like( runperl( switches => [ '-M:swtest' ], stderr => 1,
+ prog => 'die "oops"' ),
+ qr/Invalid module name [\w:]+ with -M option\b/,
+ "-M:Foo not allowed" );
+
+ like( runperl( switches => [ '-mA:B:C' ], stderr => 1,
+ prog => 'die "oops"' ),
+ qr/Invalid module name [\w:]+ with -m option\b/,
+ "-mFoo:Bar not allowed" );
+
+ like( runperl( switches => [ '-m-A:B:C' ], stderr => 1,
+ prog => 'die "oops"' ),
+ qr/Invalid module name [\w:]+ with -m option\b/,
+ "-m-Foo:Bar not allowed" );
+
+ like( runperl( switches => [ '-m-' ], stderr => 1,
+ prog => 'die "oops"' ),
+ qr/Module name required with -m option\b/,
+ "-m- not allowed" );
+
+ like( runperl( switches => [ '-M-=' ], stderr => 1,
+ prog => 'die "oops"' ),
+ qr/Module name required with -M option\b/,
+ "-M- not allowed" );
}
# Tests for -V
==== //depot/maint-5.8/perl/util.c#164 (text) ====
Index: perl/util.c
--- perl/util.c#163~33428~ 2008-03-03 13:34:54.000000000 -0800
+++ perl/util.c 2008-05-10 09:43:45.000000000 -0700
@@ -177,11 +177,11 @@
ptr = (Malloc_t)PerlMem_realloc(where,size);
PERL_ALLOC_CHECK(ptr);
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld)
rfree\n",PTR2UV(where),(long)PL_an++));
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld
bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
-
- if (ptr != NULL) {
+ /* MUST do this fixup first, before doing ANYTHING else, as anything else
+ might allocate memory/free/move memory, and until we do the fixup, it
+ may well be chasing (and writing to) free memory. */
#ifdef PERL_TRACK_MEMPOOL
+ if (ptr != NULL) {
struct perl_memory_debug_header *const header
= (struct perl_memory_debug_header *)ptr;
@@ -197,7 +197,17 @@
header->prev->next = header;
ptr = (Malloc_t)((char*)ptr+sTHX);
+ }
#endif
+
+ /* In particular, must do that fixup above before logging anything via
+ *printf(), as it can reallocate memory, which can cause SEGVs. */
+
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld)
rfree\n",PTR2UV(where),(long)PL_an++));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld
bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
+
+
+ if (ptr != NULL) {
return ptr;
}
else if (PL_nomemok)
@@ -2905,6 +2915,7 @@
#endif
if (result < 0 && errno == EINTR) {
PERL_ASYNC_CHECK();
+ errno = EINTR; /* reset in case a signal handler changed $! */
}
return result;
}
End of Patch.
