]> git.vpit.fr Git - perl/modules/Test-Leaner.git/blob - t/24-cmp_ok.t
Update the bug tracker URL in META after the rt.perl.org upgrade
[perl/modules/Test-Leaner.git] / t / 24-cmp_ok.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
7
8 use Test::Leaner tests => 7 * 10 + 4 * 7 + 10;
9
10 {
11  package Test::Leaner::TestCmpNum;
12
13  use overload '<=>' => sub {
14   my ($x, $y, $r) = @_;
15
16   $x = $x->{num};
17   $y = $y->{num} if ref $y;
18
19   ($x, $y) = ($y, $x) if $r;
20
21   return $x <=> $y;
22  };
23
24  sub new {
25   my $class = shift;
26
27   bless { num => $_[0] }, $class
28  }
29 }
30
31 my @num_tests = (
32  [ '1.0', '==', '1.0' ],
33  [ '1e0', '==', '1e0' ],
34  [ '1.0', '<=', '1.0' ],
35  [ '1.0', '>=', '1.0' ],
36  [ '1.0', '<=', '2.0' ],
37  [ '1.0', '<',  '2.0' ],
38  [ '2.0', '>=', '1.0' ],
39  [ '2.0', '>',  '1.0' ],
40  [ '1.0', '!=', '2.0' ],
41  [ '2.0', '!=', '1.0' ],
42 );
43
44 for my $t (@num_tests) {
45  my ($x, $op, $y) = @$t;
46
47  cmp_ok $x,      $op, $y;
48  cmp_ok int($x), $op, $y;
49  cmp_ok $x,      $op, int($y);
50  cmp_ok int($x), $op, int($y);
51
52  my $ox = Test::Leaner::TestCmpNum->new($x);
53  my $oy = Test::Leaner::TestCmpNum->new($y);
54
55  cmp_ok $ox,     $op, $y;
56  cmp_ok $x,      $op, $oy;
57  cmp_ok $ox,     $op, $oy;
58 }
59
60 {
61  package Test::Leaner::TestCmpStr;
62
63  use overload 'cmp' => sub {
64   my ($x, $y, $r) = @_;
65
66   $x = $x->{str};
67   $y = $y->{str} if ref $y;
68
69   ($x, $y) = ($y, $x) if $r;
70
71   return $x cmp $y;
72  };
73
74  sub new {
75   my $class = shift;
76
77   bless { str => $_[0] }, $class
78  }
79 }
80
81 my @str_tests = (
82  [ 'a', 'eq', 'a' ],
83  [ 'a', 'le', 'b' ],
84  [ 'a', 'lt', 'b' ],
85  [ 'b', 'ge', 'a' ],
86  [ 'b', 'gt', 'a' ],
87  [ 'a', 'ne', 'b' ],
88  [ 'b', 'ne', 'a' ],
89 );
90
91 for my $t (@str_tests) {
92  my ($x, $op, $y) = @$t;
93
94  cmp_ok $x, $op, $y;
95
96  my $ox = Test::Leaner::TestCmpStr->new($x);
97  my $oy = Test::Leaner::TestCmpStr->new($y);
98
99  cmp_ok $ox, $op, $y;
100  cmp_ok $x,  $op, $oy;
101  cmp_ok $ox, $op, $oy;
102 }
103
104 my @logic_tests = (
105  [ 1, 'or',  0 ],
106  [ 0, 'or',  1 ],
107  [ 1, 'or',  1 ],
108  [ 1, 'xor', 0 ],
109  [ 0, 'xor', 1 ],
110  [ 1, 'and', 1 ],
111
112  [ 1, '||', 0 ],
113  [ 0, '||', 1 ],
114  [ 1, '||', 1 ],
115  [ 1, '&&', 1 ],
116 );
117
118 for my $t (@logic_tests) {
119  my ($x, $op, $y) = @$t;
120  cmp_ok $x, $op, $y;
121 }