t/20-version.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 3 + (2 + 2 * 3) * (50 + 4 * 7);
   7
   8 use CPANPLUS::Dist::Gentoo::Version;
   9
  10 sub V () { 'CPANPLUS::Dist::Gentoo::Version' }
  11
  12 eval { V->new() };
  13 like $@, qr/You\s+must\s+specify\s+a\s+version\s+string/, "V->(undef)";
  14
  15 eval { V->new('dongs') };
  16 like $@, qr/Couldn't\s+parse\s+version\s+string/, "V->('dongs')";
  17
  18 eval { my $res = 'dongs' < V->new(1) };
  19 like $@, qr/Couldn't\s+parse\s+version\s+string/, "'dongs' < V->new(1)";
  20
  21 my @tests = (
  22  [ 0, 0 =>  0 ],
  23  [ 1, 0 =>  1 ],
  24  [ 0, 1 => -1 ],
  25  [ 1, 1 =>  0 ],
  26
  27  [ '1.0',   1       =>  0 ],
  28  [ '1.1',   1       =>  1 ],
  29  [ '1.1',   '1.0'   =>  1 ],
  30  [ 1,       '1.0'   =>  0 ],
  31  [ 1,       '1.1'   => -1 ],
  32  [ '1.0',   '1.1'   => -1 ],
  33  [ '1.0.1', '1.1'   => -1 ],
  34  [ '1.0.1', '1.0.0' =>  1 ],
  35
  36  [ '1a',   1      =>  1 ],
  37  [ '1.0a', 1      =>  1 ],
  38  [ '1.0',  '1a'   => -1 ],
  39  [ '1a',   '1b'   => -1 ],
  40  [ '1.1a', '1.0b' =>  1 ],
  41
  42  map( {
  43   [ '1.0',        "1.0_${_}"  =>  1 ],
  44   [ '1.0a',       "1.0_${_}"  =>  1 ],
  45   [ '1.0',        "1.0_${_}1" =>  1 ],
  46   [ "1.0_${_}1",  "1.0_${_}1" =>  0 ],
  47   [ "1.0_${_}1",  "1.0_${_}2" => -1 ],
  48   [ "1.0a_${_}1", "1.0_${_}2" =>  1 ],
  49   [ "1.1_${_}1",  "1.0_${_}2" =>  1 ],
  50  } qw(alpha beta pre rc)),
  51
  52  [ '1.0',     '1.0_p'  => -1 ],
  53  [ '1.0a',    '1.0_p'  =>  1 ],
  54  [ '1.0',     '1.0_p1' => -1 ],
  55  [ '1.0_p1',  '1.0_p1' =>  0 ],
  56  [ '1.0_p1',  '1.0_p2' => -1 ],
  57  [ '1.0a_p1', '1.0_p2' =>  1 ],
  58  [ '1.1_p1',  '1.0_p2' =>  1 ],
  59
  60  [ '1.0_alpha1', '1.0_beta1' => -1 ],
  61  [ '1.0_beta1',  '1.0_pre1'  => -1 ],
  62  [ '1.0_pre1',   '1.0_rc1'   => -1 ],
  63  [ '1.0_rc1',    '1.0'       => -1 ],
  64  [ '1.0',        '1.0_p1'    => -1 ],
  65
  66  [ '1.0_alpha', '1.0_alpha_alpha' =>  1 ],
  67  [ '1.0_beta',  '1.0_beta_beta'   =>  1 ],
  68  [ '1.0_pre',   '1.0_pre_pre'     =>  1 ],
  69  [ '1.0_rc',    '1.0_rc_rc'       =>  1 ],
  70  [ '1.0_p',     '1.0_p_p'         => -1 ],
  71
  72  [ '1.0_alpha',    '1.0_alpha_p'     => -1 ],
  73  [ '1.0_beta',     '1.0_alpha_beta'  =>  1 ],
  74  [ '1.0_beta',     '1.0_alpha_p'     =>  1 ],
  75  [ '1.0_pre1_rc2', '1.0_pre1_rc2'    =>  0 ],
  76  [ '1.0_pre1_rc2', '1.0_pre1_rc3'    => -1 ],
  77
  78  [ '1.0',    '1.0-r1' => -1 ],
  79  [ '1.0-r1', '1.0-r1' =>  0 ],
  80  [ '1.0-r1', '1.0-r2' => -1 ],
  81  [ '1.1-r1', '1.0-r2' =>  1 ],
  82
  83  [ '1.2_p1-r1',      '1.2_p1',            1 ],
  84  [ '1.2_p1-r1',      '1.2_p1_p1',        -1 ],
  85  [ '1.2_p1_pre2-r1', '1.2_p1-r1',        -1 ],
  86  [ '1.2_p1_pre2-r1', '1.2_p1_beta3-r1',   1 ],
  87  [ '1.2_p1_pre2-r1', '1.2_p1_beta3-r4',   1 ],
  88  [ '1.2_p1_pre2-r1', '1.2_p2_beta3-r4',  -1 ],
  89  [ '1.2_p1_pre2-r1', '1.2a_p1_beta3-r1', -1 ],
  90 );
  91
  92 sub compare_ok {
  93  my ($a, $cmp, $b, $exp) = @_;
  94
  95  my $desc = join " $cmp ", map { ref() ? "V->new('$_')" : "'$_'" } $a, $b;
  96
  97  my ($err, $c);
  98  {
  99   local $@;
 100   $c   = eval "\$a $cmp \$b";
 101   $err = $@;
 102  }
 103
 104  if (ref $exp eq 'Regexp') {
 105   like $err, $exp, "$desc should fail";
 106  } elsif ($err) {
 107   fail "$desc failed but shouldn't: $err";
 108  } else {
 109   is $c, $exp, "$desc == '$exp'";
 110  }
 111 }
 112
 113 for (@tests) {
 114  my ($s1, $s2, $exp) = @$_;
 115
 116  my $v1 = eval { V->new($s1) };
 117  is $@, '', "'$s1' parses fine";
 118
 119  my $v2 = eval { V->new($s2) };
 120  is $@, '', "'$s2' parses fine";
 121
 122  for my $r (0 .. 1) {
 123   if ($r) {
 124    ($v1, $v2) = ($v2, $v1);
 125    ($s1, $s2) = ($s2, $s1);
 126    $exp = -$exp;
 127   }
 128
 129   compare_ok($v1, '<=>', $v2, $exp);
 130   compare_ok($v1, '<=>', $s2, $exp);
 131   compare_ok($s1, '<=>', $v2, $exp);
 132  }
 133 }