From: Vincent Pit Date: Mon, 24 Sep 2012 21:31:38 +0000 (+0200) Subject: Fix vcopy() with an out-of-bounds 'from' offset X-Git-Tag: v0.07~4 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScalar-Vec-Util.git;a=commitdiff_plain;h=4dc1aa8932c595136b763a34207e4e9ee683dc53 Fix vcopy() with an out-of-bounds 'from' offset --- diff --git a/Util.xs b/Util.xs index 6733972..86a21ca 100644 --- a/Util.xs +++ b/Util.xs @@ -98,8 +98,8 @@ void vcopy(SV *sf, SV *sfs, SV *st, SV *sts, SV *sl) PROTOTYPE: $$$$$ PREINIT: - size_t fs, ts, l, lf = 0, c; - char *t, *f; + size_t fs, ts, l, e, lf, cf; + char *vt, *vf; CODE: l = svu_validate_uv(sl, "length"); if (!l) @@ -107,24 +107,25 @@ CODE: fs = svu_validate_uv(sfs, "offset"); ts = svu_validate_uv(sts, "offset"); - t = svu_prepare_sv(st, ts, l); - - f = SvPVX(sf); /* We do it there in case st == sf. */ - c = SvCUR(sf); - if (c * CHAR_BIT <= fs + l && c <= SvCUR(st)) { - lf = fs + l - c * CHAR_BIT; - l = c * CHAR_BIT - fs; + SvUPGRADE(sf, SVt_PV); + vt = svu_prepare_sv(st, ts, l); + + /* We fetch vf after upgrading st in case st == sf. */ + vf = SvPVX(sf); + cf = SvCUR(sf) * CHAR_BIT; + lf = fs + l; + e = lf > cf ? lf - cf : 0; + l = l > e ? l - e : 0; + + if (l) { + if (vf == vt) + bv_move(vf, ts, fs, l); + else + bv_copy(vt, ts, vf, fs, l); } - if (f == t) { - bv_move(f, ts, fs, l); - } else { - bv_copy(t, ts, f, fs, l); - } - - if (lf) { - bv_fill(t, ts + l, lf, 0); - } + if (e) + bv_fill(vt, ts + l, e, 0); XSRETURN(0); diff --git a/t/30-vcopy-pp.t b/t/30-vcopy-pp.t index 911b5a1..f39e9ab 100644 --- a/t/30-vcopy-pp.t +++ b/t/30-vcopy-pp.t @@ -45,7 +45,7 @@ my @s = ($p - $q) .. ($p + $q); for my $s1 (@s) { for my $s2 (@s) { for my $l (0 .. $n - 1) { - last if $s1 + $l > $n or $s2 + $l > $n; + next if $s1 + $l > $n or $s2 + $l > $n; my $desc = "vcopy_pp $s1, $s2, $l"; pat $f, $s1, $l, 0; rst $t; diff --git a/t/31-vcopy-copy.t b/t/31-vcopy-copy.t index af8d3a6..00f2897 100644 --- a/t/31-vcopy-copy.t +++ b/t/31-vcopy-copy.t @@ -49,7 +49,6 @@ my @s = ($p - $q) .. ($p + $q); for my $s1 (@s) { for my $s2 (@s) { for my $l (0 .. $n - 1) { - last if $s1 + $l > $n or $s2 + $l > $n; my $desc = "vcopy $s1, $s2, $l"; pat $f, $s1, $l, 0; rst $t; diff --git a/t/32-vcopy-move.t b/t/32-vcopy-move.t index f95fbd4..ddf8c47 100644 --- a/t/32-vcopy-move.t +++ b/t/32-vcopy-move.t @@ -50,8 +50,7 @@ for my $s1 (@s) { for my $l (0 .. $n - 1) { for my $x (0 .. $q) { for my $y (0 .. $q) { - last if $s1 + $l + $x > $n or $s1 + $x + $y > $l - or $s2 + $l + $x > $n or $s2 + $x + $y > $l; + next if $l - $x - $y < 0 or $s2 + $l - $y < 0; my $desc = "vcopy [ $x, $y ], $s1, $s2, $l (move)"; pat $v, $s1 + $x, $l - $x - $y, 0; my $v0 = $v;