From: Robin Houston <robin@cpan.org>
Date: Thu, 10 May 2001 18:54:59 +0000 (+0100)
Subject: Extend tr/\0-\377/blah/c support
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bec892532a745f0388849c19cf8d4d5b3cbbda35;p=p5sagit%2Fp5-mst-13.2.git

Extend tr/\0-\377/blah/c support
Message-ID: <20010510185459.A5995@penderel>

p4raw-id: //depot/perl@10075
---

diff --git a/ext/B/B.xs b/ext/B/B.xs
index b19eb7c..ea4f620 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -756,13 +756,22 @@ PVOP_pv(o)
 	B::PVOP	o
     CODE:
 	/*
-	 * OP_TRANS uses op_pv to point to a table of 256 or 258 shorts
+	 * OP_TRANS uses op_pv to point to a table of 256 or >=258 shorts
 	 * whereas other PVOPs point to a null terminated string.
 	 */
-	ST(0) = sv_2mortal(newSVpv(o->op_pv, (o->op_type == OP_TRANS) ?
-			   ((o->op_private & OPpTRANS_COMPLEMENT) &&
-			   !(o->op_private & OPpTRANS_DELETE) ? 258 : 256)
-			    * sizeof(short) : 0));
+	if (o->op_type == OP_TRANS &&
+		(o->op_private & OPpTRANS_COMPLEMENT) &&
+		!(o->op_private & OPpTRANS_DELETE))
+	{
+	    short* tbl = (short*)o->op_pv;
+	    short entries = 257 + tbl[256];
+	    ST(0) = sv_2mortal(newSVpv(o->op_pv, entries * sizeof(short)));
+	}
+	else if (o->op_type == OP_TRANS) {
+	    ST(0) = sv_2mortal(newSVpv(o->op_pv, 256 * sizeof(short)));
+	}
+	else
+	    ST(0) = sv_2mortal(newSVpv(o->op_pv, 0));
 
 #define LOOP_redoop(o)	o->op_redoop
 #define LOOP_nextop(o)	o->op_nextop
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index f88b0fb..21fdd15 100644
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -3238,7 +3238,7 @@ sub collapse {
 sub tr_decode_byte {
     my($table, $flags) = @_;
     my(@table) = unpack("s*", $table);
-    splice @table, 0x100, 1;   # Just flags presence of element 0x101
+    splice @table, 0x100, 1;   # Number of subsequent elements
     my($c, $tr, @from, @to, @delfrom, $delhyphen);
     if ($table[ord "-"] != -1 and 
 	$table[ord("-") - 1] == -1 || $table[ord("-") + 1] == -1)
diff --git a/t/op/tr.t b/t/op/tr.t
index 7c73430..1e30365 100755
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..69\n";
+print "1..70\n";
 
 $_ = "abcdefghijklmnopqrstuvwxyz";
 
@@ -385,3 +385,9 @@ print "ok 68\n";
 print "not " if "@a" ne "1 2";
 print "ok 69\n";
 
+# Additional test for Inaba Hiroto patch (robin@kitsite.com)
+($a = "\x{100}\x{102}\x{101}") =~ tr/\x00-\377/XYZ/c;
+print "not " unless $a eq "XZY";
+print "ok 70\n";
+
+