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 (file)
--- 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 (file)
--- 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 (executable)
--- 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";
+
+