This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
doop.c: (Coverity) found a bug but not quite what Coverity thought it did (try valgri...
authorJarkko Hietaniemi <jhi@iki.fi>
Thu, 13 Apr 2006 19:20:46 +0000 (22:20 +0300)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Fri, 14 Apr 2006 16:11:19 +0000 (16:11 +0000)
Message-Id: <20060413162046.5F9636D08C@ugli.hut.fi>

p4raw-id: //depot/perl@27801

doop.c
pod/perlapi.pod
sv.c
t/op/bop.t

diff --git a/doop.c b/doop.c
index 3e60665..cfc67cb 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -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);
index 6af8b05..8b214d4 100644 (file)
@@ -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)
diff --git a/sv.c b/sv.c
index 8e90234..3f44139 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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
index 6bc1067..28ac60e 100755 (executable)
@@ -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);
+}
+