Change 34279 by [EMAIL PROTECTED] on 2008/09/05 19:03:34
Integrate:
[ 34260]
Integrate:
[ 34128]
In Perl_sv_utf8_upgrade_flags(), don't assume that the SV is well
formed with a trailing '\0'. And do assume that bytes_to_utf8() does.
[ 34234]
Fix #30660: Repeated spaces on shebang line stops option parsing
From a patch and test sent by Renée Bäcker in
<[EMAIL PROTECTED]>
[ 34261]
Integrate:
[ 34055]
Subject: [perl #55786] [PATCH blead] Re: Overload Segfaulting
From: Rick Delaney (via RT) <[EMAIL PROTECTED]>
Date: Sat, 14 Jun 2008 11:51:01 -0700
Message-ID: <[EMAIL PROTECTED]>
[ 34067]
Subject: [perl #46309] Buffer overflow in win32_select() (PATCH
included)
From: Risto Kankkunen (via RT) <[EMAIL PROTECTED]>
Date: Wed, 10 Oct 2007 02:44:13 -0700
Message-ID: <[EMAIL PROTECTED]>
[ 34263]
Integrate:
[ 34076]
Subject: Re: [perl #46381] "Out of memory ... sbrk()" on FreeBSD-6.x
for v.5.8.x but not v.5.6.x
From: Slaven Rezic <[EMAIL PROTECTED]>
Date: 26 Oct 2007 16:58:55 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 34078]
Subject: [PATCH] Fix malloc.c warning
From: "Jerry D. Hedden" <[EMAIL PROTECTED]>
Date: Mon, 23 Jun 2008 09:41:11 -0400
Message-ID: <[EMAIL PROTECTED]>
[ 34267]
Integrate:
[ 34225]
Subject: [PATCH] Safer environ iteration
From: "Milosz Tanski" <[EMAIL PROTECTED]>
Date: Tue, 5 Aug 2008 18:33:02 -0400
Message-ID: <[EMAIL PROTECTED]>
[ 34275]
Integrate:
[ 34220]
Don't add freed SVF_BREAK scalars to the freed list.
This may still be referenced, so don't reuse.
Affected files ...
... //depot/maint-5.8/perl/lib/overload.pm#16 integrate
... //depot/maint-5.8/perl/lib/overload.t#17 integrate
... //depot/maint-5.8/perl/malloc.c#27 integrate
... //depot/maint-5.8/perl/perl.c#232 integrate
... //depot/maint-5.8/perl/pp.h#26 integrate
... //depot/maint-5.8/perl/sv.c#385 integrate
... //depot/maint-5.8/perl/t/run/switches.t#11 integrate
... //depot/maint-5.8/perl/win32/win32sck.c#9 integrate
Differences ...
==== //depot/maint-5.8/perl/lib/overload.pm#16 (text) ====
Index: perl/lib/overload.pm
--- perl/lib/overload.pm#15~32424~ 2007-11-20 08:06:10.000000000 -0800
+++ perl/lib/overload.pm 2008-09-05 12:03:34.000000000 -0700
@@ -584,7 +584,8 @@
If the copy constructor is required during the execution of some mutator,
but a method for C<'='> was not specified, it can be autogenerated as a
-string copy if the object is a plain scalar.
+string copy if the object is a plain scalar or a simple assignment if it
+is not.
=over 5
@@ -671,7 +672,8 @@
=item I<Copy operator>
can be expressed in terms of an assignment to the dereferenced value, if this
-value is a scalar and not a reference.
+value is a scalar and not a reference, or simply a reference assignment
+otherwise.
=back
==== //depot/maint-5.8/perl/lib/overload.t#17 (text) ====
Index: perl/lib/overload.t
--- perl/lib/overload.t#16~32545~ 2007-11-28 15:35:51.000000000 -0800
+++ perl/lib/overload.t 2008-09-05 12:03:34.000000000 -0700
@@ -47,7 +47,7 @@
package main;
$| = 1;
-use Test::More tests => 555;
+use Test::More tests => 557;
$a = new Oscalar "087";
@@ -1420,4 +1420,20 @@
is($aref**1, $num_val, 'exponentiation of ref');
}
+{
+ package CopyConstructorFallback;
+ use overload
+ '++' => sub { "$_[0]"; $_[0] },
+ fallback => 1;
+ sub new { bless {} => shift }
+
+ package main;
+
+ my $o = CopyConstructorFallback->new;
+ my $x = $o++; # would segfault
+ my $y = ++$o;
+ is($x, $o, "copy constructor falls back to assignment (postinc)");
+ is($y, $o, "copy constructor falls back to assignment (preinc)");
+}
+
# EOF
==== //depot/maint-5.8/perl/malloc.c#27 (text) ====
Index: perl/malloc.c
--- perl/malloc.c#26~33214~ 2008-02-02 14:01:39.000000000 -0800
+++ perl/malloc.c 2008-09-05 12:03:34.000000000 -0700
@@ -2276,6 +2276,8 @@
nmalloc[bucket]--;
nmalloc[pow * BUCKETS_PER_POW2]++;
#endif
+ if (pow * BUCKETS_PER_POW2 > (MEM_SIZE)max_bucket)
+ max_bucket = pow * BUCKETS_PER_POW2;
*(cp - M_OVERHEAD) = pow * BUCKETS_PER_POW2; /* Fill index. */
MALLOC_UNLOCK;
goto inplace_label;
==== //depot/maint-5.8/perl/perl.c#232 (text) ====
Index: perl/perl.c
--- perl/perl.c#231~33866~ 2008-05-19 07:57:58.000000000 -0700
+++ perl/perl.c 2008-09-05 12:03:34.000000000 -0700
@@ -3490,8 +3490,10 @@
return s;
case '*':
case ' ':
- if (s[1] == '-') /* Additional switches on #! line. */
- return s+2;
+ while( *s == ' ' )
+ ++s;
+ if (s[0] == '-') /* Additional switches on #! line. */
+ return s+1;
break;
case '-':
case 0:
@@ -4793,18 +4795,21 @@
environ[0] = NULL;
}
if (env) {
- char *s;
+ char *s, *old_var;
SV *sv;
for (; *env; env++) {
- if (!(s = strchr(*env,'=')) || s == *env)
+ old_var = *env;
+
+ if (!(s = strchr(old_var,'=')) || s == old_var)
continue;
+
#if defined(MSDOS) && !defined(DJGPP)
*s = '\0';
- (void)strupr(*env);
+ (void)strupr(old_var);
*s = '=';
#endif
sv = newSVpv(s+1, 0);
- (void)hv_store(hv, *env, s - *env, sv, 0);
+ (void)hv_store(hv, old_var, s - old_var, sv, 0);
if (env_is_not_environ)
mg_set(sv);
}
==== //depot/maint-5.8/perl/pp.h#26 (text) ====
Index: perl/pp.h
--- perl/pp.h#25~33217~ 2008-02-02 14:47:50.000000000 -0800
+++ perl/pp.h 2008-09-05 12:03:34.000000000 -0700
@@ -502,9 +502,9 @@
/* SV* ref causes confusion with the member variable
changed SV* ref to SV* tmpRef */
-#define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv); \
- if (SvREFCNT(tmpRef)>1) { \
- SvRV_set(rv, AMG_CALLun(rv,copy)); \
+#define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv); SV* rv_copy; \
+ if (SvREFCNT(tmpRef)>1 && (rv_copy = AMG_CALLun(rv,copy))) { \
+ SvRV_set(rv, rv_copy); \
SvREFCNT_dec(tmpRef); \
} } STMT_END
==== //depot/maint-5.8/perl/sv.c#385 (text) ====
Index: perl/sv.c
--- perl/sv.c#384~33926~ 2008-05-25 14:12:26.000000000 -0700
+++ perl/sv.c 2008-09-05 12:03:34.000000000 -0700
@@ -172,11 +172,21 @@
UNLOCK_SV_MUTEX;
}
+/* Mark an SV head as unused, and add to free list.
+ *
+ * If SVf_BREAK is set, skip adding it to the free list, as this SV had
+ * its refcount artificially decremented during global destruction, so
+ * there may be dangling pointers to it. The last thing we want in that
+ * case is for it to be reused. */
+
#define plant_SV(p) \
STMT_START { \
- SvANY(p) = (void *)PL_sv_root; \
+ const U32 old_flags = SvFLAGS(p); \
SvFLAGS(p) = SVTYPEMASK; \
- PL_sv_root = (p); \
+ if (!(old_flags & SVf_BREAK)) { \
+ SvANY(p) = (void *)PL_sv_root; \
+ PL_sv_root = (p); \
+ } \
--PL_sv_count; \
} STMT_END
@@ -3017,13 +3027,21 @@
const U8 ch = *t++;
/* Check for hi bit */
if (!NATIVE_IS_INVARIANT(ch)) {
- STRLEN len = SvCUR(sv) + 1; /* Plus the \0 */
+ STRLEN len = SvCUR(sv);
+ /* *Currently* bytes_to_utf8() adds a '\0' after every string
+ it converts. This isn't documented. It's not clear if it's
+ a bad thing to be doing, and should be changed to do exactly
+ what the documentation says. If so, this code will have to
+ be changed.
+ As is, we mustn't rely on our incoming SV being well formed
+ and having a trailing '\0', as certain code in pp_formline
+ can send us partially built SVs. */
U8 * const recoded = bytes_to_utf8((U8*)s, &len);
SvPV_free(sv); /* No longer using what was there before. */
SvPV_set(sv, (char*)recoded);
- SvCUR_set(sv, len - 1);
- SvLEN_set(sv, len); /* No longer know the real size. */
+ SvCUR_set(sv, len);
+ SvLEN_set(sv, len + 1); /* No longer know the real size. */
break;
}
}
==== //depot/maint-5.8/perl/t/run/switches.t#11 (text) ====
Index: perl/t/run/switches.t
--- perl/t/run/switches.t#10~33813~ 2008-05-10 09:43:45.000000000 -0700
+++ perl/t/run/switches.t 2008-09-05 12:03:34.000000000 -0700
@@ -11,7 +11,7 @@
BEGIN { require "./test.pl"; }
-plan(tests => 65);
+plan(tests => 66);
use Config;
@@ -328,3 +328,19 @@
"foo yada dada:bada foo bing:king kong foo",
"-i backup file");
}
+
+# RT #30660
+
+$filename = tempfile();
+SKIP: {
+ open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
+ print $f <<'SWTEST';
+#!perl -w -iok
+print "$^I\n";
+SWTEST
+ close $f or die "Could not close: $!";
+ $r = runperl(
+ progfile => $filename,
+ );
+ like( $r, qr/ok/, 'Spaces on the #! line (#30660)' );
+}
==== //depot/maint-5.8/perl/win32/win32sck.c#9 (text) ====
Index: perl/win32/win32sck.c
--- perl/win32/win32sck.c#8~32419~ 2007-11-20 06:28:43.000000000 -0800
+++ perl/win32/win32sck.c 2008-09-05 12:03:34.000000000 -0700
@@ -284,9 +284,8 @@
{
int r;
#ifdef USE_SOCKETS_AS_HANDLES
- Perl_fd_set dummy;
int i, fd, save_errno = errno;
- FD_SET nrd, nwr, nex, *prd, *pwr, *pex;
+ FD_SET nrd, nwr, nex;
/* winsock seems incapable of dealing with all three null fd_sets,
* so do the (millisecond) sleep as a special case
@@ -300,44 +299,31 @@
return 0;
}
StartSockets();
- PERL_FD_ZERO(&dummy);
- if (!rd)
- rd = &dummy, prd = NULL;
- else
- prd = &nrd;
- if (!wr)
- wr = &dummy, pwr = NULL;
- else
- pwr = &nwr;
- if (!ex)
- ex = &dummy, pex = NULL;
- else
- pex = &nex;
FD_ZERO(&nrd);
FD_ZERO(&nwr);
FD_ZERO(&nex);
for (i = 0; i < nfds; i++) {
fd = TO_SOCKET(i);
- if (PERL_FD_ISSET(i,rd))
+ if (rd && PERL_FD_ISSET(i,rd))
FD_SET((unsigned)fd, &nrd);
- if (PERL_FD_ISSET(i,wr))
+ if (wr && PERL_FD_ISSET(i,wr))
FD_SET((unsigned)fd, &nwr);
- if (PERL_FD_ISSET(i,ex))
+ if (ex && PERL_FD_ISSET(i,ex))
FD_SET((unsigned)fd, &nex);
}
errno = save_errno;
- SOCKET_TEST_ERROR(r = select(nfds, prd, pwr, pex, timeout));
+ SOCKET_TEST_ERROR(r = select(nfds, &nrd, &nwr, &nex, timeout));
save_errno = errno;
for (i = 0; i < nfds; i++) {
fd = TO_SOCKET(i);
- if (PERL_FD_ISSET(i,rd) && !FD_ISSET(fd, &nrd))
+ if (rd && PERL_FD_ISSET(i,rd) && !FD_ISSET(fd, &nrd))
PERL_FD_CLR(i,rd);
- if (PERL_FD_ISSET(i,wr) && !FD_ISSET(fd, &nwr))
+ if (wr && PERL_FD_ISSET(i,wr) && !FD_ISSET(fd, &nwr))
PERL_FD_CLR(i,wr);
- if (PERL_FD_ISSET(i,ex) && !FD_ISSET(fd, &nex))
+ if (ex && PERL_FD_ISSET(i,ex) && !FD_ISSET(fd, &nex))
PERL_FD_CLR(i,ex);
}
errno = save_errno;
End of Patch.
