t/24-cmp_ok.t

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