Change 19645 by [EMAIL PROTECTED] on 2003/05/31 05:37:10
Subject: Re: [perl #22372] [PATCH] sv_chop() broken
From: Enache Adrian <[EMAIL PROTECTED]>
Date: Fri, 30 May 2003 18:52:28 +0300
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/sv.c#663 edit
... //depot/perl/t/op/write.t#25 edit
Differences ...
==== //depot/perl/sv.c#663 (text) ====
Index: perl/sv.c
--- perl/sv.c#662~19640~ Thu May 29 22:47:15 2003
+++ perl/sv.c Fri May 30 22:37:10 2003
@@ -4501,6 +4501,8 @@
SvPOK(sv) must be true and the C<ptr> must be a pointer to somewhere inside
the string buffer. The C<ptr> becomes the first character of the adjusted
string. Uses the "OOK hack".
+Beware: after this function returns, C<ptr> and SvPVX(sv) may no longer
+refer to the same chunk of data.
=cut
*/
@@ -4509,9 +4511,9 @@
Perl_sv_chop(pTHX_ register SV *sv, register char *ptr)
{
register STRLEN delta;
-
if (!ptr || !SvPOKp(sv))
return;
+ delta = ptr - SvPVX(sv);
SV_CHECK_THINKFIRST(sv);
if (SvTYPE(sv) < SVt_PVIV)
sv_upgrade(sv,SVt_PVIV);
@@ -4531,7 +4533,6 @@
SvFLAGS(sv) |= SVf_OOK;
}
SvNIOK_off(sv);
- delta = ptr - SvPVX(sv);
SvLEN(sv) -= delta;
SvCUR(sv) -= delta;
SvPVX(sv) += delta;
==== //depot/perl/t/op/write.t#25 (xtext) ====
Index: perl/t/op/write.t
--- perl/t/op/write.t#24~16257~ Sun Apr 28 13:26:30 2002
+++ perl/t/op/write.t Fri May 30 22:37:10 2003
@@ -5,7 +5,7 @@
@INC = '../lib';
}
-print "1..47\n";
+print "1..48\n";
my $CAT = ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') ? 'type'
: ($^O eq 'MacOS') ? 'catenate'
@@ -271,7 +271,19 @@
else
{ print "not ok 11\n"; }
-# 12..47: scary format testing from Merijn H. Brand
+{
+ my $el;
+ format STDOUT =
+ok ^<<<<<<<<<<<<<<~~ # sv_chop() naze
+$el
+.
+ my %hash = (12 => 3);
+ for $el (keys %hash) {
+ write;
+ }
+}
+
+# 13..48: scary format testing from Merijn H. Brand
if ($^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'dos' || $^O eq 'MacOS' ||
($^O eq 'os2' and not eval '$OS2::can_fork')) {
@@ -281,7 +293,7 @@
use strict; # Amazed that this hackery can be made strict ...
-my $test = 12;
+my $test = 13;
# Just a complete test for format, including top-, left- and bottom marging
# and format detection through glob entries
End of Patch.
