t/32-vcopy-move.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use lib 't/lib';
   7 use Test::Leaner 'no_plan';
   8
   9 use Scalar::Vec::Util qw/vcopy SVU_SIZE/;
  10
  11 my $p = SVU_SIZE;
  12 $p = 8 if $p < 8;
  13 my $n = 3 * $p;
  14 my $q = 1;
  15
  16 *myfill = *Scalar::Vec::Util::vfill_pp;
  17 *myeq   = *Scalar::Vec::Util::veq_pp;
  18
  19 sub rst { myfill($_[0], 0, $n, 0); $_[0] = '' }
  20
  21 sub pat {
  22  (undef, my $a, my $b, my $x) = @_;
  23  unless ($b) {
  24   rst $_[0];
  25  } else {
  26   $_[0] = '';
  27   myfill($_[0], 0,       $a,             $x);
  28   myfill($_[0], $a,      $b,             1 - $x);
  29   myfill($_[0], $a + $b, $n - ($a + $b), $x) if $a + $b < $n;
  30  }
  31 }
  32
  33 sub prnt {
  34  (undef, my $n, my $desc) = @_;
  35  my $i = 0;
  36  my $s;
  37  $s .= vec($_[0], $i++, 1) while $i < $n;
  38  diag "$desc: $s";
  39 }
  40
  41 my ($v, $c) = ('') x 2;
  42
  43 my @s = (0 .. $q, ($p - $q) .. ($p + $q));
  44 for my $s1 (@s) {
  45  for my $s2 (@s) {
  46   for my $l (0 .. $n - 1) {
  47    for my $x (0 .. $q) {
  48     for my $y (0 .. $q) {
  49      last if $s1 + $l + $x > $n or $s1 + $x + $y > $l
  50           or $s2 + $l + $x > $n or $s2 + $x + $y > $l;
  51      pat $v, $s1 + $x, $l - $x - $y, 0;
  52      my $v0 = $v;
  53      $c = $v;
  54      myfill($c, $s2,           $x,           0) if $x;
  55      myfill($c, $s2 + $x,      $l - $x - $y, 1);
  56      myfill($c, $s2 + $l - $y, $y,           0) if $y;
  57      vcopy $v => $s1, $v => $s2, $l;
  58      ok(myeq($v, 0, $c, 0, $n), "vcopy [ $x, $y ], $s1, $s2, $l (move)") or do {
  59       diag "n = $n, s1 = $s1, s2 = $s2, l = $l, x = $x, y = $y";
  60       prnt $v0, $n, 'original';
  61       prnt $v,  $n, 'got     ';
  62       prnt $c,  $n, 'expected';
  63      };
  64      is(length $v, length $c, "length is ok");
  65     }
  66    }
  67   }
  68  }
  69 }