Fix vcopy() with an out-of-bounds 'from' offset

diff --git a/Util.xs b/Util.xs
index 6733972275805f09ed91925b6899ffa744afa19e..86a21cae21f8f92668960c29cb619330851b249a 100644 (file)
--- 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 911b5a1f90d85bc463476dacc12c390131f2af6c..f39e9ab9cee4ed5b67301fc2e38b91138d9ae694 100644 (file)
--- 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 af8d3a639dfd67f4e656fd5bc19f62c70364a864..00f289702fd685d44ceeffc2ad81150ad166cb0d 100644 (file)
--- 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 f95fbd43a2417db1b2ee44121c3cdd0ec8c0980b..ddf8c472a4b1d031cd2f7b8a5b76aa0e5e40cdfd 100644 (file)
--- 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;