]> git.vpit.fr Git - perl/modules/Scalar-Vec-Util.git/blob - t/11-veq.t
Get rid of t/99-kwalitee.t
[perl/modules/Scalar-Vec-Util.git] / t / 11-veq.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<veq SVU_SIZE>;
9
10 for ([ 1, 'offset', -1 ], [ 3, 'offset', '-1' ], [ 4, 'length', -1 ]) {
11  my @args  = ('1') x 5;
12  $args[$_->[0]] = $_->[2];
13  local $@;
14  eval { &veq(@args) };
15  my $err  = $@;
16  my $line = __LINE__-2;
17  like $err, qr/^Invalid\s+negative\s+$_->[1]\s+at\s+\Q$0\E\s+line\s+$line/,
18       "veq(@args) failed";
19 }
20
21 my $p = SVU_SIZE;
22 $p    = 8 if $p < 8;
23 my $n = 3 * $p;
24 my $q = 1;
25
26 sub myfill {
27  my (undef, $s, $l, $x) = @_;
28  $x = 1 if $x;
29  vec($_[0], $_, 1) = $x for $s .. $s + $l - 1;
30 }
31
32 sub rst {
33  myfill $_[0], 0, $n, 0;
34 }
35
36 sub pat {
37  my (undef, $a, $b, $x, $y) = @_;
38  myfill $_[0], 0,       $a,             $x;
39  myfill $_[0], $a,      $b,             1 - $x;
40  myfill $_[0], $a + $b, $n - ($a + $b), $x     if $y;
41 }
42
43 my $z = '';
44
45 my @s = ($p - $q) .. ($p + $q);
46 for my $s1 (@s) {
47  for my $s2 (@s) {
48   for my $l (0 .. $n) {
49    next if $s1 + $l > $n or $s2 + $l > $n;
50    my $v1 = '';
51    my $v2 = '';
52    pat $v1, $s1, $l, 0, 0;
53    pat $v2, $s2, $l, 0, 1;
54    if ($l > 0) {
55     my $desc = "not veq 0, 0, $n";
56     ok    !veq($v1 => 0, $z  => 0, $n), "$desc [1<=>0,$l]";
57     ok    !veq($z  => 0, $v1 => 0, $n), "$desc [0<=>1,$l]";
58    }
59    for my $r ($l, $l + $n + 1) {
60     my $desc = "veq $s1, $s2, $r";
61     ok     veq($v1 => $s1,   $v2 => $s2,   $r), "$desc [1<=>2,$l]";
62     ok     veq($v2 => $s2,   $v1 => $s1,   $r), "$desc [2<=>1,$l]";
63     if ($l > 0) { # Implies $r > 0
64      if ($s1 > 0) {
65       my $desc = 'not veq ' . ($s1 - 1). ", $s2, $r";
66       ok !veq($v1 => $s1-1, $v2 => $s2,   $r), "$desc [1-1<=>2,$l]";
67       ok !veq($v2 => $s2,   $v1 => $s1-1, $r), "$desc [2<=>1-1,$l]";
68      }
69      {
70       my $desc = 'not veq ' . ($s1 + 1). ", $s2, $r";
71       ok !veq($v1 => $s1+1, $v2 => $s2,   $r), "$desc [1+1<=>2,$l]";
72       ok !veq($v2 => $s2,   $v1 => $s1+1, $r), "$desc [2<=>1+1,$l]";
73      }
74     }
75    }
76   }
77  }
78 }