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 BEGIN {
  12  *myfill = *Scalar::Vec::Util::vfill_pp;
  13  *myeq   = *Scalar::Vec::Util::veq_pp;
  14 }
  15
  16 my $p = SVU_SIZE;
  17 $p    = 8 if $p < 8;
  18 my $n = 3 * $p;
  19 my $q = 1;
  20
  21 sub rst {
  22  myfill $_[0], 0, $n, 0;
  23  $_[0] = '';
  24 }
  25
  26 sub pat {
  27  my (undef, $a, $b, $x) = @_;
  28  if ($b) {
  29   $_[0] = '';
  30   myfill $_[0], 0,       $a,             $x;
  31   myfill $_[0], $a,      $b,             1 - $x;
  32   myfill $_[0], $a + $b, $n - ($a + $b), $x      if $a + $b < $n;
  33  } else {
  34   rst $_[0];
  35  }
  36 }
  37
  38 sub prnt {
  39  my (undef, $n, $desc) = @_;
  40  my $s = '';
  41  $s .= vec($_[0], $_, 1) for 0 .. $n - 1;
  42  diag "$desc: $s";
  43 }
  44
  45 my ($v, $c) = ('') x 2;
  46
  47 my @s = (0 .. $q, ($p - $q) .. ($p + $q));
  48 for my $s1 (@s) {
  49  for my $s2 (@s) {
  50   for my $l (0 .. $n - 1) {
  51    for my $x (0 .. $q) {
  52     for my $y (0 .. $q) {
  53      last if $s1 + $l + $x > $n or $s1 + $x + $y > $l
  54           or $s2 + $l + $x > $n or $s2 + $x + $y > $l;
  55      my $desc = "vcopy [ $x, $y ], $s1, $s2, $l (move)";
  56      pat $v, $s1 + $x, $l - $x - $y, 0;
  57      my $v0 = $v;
  58      $c = $v;
  59      myfill $c, $s2,           $x,           0 if $x;
  60      myfill $c, $s2 + $x,      $l - $x - $y, 1;
  61      myfill $c, $s2 + $l - $y, $y,           0 if $y;
  62      vcopy $v => $s1, $v => $s2, $l;
  63      is length $v, length $c,   "$desc: length";
  64      ok myeq($v, 0, $c, 0, $n), "$desc: bits" or do {
  65       diag "n = $n, s1 = $s1, s2 = $s2, l = $l, x = $x, y = $y";
  66       prnt $v0, $n, 'original';
  67       prnt $v,  $n, 'got     ';
  68       prnt $c,  $n, 'expected';
  69      }
  70     }
  71    }
  72   }
  73  }
  74 }