From: Inaba Hiroto <inaba@st.rim.or.jp>
Date: Sat, 10 Jan 1998 15:53:33 +0000 (+0900)
Subject: [win32] still another
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f3ea7b5ee70397733e54550d64ca43f4288e744f;p=p5sagit%2Fp5-mst-13.2.git

[win32] still another
	Subject: [PERL] tr///s bug
	Message-Id: <19980110155333D.inaba@st.rim.or.jp>

p4raw-id: //depot/win32/perl@613
---

diff --git a/doop.c b/doop.c
index be3e674..4b10dde 100644
--- a/doop.c
+++ b/doop.c
@@ -29,6 +29,7 @@ do_trans(SV *sv, OP *arg)
     register I32 ch;
     register I32 matches = 0;
     register I32 squash = op->op_private & OPpTRANS_SQUASH;
+    register U8 *p;
     STRLEN len;
 
     if (SvREADONLY(sv) && !(op->op_private & OPpTRANS_COUNTONLY))
@@ -63,14 +64,16 @@ do_trans(SV *sv, OP *arg)
     }
     else {
 	d = s;
+	p = send;
 	while (s < send) {
 	    if ((ch = tbl[*s]) >= 0) {
 		*d = ch;
-		if (matches++ && squash) {
-		    if (d[-1] == *d)
+		matches++;
+		if (squash) {
+		    if (p == d - 1 && *p == *d)
 			matches--;
 		    else
-			d++;
+		        p = d++;
 		}
 		else
 		    d++;
diff --git a/t/op/subst.t b/t/op/subst.t
index c6cfb8c..4fd00d5 100755
--- a/t/op/subst.t
+++ b/t/op/subst.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: s.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:22 $
 
-print "1..67\n";
+print "1..68\n";
 
 $x = 'foo';
 $_ = "x";
@@ -261,3 +261,9 @@ print $_ eq "foobarfoobbar" ? "ok 66\n" : "not ok 66 # `$_' ne `foobarfoobbar'\n
 eval 's{foo} # this is a comment, not a delimiter
        {bar};';
 print @? ? "not ok 67\n" : "ok 67\n";
+
+# check if squashing works at the end of string
+$_="baacbaa";
+tr/a/b/s;
+print $_ eq "bbcbb" ? "ok 68\n" : "not ok 68 # `$_' ne `bbcbb'\n";
+