Change 26689 by [EMAIL PROTECTED] on 2006/01/06 23:03:51
Integrate:
[ 25360]
Add a TODO test for bug #37038 - assigning to the match variable
should not corrupt match vars such as $1 and $2
[ 25925]
Fix [perl #37533] open pragma ignored for all 3-arg opens
Also, correct the documentation in open.pm that stated
that open() did not override open.pm-given default encodings.
[ 25932]
Avoid corruption when calling mg_get to retrieve the value
of a $digit variable. This is done by ensuring it's not
tainted.
See http://bugs.debian.org/303308
Patch by Chris Heath <[EMAIL PROTECTED]>
[ 25952]
Subject: [PATCH] RE: [perl #37571] -z FH broken with Borland build
From: "Paul Marquess" <[EMAIL PROTECTED]>
Date: Tue, 1 Nov 2005 17:05:38 -0000
Message-ID: <[EMAIL PROTECTED]>
[ 25993]
Subject: [perl #19049] Incorrect $` after replacement
From: [EMAIL PROTECTED] (Andreas J. Koenig)
Date: Fri, 04 Nov 2005 08:17:25 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 25998]
Revert patch #25993.
[ 26064]
Better diagnostics from io/utf8.t
[ 26065]
As using -C to turn on utf8 IO is equivalent to the open pragma,
change 25925 had the side effect of breaking t/io/utf8.t
Fixed by adding the missing binmode()s.
[ 26067]
As using -C to turn on utf8 IO is equivalent to the open pragma,
change 25925 had the side effect of breaking ext/Encode/t/perlio.t
Fixed by opening with :bytes.
[ 26075]
Subject: [perl #37648] segfault with PERLIO_DEBUG
From: Peter Dintelmann (via RT) <[EMAIL PROTECTED]>
Date: Thu, 10 Nov 2005 04:31:39 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 26101]
Subject: [perl #37657] segfault with binmode ":pop"
From: Peter Dintelmann (via RT) <[EMAIL PROTECTED]>
Date: Fri, 11 Nov 2005 06:36:20 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 26136]
Subject: Re: [perl #37616] Bug in &= (string) and/or m//
From: SADAHIRO Tomoyuki <[EMAIL PROTECTED]>
Date: Wed, 09 Nov 2005 02:12:00 +0900
Message-Id: <[EMAIL PROTECTED]>
[ 26137]
Subject: Re: [perl #37688] Unexpected regex failure.
From: [EMAIL PROTECTED]
Date: Wed, 16 Nov 2005 14:54:55 +0000
Message-Id: <[EMAIL PROTECTED]>
[ 26144]
Subject: [perl #37694] segfault with PerlIO::get_layers()
From: Peter Dintelmann (via RT) <[EMAIL PROTECTED]>
Date: Wed, 16 Nov 2005 07:11:41 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 26189]
Subject: RE: [perl #37708] [PATCH] wrong IP_ constants on Win32
From: "Jan Dubois" <[EMAIL PROTECTED]>
Date: Mon, 21 Nov 2005 21:35:51 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 26193]
Use the system's free to dealloc a PV allocated by the system
(more precisely by libgdbm.) See :
Subject: GDBM_file realloc failures
From: Rafael Garcia-Suarez <[EMAIL PROTECTED]>
Date: Mon, 21 Nov 2005 18:22:00 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 26195]
[perl #37725] perl segfaults on reversed array reference
The 'for (reverse @a)' optimisation got its index wrong when
create LVALUE SVs for undef elements
[ 26399]
Un-TODO a fixed test
Subject: Re: Change 26165 broke ext/threads/t/stress_re.t test on Win32
(and patch to t/test.pl and/or Test::Harness)
From: demerphq <[EMAIL PROTECTED]>
Date: Sat, 17 Dec 2005 17:23:23 +0100
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.8/perl/doop.c#32 integrate
... //depot/maint-5.8/perl/ext/Encode/t/perlio.t#7 integrate
... //depot/maint-5.8/perl/ext/GDBM_File/GDBM_File.xs#6 integrate
... //depot/maint-5.8/perl/lib/open.pm#10 integrate
... //depot/maint-5.8/perl/mg.c#93 integrate
... //depot/maint-5.8/perl/perlio.c#71 integrate
... //depot/maint-5.8/perl/pp_ctl.c#109 integrate
... //depot/maint-5.8/perl/pp_hot.c#90 integrate
... //depot/maint-5.8/perl/regexec.c#56 integrate
... //depot/maint-5.8/perl/t/io/utf8.t#10 integrate
... //depot/maint-5.8/perl/t/op/bop.t#4 integrate
... //depot/maint-5.8/perl/t/op/loopctl.t#3 integrate
... //depot/maint-5.8/perl/t/op/pat.t#32 integrate
... //depot/maint-5.8/perl/t/op/re_tests#8 integrate
... //depot/maint-5.8/perl/t/op/stat.t#12 integrate
... //depot/maint-5.8/perl/universal.c#42 integrate
... //depot/maint-5.8/perl/win32/include/sys/socket.h#2 integrate
... //depot/maint-5.8/perl/win32/win32.c#28 integrate
Differences ...
==== //depot/maint-5.8/perl/doop.c#32 (text) ====
Index: perl/doop.c
--- perl/doop.c#31~26113~ 2005-11-13 10:53:10.000000000 -0800
+++ perl/doop.c 2006-01-06 15:03:51.000000000 -0800
@@ -1176,7 +1176,7 @@
/* Fix this to nong when change 22613 is integrated.
(Which in turn awaits merging sv_2iv and sv_2uv) */
dc = SvPV_force_nolen(sv);
- if (SvCUR(sv) < (STRLEN)len) {
+ if (SvLEN(sv) < (STRLEN)(len + 1)) {
dc = SvGROW(sv, (STRLEN)(len + 1));
(void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
}
@@ -1305,6 +1305,7 @@
case OP_BIT_AND:
while (len--)
*dc++ = *lc++ & *rc++;
+ *dc = '\0';
break;
case OP_BIT_XOR:
while (len--)
==== //depot/maint-5.8/perl/ext/Encode/t/perlio.t#7 (text) ====
Index: perl/ext/Encode/t/perlio.t
--- perl/ext/Encode/t/perlio.t#6~20433~ 2003-08-01 06:48:38.000000000 -0700
+++ perl/ext/Encode/t/perlio.t 2006-01-06 15:03:51.000000000 -0800
@@ -167,7 +167,7 @@
open $fh, ">:encoding($utf_nobom)", $sfile or die "$sfile : $!";
print $fh $str;
close $fh;
- open my $fh, "<", $sfile or die "$sfile : $!";
+ open my $fh, "<:bytes", $sfile or die "$sfile : $!";
read $fh, my $cmp, -s $sfile;
close $fh;
use bytes ();
==== //depot/maint-5.8/perl/ext/GDBM_File/GDBM_File.xs#6 (text) ====
Index: perl/ext/GDBM_File/GDBM_File.xs
--- perl/ext/GDBM_File/GDBM_File.xs#5~18208~ 2002-11-28 08:57:01.000000000
-0800
+++ perl/ext/GDBM_File/GDBM_File.xs 2006-01-06 15:03:51.000000000 -0800
@@ -39,12 +39,8 @@
static void
output_datum(pTHX_ SV *arg, char *str, int size)
{
-#if (!defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC)))
- sv_usepvn(arg, str, size);
-#else
sv_setpvn(arg, str, size);
- safesysfree(str);
-#endif
+ free(str);
}
/* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
==== //depot/maint-5.8/perl/lib/open.pm#10 (text) ====
Index: perl/lib/open.pm
--- perl/lib/open.pm#9~23389~ 2004-10-19 12:16:21.000000000 -0700
+++ perl/lib/open.pm 2006-01-06 15:03:51.000000000 -0800
@@ -3,7 +3,7 @@
use Carp;
$open::hint_bits = 0x20000; # HINT_LOCALIZE_HH
-our $VERSION = '1.04';
+our $VERSION = '1.05';
require 5.008001; # for PerlIO::get_layers()
@@ -215,8 +215,8 @@
Note that C<:utf8> PerlIO layer must always be specified exactly like
that, it is not subject to the loose matching of encoding names.
-When open() is given an explicit list of layers they are appended to
-the list declared using this pragma.
+When open() is given an explicit list of layers (with the three-arg
+syntax), they override the list declared using this pragma.
The C<:std> subpragma on its own has no effect, but if combined with
the C<:utf8> or C<:encoding> subpragmas, it converts the standard
@@ -228,7 +228,7 @@
STDOUT and STDERR to be in C<koi8r>. The C<:locale> subpragma
implicitly turns on C<:std>.
-The logic of C<:locale> is described in full in L</encoding>,
+The logic of C<:locale> is described in full in L<encoding>,
but in short it is first trying nl_langinfo(CODESET) and then
guessing from the LC_ALL and LANG locale environment variables.
==== //depot/maint-5.8/perl/mg.c#93 (text) ====
Index: perl/mg.c
--- perl/mg.c#92~26688~ 2006-01-06 14:22:00.000000000 -0800
+++ perl/mg.c 2006-01-06 15:03:51.000000000 -0800
@@ -768,7 +768,10 @@
getrx:
if (i >= 0) {
+ int oldtainted = PL_tainted;
+ TAINT_NOT;
sv_setpvn(sv, s, i);
+ PL_tainted = oldtainted;
if (RX_MATCH_UTF8(rx) && is_utf8_string((U8*)s, i))
SvUTF8_on(sv);
else
==== //depot/maint-5.8/perl/perlio.c#71 (text) ====
Index: perl/perlio.c
--- perl/perlio.c#70~26577~ 2006-01-02 08:41:40.000000000 -0800
+++ perl/perlio.c 2006-01-06 15:03:51.000000000 -0800
@@ -1295,9 +1295,10 @@
int
PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
{
- PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n",
- (void*)f, PerlIOBase(f)->tab->name, iotype, mode,
- (names) ? names : "(Null)");
+ PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n", (void*)f,
+ (PerlIOBase(f)) ? PerlIOBase(f)->tab->name : "(Null)",
+ iotype, mode, (names) ? names : "(Null)");
+
if (names) {
/* Do not flush etc. if (e.g.) switching encodings.
if a pushed layer knows it needs to flush lower layers
@@ -1458,7 +1459,7 @@
*/
}
}
- if (!layers)
+ if (!layers || !*layers)
layers = PerlIO_context_layers(aTHX_ mode);
if (layers && *layers) {
PerlIO_list_t *av;
@@ -1494,7 +1495,7 @@
{
if (!f && narg == 1 && *args == &PL_sv_undef) {
if ((f = PerlIO_tmpfile())) {
- if (!layers)
+ if (!layers || !*layers)
layers = PerlIO_context_layers(aTHX_ mode);
if (layers && *layers)
PerlIO_apply_layers(aTHX_ f, mode, layers);
@@ -1545,8 +1546,8 @@
Perl_croak(aTHX_ "More than one argument to
open(,':%s')",tab->name);
}
PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n",
- tab->name, layers, mode, fd, imode, perm,
- (void*)f, narg, (void*)args);
+ tab->name, layers ? layers : "(Null)", mode, fd,
+ imode, perm, (void*)f, narg, (void*)args);
if (tab->Open)
f = (*tab->Open) (aTHX_ tab, layera, n, mode, fd, imode, perm,
f, narg, args);
==== //depot/maint-5.8/perl/pp_ctl.c#109 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#108~26688~ 2006-01-06 14:22:00.000000000 -0800
+++ perl/pp_ctl.c 2006-01-06 15:03:51.000000000 -0800
@@ -1769,8 +1769,8 @@
}
}
else if (PL_op->op_private & OPpITER_REVERSED) {
- cx->blk_loop.itermax = -1;
- cx->blk_loop.iterix = AvFILL(cx->blk_loop.iterary);
+ cx->blk_loop.itermax = 0;
+ cx->blk_loop.iterix = AvFILL(cx->blk_loop.iterary) + 1;
}
}
@@ -1778,8 +1778,8 @@
cx->blk_loop.iterary = PL_curstack;
AvFILLp(PL_curstack) = SP - PL_stack_base;
if (PL_op->op_private & OPpITER_REVERSED) {
- cx->blk_loop.itermax = MARK - PL_stack_base;
- cx->blk_loop.iterix = cx->blk_oldsp;
+ cx->blk_loop.itermax = MARK - PL_stack_base + 1;
+ cx->blk_loop.iterix = cx->blk_oldsp + 1;
}
else {
cx->blk_loop.iterix = MARK - PL_stack_base;
==== //depot/maint-5.8/perl/pp_hot.c#90 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#89~26688~ 2006-01-06 14:22:00.000000000 -0800
+++ perl/pp_hot.c 2006-01-06 15:03:51.000000000 -0800
@@ -1920,14 +1920,11 @@
RETPUSHNO;
if (SvMAGICAL(av) || AvREIFY(av)) {
- SV **svp = av_fetch(av, cx->blk_loop.iterix--, FALSE);
- if (svp)
- sv = *svp;
- else
- sv = Nullsv;
+ SV ** const svp = av_fetch(av, --cx->blk_loop.iterix, FALSE);
+ sv = svp ? *svp : Nullsv;
}
else {
- sv = AvARRAY(av)[cx->blk_loop.iterix--];
+ sv = AvARRAY(av)[--cx->blk_loop.iterix];
}
}
else {
==== //depot/maint-5.8/perl/regexec.c#56 (text) ====
Index: perl/regexec.c
--- perl/regexec.c#55~26688~ 2006-01-06 14:22:00.000000000 -0800
+++ perl/regexec.c 2006-01-06 15:03:51.000000000 -0800
@@ -512,6 +512,7 @@
|| ((slen = SvCUR(check)) > 1
&& memNE(SvPVX_const(check), s, slen)))
goto report_neq;
+ check_at = s;
goto success_at_start;
}
}
==== //depot/maint-5.8/perl/t/io/utf8.t#10 (xtext) ====
Index: perl/t/io/utf8.t
--- perl/t/io/utf8.t#9~22040~ 2004-01-01 16:21:57.000000000 -0800
+++ perl/t/io/utf8.t 2006-01-06 15:03:51.000000000 -0800
@@ -13,42 +13,42 @@
require "./test.pl";
-plan(tests => 53);
+plan(tests => 55);
$| = 1;
open(F,"+>:utf8",'a');
print F chr(0x100).'£';
-ok( tell(F) == 4, tell(F) );
+cmp_ok( tell(F), '==', 4, tell(F) );
print F "\n";
-ok( tell(F) >= 5, tell(F) );
+cmp_ok( tell(F), '>=', 5, tell(F) );
seek(F,0,0);
-ok( getc(F) eq chr(0x100) );
-ok( getc(F) eq "£" );
-ok( getc(F) eq "\n" );
+is( getc(F), chr(0x100) );
+is( getc(F), "£" );
+is( getc(F), "\n" );
seek(F,0,0);
binmode(F,":bytes");
my $chr = chr(0xc4);
if (ord('A') == 193) { $chr = chr(0x8c); } # EBCDIC
-ok( getc(F) eq $chr );
+is( getc(F), $chr );
$chr = chr(0x80);
if (ord('A') == 193) { $chr = chr(0x41); } # EBCDIC
-ok( getc(F) eq $chr );
+is( getc(F), $chr );
$chr = chr(0xc2);
if (ord('A') == 193) { $chr = chr(0x80); } # EBCDIC
-ok( getc(F) eq $chr );
+is( getc(F), $chr );
$chr = chr(0xa3);
if (ord('A') == 193) { $chr = chr(0x44); } # EBCDIC
-ok( getc(F) eq $chr );
-ok( getc(F) eq "\n" );
+is( getc(F), $chr );
+is( getc(F), "\n" );
seek(F,0,0);
binmode(F,":utf8");
-ok( scalar(<F>) eq "\x{100}£\n" );
+is( scalar(<F>), "\x{100}£\n" );
seek(F,0,0);
$buf = chr(0x200);
$count = read(F,$buf,2,1);
-ok( $count == 2 );
-ok( $buf eq "\x{200}\x{100}£" );
+cmp_ok( $count, '==', 2 );
+is( $buf, "\x{200}\x{100}£" );
close(F);
{
@@ -62,7 +62,7 @@
open F, "<:utf8", 'a' or die $!;
$x = <F>;
chomp($x);
- ok( $x eq chr(300) );
+ is( $x, chr(300) );
open F, "a" or die $!; # Not UTF
binmode(F, ":bytes");
@@ -70,7 +70,7 @@
chomp($x);
$chr = chr(196).chr(172);
if (ord('A') == 193) { $chr = chr(141).chr(83); } # EBCDIC
- ok( $x eq $chr );
+ is( $x, $chr );
close F;
open F, ">:utf8", 'a' or die $!;
@@ -80,25 +80,25 @@
my $y;
{ my $x = tell(F);
{ use bytes; $y = length($a);}
- ok( $x == $y );
+ cmp_ok( $x, '==', $y );
}
{ # Check byte length of $b
use bytes; my $y = length($b);
- ok( $y == 1 );
+ cmp_ok( $y, '==', 1 );
}
print F $b,"\n"; # Don't upgrades $b
{ # Check byte length of $b
use bytes; my $y = length($b);
- ok( $y == 1 );
+ cmp_ok( $y, '==', 1 );
}
{
my $x = tell(F);
{ use bytes; if (ord('A')==193){$y += 2;}else{$y += 3;}} # EBCDIC ASCII
- ok( $x == $y );
+ cmp_ok( $x, '==', $y );
}
close F;
@@ -109,13 +109,13 @@
chomp($x);
$chr = v196.172.194.130;
if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC
- ok( $x eq $chr, sprintf('(%vd)', $x) );
+ is( $x, $chr, sprintf('(%vd)', $x) );
open F, "<:utf8", "a" or die $!;
$x = <F>;
chomp($x);
close F;
- ok( $x eq chr(300).chr(130), sprintf('(%vd)', $x) );
+ is( $x, chr(300).chr(130), sprintf('(%vd)', $x) );
open F, ">", "a" or die $!;
if (${^OPEN} =~ /:utf8/) {
@@ -128,7 +128,8 @@
use warnings 'utf8';
local $SIG{__WARN__} = sub { $w = $_[0] };
print F $a;
- ok( !($@ || $w !~ /Wide character in print/i) );
+ ok( (!$@));
+ like($w, qr/Wide character in print/i );
}
}
@@ -144,30 +145,39 @@
$x = <F>; chomp $x;
$chr = v196.172.130;
if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC
-ok( $x eq $chr );
+is( $x, $chr );
# Right.
open F, ">:utf8", "a" or die $!;
print F $a;
close F;
open F, ">>", "a" or die $!;
+binmode(F, ":bytes");
print F chr(130)."\n";
close F;
open F, "<", "a" or die $!;
+binmode(F, ":bytes");
$x = <F>; chomp $x;
-ok( $x eq $chr );
+SKIP: {
+ skip("Defaulting to UTF-8 output means that we can't generate a mangled
file")
+ if $UTF8_OUTPUT;
+ is( $x, $chr );
+}
# Now we have a deformed file.
SKIP: {
if (ord('A') == 193) {
- skip( "EBCDIC doesn't complain" );
+ skip("EBCDIC doesn't complain", 2);
} else {
+ my @warnings;
open F, "<:utf8", "a" or die $!;
$x = <F>; chomp $x;
- local $SIG{__WARN__} = sub { ok( 1 ) };
+ local $SIG{__WARN__} = sub { push @warnings, $_[0]; };
eval { sprintf "%vd\n", $x };
+ is (scalar @warnings, 1);
+ like ($warnings[0], qr/Malformed UTF-8 character \(unexpected
continuation byte 0x82, with no preceding start byte/);
}
}
@@ -185,6 +195,7 @@
# read() should work on characters, not bytes
open F, "<:utf8", "a";
$a = 0;
+my $failed;
for (@a) {
unless (($c = read(F, $b, 1) == 1) &&
length($b) == 1 &&
@@ -197,12 +208,12 @@
print '# tell(F) == ', tell(F), "\n";
print '# $a == ', $a, "\n";
print '# $c == ', $c, "\n";
- print "not ";
+ $failed++;
last;
}
}
close F;
-ok( 1 );
+is($failed, undef);
{
# Check that warnings are on on I/O, and that they can be muffled.
@@ -258,7 +269,7 @@
open F, "<:bytes", "a";
my $b = chr 0x100;
$b .= <F>;
- ok( $b eq chr(0x100).chr(0xde), "21395 '.= <>' utf8 vs. bytes" );
+ is( $b, chr(0x100).chr(0xde), "21395 '.= <>' utf8 vs. bytes" );
close F;
}
@@ -268,7 +279,7 @@
open F, "<:utf8", "a";
my $b = "\xde";
$b .= <F>;
- ok( $b eq chr(0xde).chr(0x100), "21395 '.= <>' bytes vs. utf8" );
+ is( $b, chr(0xde).chr(0x100), "21395 '.= <>' bytes vs. utf8" );
close F;
}
@@ -293,7 +304,7 @@
utf8::upgrade($s) if $v->[1] eq "utf8";
$s .= <F>;
- ok( $s eq chr($v->[0]) . chr($u->[0]), 'rcatline utf8' );
+ is( $s, chr($v->[0]) . chr($u->[0]), 'rcatline utf8' );
close F;
$t++;
}
==== //depot/maint-5.8/perl/t/op/bop.t#4 (xtext) ====
Index: perl/t/op/bop.t
--- perl/t/op/bop.t#3~23808~ 2005-01-17 13:59:28.000000000 -0800
+++ perl/t/op/bop.t 2006-01-06 15:03:51.000000000 -0800
@@ -15,7 +15,7 @@
# If you find tests are failing, please try adding names to tests to track
# down where the failure is, and supply your new names as a patch.
# (Just-in-time test naming)
-plan tests => 47;
+plan tests => 49;
# numerics
ok ((0xdead & 0xbeef) == 0x9ead);
@@ -186,3 +186,14 @@
skip "No malloc wrap checks" unless $Config::Config{usemallocwrap};
like( runperl(prog => 'eval q($#a>>=1); print 1'), "^1\n?" );
}
+
+# [perl #37616] Bug in &= (string) and/or m//
+{
+ $a = "aa";
+ $a &= "a";
+ ok($a =~ /a+$/, 'ASCII "a" is NUL-terminated');
+
+ $b = "bb\x{100}";
+ $b &= "b";
+ ok($b =~ /b+$/, 'Unicode "b" is NUL-terminated');
+}
==== //depot/maint-5.8/perl/t/op/loopctl.t#3 (text) ====
Index: perl/t/op/loopctl.t
--- perl/t/op/loopctl.t#2~22457~ 2004-03-07 08:41:16.000000000 -0800
+++ perl/t/op/loopctl.t 2006-01-06 15:03:51.000000000 -0800
@@ -31,7 +31,7 @@
#
# -- .robin. <[EMAIL PROTECTED]> 2001-03-13
-print "1..43\n";
+print "1..44\n";
my $ok;
@@ -967,3 +967,16 @@
}
+
+{
+ # [perl #37725]
+
+ $a37725[3] = 1; # use package var
+ $i = 2;
+ for my $x (reverse @a37725) {
+ $x = $i++;
+ }
+ print "@a37725" == "5 4 3 2" ? "" : "not ",
+ "ok 44 - reverse with empty slots (@a37725)\n";
+}
+
==== //depot/maint-5.8/perl/t/op/pat.t#32 (xtext) ====
Index: perl/t/op/pat.t
--- perl/t/op/pat.t#31~25568~ 2005-09-22 05:22:36.000000000 -0700
+++ perl/t/op/pat.t 2006-01-06 15:03:51.000000000 -0800
@@ -6,7 +6,7 @@
$| = 1;
-print "1..1186\n";
+print "1..1187\n";
BEGIN {
chdir 't' if -d 't';
@@ -3375,4 +3375,16 @@
ok($latin1 =~ /(abc|$utf8)/i, "# latin/utf8 trie runtime");
}
-# last test 1186
+# [perl #37038] Global regular matches generate invalid pointers
+
+{
+ my $s = "abcd";
+ $s =~ /(..)(..)/g;
+ $s = $1;
+ $s = $2;
+ ok($s eq 'cd',
+ "# assigning to original string should not corrupt match vars");
+}
+
+# last test 1187
+
==== //depot/maint-5.8/perl/t/op/re_tests#8 (text) ====
Index: perl/t/op/re_tests
--- perl/t/op/re_tests#7~25568~ 2005-09-22 05:22:36.000000000 -0700
+++ perl/t/op/re_tests 2006-01-06 15:03:51.000000000 -0800
@@ -958,3 +958,4 @@
(a|aa|aaa|aaaa|aaaaa|aaaaaa)(??{$1&&"foo"})(b|c) aaaaaaaaaaaaaaab
n - -
^(a*?)(?!(aa|aaaa)*$) aaaaaaaaaaaaaaaaaaaa y $1 a # [perl
#34195]
^(a*?)(?!(aa|aaaa)*$)(?=a\z) aaaaaaaa y $1 aaaaaaa
+^(.)\s+.$(?(1)) A B y $1 A # [perl #37688]
==== //depot/maint-5.8/perl/t/op/stat.t#12 (xtext) ====
Index: perl/t/op/stat.t
--- perl/t/op/stat.t#11~25505~ 2005-09-19 15:20:52.000000000 -0700
+++ perl/t/op/stat.t 2006-01-06 15:03:51.000000000 -0800
@@ -9,7 +9,7 @@
use Config;
use File::Spec;
-plan tests => 82;
+plan tests => 86;
my $Perl = which_perl();
@@ -126,6 +126,8 @@
# truncate and touch $tmpfile.
open(F, ">$tmpfile") || DIE("Can't open temp test file: $!");
+ok(-z \*F, '-z on empty filehandle');
+ok(! -s \*F, ' and -s');
close F;
ok(-z $tmpfile, '-z on empty file');
@@ -135,6 +137,11 @@
print F "hi\n";
close F;
+open(F, "<$tmpfile") || DIE("Can't open temp test file: $!");
+ok(!-z *F, '-z on empty filehandle');
+ok( -s *F, ' and -s');
+close F;
+
ok(! -z $tmpfile, '-z on non-empty file');
ok(-s $tmpfile, ' and -s');
==== //depot/maint-5.8/perl/universal.c#42 (text) ====
Index: perl/universal.c
--- perl/universal.c#41~25673~ 2005-09-30 10:13:04.000000000 -0700
+++ perl/universal.c 2006-01-06 15:03:51.000000000 -0800
@@ -611,7 +611,7 @@
if (!isGV(sv)) {
if (SvROK(sv) && isGV(SvRV(sv)))
gv = (GV*)SvRV(sv);
- else
+ else if (SvPOKp(sv))
gv = gv_fetchpv(SvPVX(sv), FALSE, SVt_PVIO);
}
==== //depot/maint-5.8/perl/win32/include/sys/socket.h#2 (text) ====
Index: perl/win32/include/sys/socket.h
--- perl/win32/include/sys/socket.h#1~17645~ 2002-07-19 12:29:57.000000000
-0700
+++ perl/win32/include/sys/socket.h 2006-01-06 15:03:51.000000000 -0800
@@ -15,7 +15,11 @@
# define Win32_Winsock
#endif
#include <windows.h>
-#include <winsock.h>
+
+/* Too late to include winsock2.h if winsock.h has already been loaded */
+#ifndef _WINSOCKAPI_
+# include <winsock2.h>
+#endif
#include "win32.h"
==== //depot/maint-5.8/perl/win32/win32.c#28 (text) ====
Index: perl/win32/win32.c
--- perl/win32/win32.c#27~25667~ 2005-09-30 03:29:54.000000000 -0700
+++ perl/win32/win32.c 2006-01-06 15:03:51.000000000 -0800
@@ -2734,9 +2734,31 @@
* for write operations, probably because it is opened for reading.
* --Vadim Konovalov
*/
- int rc = fstat(fd,sbufptr);
BY_HANDLE_FILE_INFORMATION bhfi;
+#if defined(WIN64) || defined(USE_LARGE_FILES)
+ /* Borland 5.5.1 has a 64-bit stat, but only a 32-bit fstat */
+ struct stat tmp;
+ int rc = fstat(fd,&tmp);
+
+ sbufptr->st_dev = tmp.st_dev;
+ sbufptr->st_ino = tmp.st_ino;
+ sbufptr->st_mode = tmp.st_mode;
+ sbufptr->st_nlink = tmp.st_nlink;
+ sbufptr->st_uid = tmp.st_uid;
+ sbufptr->st_gid = tmp.st_gid;
+ sbufptr->st_rdev = tmp.st_rdev;
+ sbufptr->st_size = tmp.st_size;
+ sbufptr->st_atime = tmp.st_atime;
+ sbufptr->st_mtime = tmp.st_mtime;
+ sbufptr->st_ctime = tmp.st_ctime;
+#else
+ int rc = fstat(fd,sbufptr);
+#endif
+
if (GetFileInformationByHandle((HANDLE)_get_osfhandle(fd), &bhfi)) {
+#if defined(WIN64) || defined(USE_LARGE_FILES)
+ sbufptr->st_size = (bhfi.nFileSizeHigh << 32) + bhfi.nFileSizeLow ;
+#endif
sbufptr->st_mode &= 0xFE00;
if (bhfi.dwFileAttributes & FILE_ATTRIBUTE_READONLY)
sbufptr->st_mode |= (S_IREAD + (S_IREAD >> 3) + (S_IREAD >> 6));
End of Patch.
