Re: [perl #22372] [PATCH] sv_chop() broken

Message-ID: <20030530155228.GA872@ratsnest.hole>

p4raw-id: //depot/perl@19645

diff --git a/sv.c b/sv.c
index 310ba50..d6ae16c 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4501,6 +4501,8 @@ Efficient removal of characters from the beginning of the string buffer.
 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 @@ void
 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 @@ Perl_sv_chop(pTHX_ register SV *sv, register char *ptr)
        SvFLAGS(sv) |= SVf_OOK; 
     }
     SvNIOK_off(sv);
-    delta = ptr - SvPVX(sv);
     SvLEN(sv) -= delta;
     SvCUR(sv) -= delta;
     SvPVX(sv) += delta;

diff --git a/t/op/write.t b/t/op/write.t
index 6af6fcb..c2d7755 100755 (executable)
--- a/t/op/write.t
+++ b/t/op/write.t
@@ -5,7 +5,7 @@ BEGIN {
     @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 @@ if (`$CAT Op_write.tmp` eq $right)
 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 @@ if ($^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'dos' || $^O eq 'MacOS' ||
 
 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