diff options
| -rw-r--r-- | doop.c | 2 | ||||
| -rw-r--r-- | pod/perlunicode.pod | 12 | ||||
| -rw-r--r-- | pp.c | 39 | ||||
| -rwxr-xr-x | t/op/bop.t | 36 |
4 files changed, 74 insertions, 15 deletions
@@ -926,7 +926,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) if (left_utf && !right_utf) sv_utf8_upgrade(right); - if (!left_utf && right_utf) + else if (!left_utf && right_utf) sv_utf8_upgrade(left); if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv))) diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod index e567e183e1..30a4482260 100644 --- a/pod/perlunicode.pod +++ b/pod/perlunicode.pod @@ -198,6 +198,18 @@ byte-oriented C<chr()> and C<ord()> under utf8. =item * +The bit string operators C<& | ^ ~> can operate on character data. +However, for backward compatibility reasons (bit string operations +when the characters all are less than 256 in ordinal value) one cannot +mix C<~> (the bit complement) and characters both less than 256 and +equal or greater than 256. Most importantly, the DeMorgan's laws +(C<~($x|$y) eq ~$x&~$y>, C<~($x&$y) eq ~$x|~$y>) won't hold. +Another way to look at this is that the complement cannot return +B<both> the 8-bit (byte) wide bit complement, and the full character +wide bit complement. + +=item * + And finally, C<scalar reverse()> reverses by character rather than by byte. =back @@ -1476,31 +1476,50 @@ PP(pp_complement) tmps = (U8*)SvPV_force(TARG, len); anum = len; if (SvUTF8(TARG)) { - /* Calculate exact length, let's not estimate */ + /* Calculate exact length, let's not estimate. */ STRLEN targlen = 0; U8 *result; U8 *send; STRLEN l; + UV nchar = 0; + UV nwide = 0; send = tmps + len; while (tmps < send) { UV c = utf8_to_uv(tmps, 0, &l, UTF8_ALLOW_ANY); tmps += UTF8SKIP(tmps); targlen += UNISKIP(~c); + nchar++; + if (c > 0xff) + nwide++; } /* Now rewind strings and write them. */ tmps -= len; - Newz(0, result, targlen + 1, U8); - while (tmps < send) { - UV c = utf8_to_uv(tmps, 0, &l, UTF8_ALLOW_ANY); - tmps += UTF8SKIP(tmps); - result = uv_to_utf8(result,(UV)~c); + + if (nwide) { + Newz(0, result, targlen + 1, U8); + while (tmps < send) { + UV c = utf8_to_uv(tmps, 0, &l, UTF8_ALLOW_ANY); + tmps += UTF8SKIP(tmps); + result = uv_to_utf8(result, ~c); + } + *result = '\0'; + result -= targlen; + sv_setpvn(TARG, (char*)result, targlen); + SvUTF8_on(TARG); + } + else { + Newz(0, result, nchar + 1, U8); + while (tmps < send) { + U8 c = (U8)utf8_to_uv(tmps, 0, &l, UTF8_ALLOW_ANY); + tmps += UTF8SKIP(tmps); + *result++ = ~c; + } + *result = '\0'; + result -= nchar; + sv_setpvn(TARG, (char*)result, nchar); } - *result = '\0'; - result -= targlen; - sv_setpvn(TARG, (char*)result, targlen); - SvUTF8_on(TARG); Safefree(result); SETs(TARG); RETURN; diff --git a/t/op/bop.t b/t/op/bop.t index fd080e6be8..3fad2fd172 100755 --- a/t/op/bop.t +++ b/t/op/bop.t @@ -9,7 +9,7 @@ BEGIN { @INC = '../lib'; } -print "1..38\n"; +print "1..40\n"; # numerics print ((0xdead & 0xbeef) == 0x9ead ? "ok 1\n" : "not ok 1\n"); @@ -107,7 +107,7 @@ for (0x100...0xFFF) { if $a ne chr(~$_) or length($a) != 1 or ~$a ne chr($_); } if (@not36) { - print "# test 36 failed: @not36\n"; + print "# test 36 failed\n"; print "not "; } print "ok 36\n"; @@ -120,14 +120,42 @@ for my $i (0xEEE...0xF00) { push @not37, sprintf("%#03X %#03X", $i, $j) if $a ne chr(~$i).chr(~$j) or length($a) != 2 or - ~$a ne chr($i).chr($j); + ~$a ne chr($i).chr($j); } } if (@not37) { - print "# test 37 failed: @not37\n"; + print "# test 37 failed\n"; print "not "; } print "ok 37\n"; print "not " unless ~chr(~0) eq "\0"; print "ok 38\n"; + +my @not39; + +for my $i (0x100..0x120) { + for my $j (0x100...0x120) { + push @not39, sprintf("%#03X %#03X", $i, $j) + if ~(chr($i)|chr($j)) ne (~chr($i)&~chr($j)); + } +} +if (@not39) { + print "# test 39 failed\n"; + print "not "; +} +print "ok 39\n"; + +my @not40; + +for my $i (0x100..0x120) { + for my $j (0x100...0x120) { + push @not40, sprintf("%#03X %#03X", $i, $j) + if ~(chr($i)&chr($j)) ne (~chr($i)|~chr($j)); + } +} +if (@not40) { + print "# test 40 failed\n"; + print "not "; +} +print "ok 40\n"; |