t/32-vcopy-move.t

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