diff options
| -rw-r--r-- | doop.c | 20 | ||||
| -rw-r--r-- | pod/perlapi.pod | 14 | ||||
| -rw-r--r-- | sv.c | 14 | ||||
| -rwxr-xr-x | t/op/bop.t | 74 |
4 files changed, 102 insertions, 20 deletions
@@ -1221,7 +1221,8 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) (void)SvPOK_only(sv); if (left_utf || right_utf) { UV duc, luc, ruc; - char * const dcsave = dc; + char *dcorig = dc; + char *dcsave = NULL; STRLEN lulen = leftlen; STRLEN rulen = rightlen; STRLEN ulen; @@ -1239,8 +1240,8 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) dc = (char*)uvchr_to_utf8((U8*)dc, duc); } if (sv == left || sv == right) - (void)sv_usepvn(sv, dcsave, needlen); - SvCUR_set(sv, dc - dcsave); + (void)sv_usepvn(sv, dcorig, needlen); + SvCUR_set(sv, dc - dcorig); break; case OP_BIT_XOR: while (lulen && rulen) { @@ -1266,15 +1267,20 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) dc = (char*)uvchr_to_utf8((U8*)dc, duc); } mop_up_utf: + if (rulen) + dcsave = savepvn(rc, rulen); + else if (lulen) + dcsave = savepvn(lc, lulen); if (sv == left || sv == right) - (void)sv_usepvn(sv, dcsave, needlen); - SvCUR_set(sv, dc - dcsave); + (void)sv_usepvn(sv, dcorig, needlen); /* Uses Renew(). */ + SvCUR_set(sv, dc - dcorig); if (rulen) - sv_catpvn(sv, rc, rulen); + sv_catpvn(sv, dcsave, rulen); else if (lulen) - sv_catpvn(sv, lc, lulen); + sv_catpvn(sv, dcsave, lulen); else *SvEND(sv) = '\0'; + Safefree(dcsave); break; } SvUTF8_on(sv); diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 6af8b05cfd..8b214d46bb 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -5725,12 +5725,14 @@ Found in file sv.c =item sv_usepvn X<sv_usepvn> -Tells an SV to use C<ptr> to find its string value. Normally the string is -stored inside the SV but sv_usepvn allows the SV to use an outside string. -The C<ptr> should point to memory that was allocated by C<malloc>. The -string length, C<len>, must be supplied. This function will realloc the -memory pointed to by C<ptr>, so that pointer should not be freed or used by -the programmer after giving it to sv_usepvn. Does not handle 'set' magic. +Tells an SV to use C<ptr> to find its string value. Normally the +string is stored inside the SV but sv_usepvn allows the SV to use an +outside string. The C<ptr> should point to memory that was allocated +by C<malloc>. The string length, C<len>, must be supplied. This +function will realloc (i.e. move) the memory pointed to by C<ptr>, +so that pointer should not be freed or used by the programmer after +giving it to sv_usepvn, and neither should any pointers from "behind" +that pointer (e.g. ptr + 1) be used. Does not handle 'set' magic. See C<sv_usepvn_mg>. void sv_usepvn(SV* sv, char* ptr, STRLEN len) @@ -3883,12 +3883,14 @@ Perl_sv_setpv_mg(pTHX_ register SV *sv, register const char *ptr) /* =for apidoc sv_usepvn -Tells an SV to use C<ptr> to find its string value. Normally the string is -stored inside the SV but sv_usepvn allows the SV to use an outside string. -The C<ptr> should point to memory that was allocated by C<malloc>. The -string length, C<len>, must be supplied. This function will realloc the -memory pointed to by C<ptr>, so that pointer should not be freed or used by -the programmer after giving it to sv_usepvn. Does not handle 'set' magic. +Tells an SV to use C<ptr> to find its string value. Normally the +string is stored inside the SV but sv_usepvn allows the SV to use an +outside string. The C<ptr> should point to memory that was allocated +by C<malloc>. The string length, C<len>, must be supplied. This +function will realloc (i.e. move) the memory pointed to by C<ptr>, +so that pointer should not be freed or used by the programmer after +giving it to sv_usepvn, and neither should any pointers from "behind" +that pointer (e.g. ptr + 1) be used. Does not handle 'set' magic. See C<sv_usepvn_mg>. =cut diff --git a/t/op/bop.t b/t/op/bop.t index 6bc1067cc2..28ac60e62a 100755 --- a/t/op/bop.t +++ b/t/op/bop.t @@ -15,7 +15,7 @@ BEGIN { # If you find tests are failing, please try adding names to tests to track # down where the failure is, and supply your new names as a patch. # (Just-in-time test naming) -plan tests => 148; +plan tests => 160; # numerics ok ((0xdead & 0xbeef) == 0x9ead); @@ -340,3 +340,75 @@ SKIP: { $b &= "b"; ok($b =~ /b+$/, 'Unicode "b" is NUL-terminated'); } + +{ + $a = chr(0x101) x 0x101; + $b = chr(0x0FF) x 0x0FF; + + $c = $a | $b; + is($c, chr(0x1FF) x 0xFF . chr(0x101) x 2); + + $c = $b | $a; + is($c, chr(0x1FF) x 0xFF . chr(0x101) x 2); + + $c = $a & $b; + is($c, chr(0x001) x 0x0FF); + + $c = $b & $a; + is($c, chr(0x001) x 0x0FF); + + $c = $a ^ $b; + is($c, chr(0x1FE) x 0x0FF . chr(0x101) x 2); + + $c = $b ^ $a; + is($c, chr(0x1FE) x 0x0FF . chr(0x101) x 2); +} + +{ + $a = chr(0x101) x 0x101; + $b = chr(0x0FF) x 0x0FF; + + $a |= $b; + is($a, chr(0x1FF) x 0xFF . chr(0x101) x 2); +} + +{ + $a = chr(0x101) x 0x101; + $b = chr(0x0FF) x 0x0FF; + + $b |= $a; + is($b, chr(0x1FF) x 0xFF . chr(0x101) x 2); +} + +{ + $a = chr(0x101) x 0x101; + $b = chr(0x0FF) x 0x0FF; + + $a &= $b; + is($a, chr(0x001) x 0x0FF); +} + +{ + $a = chr(0x101) x 0x101; + $b = chr(0x0FF) x 0x0FF; + + $b &= $a; + is($b, chr(0x001) x 0x0FF); +} + +{ + $a = chr(0x101) x 0x101; + $b = chr(0x0FF) x 0x0FF; + + $a ^= $b; + is($a, chr(0x1FE) x 0x0FF . chr(0x101) x 2); +} + +{ + $a = chr(0x101) x 0x101; + $b = chr(0x0FF) x 0x0FF; + + $b ^= $a; + is($b, chr(0x1FE) x 0x0FF . chr(0x101) x 2); +} + |