t/20-version.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 3 + (2 + 2 * 3) * (69 + 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  [ 1, 1 =>  0 ],
  25
  26  [ '00',  '0'  => 0 ],
  27  [ '01',  '1'  => 0 ],
  28  [ '001', '1'  => 0 ],
  29  [ '001', '01' => 0 ],
  30
  31  [ '1.0',   1       =>  1 ], # Yes, 1.0 > 1. Deal with it
  32  [ '1.0',   '1.0'   =>  0 ],
  33  [ '1.1',   1       =>  1 ],
  34  [ '1.1',   '1.0'   =>  1 ],
  35  [ '1.1',   '1.1'   =>  0 ],
  36  [ '1.1',   '1.10'  => -1 ],
  37  [ '1.1',   '1.01'  =>  1 ],
  38  [ '1.1',   '1.010' =>  1 ],
  39  [ '1.01',  '1.010' =>  0 ],
  40
  41  [ '1.0.0',  1         =>  1 ], # Ditto
  42  [ '1.0.0',  '1.0'     =>  1 ], # Tritto
  43  [ '1.0.0',  '1.0.0'   =>  0 ],
  44  [ '1.0.1',  '1.1'     => -1 ],
  45  [ '1.0.1',  '1.0.0'   =>  1 ],
  46  [ '1.0.1',  '1.0.1'   =>  0 ],
  47  [ '1.0.1',  '1.0.10'  => -1 ],
  48  [ '1.0.1',  '1.0.01'  =>  1 ],
  49  [ '1.0.1',  '1.0.010' =>  1 ],
  50  [ '1.0.01', '1.0.010' =>  0 ],
  51
  52  [ '1a',    1        =>  1 ],
  53  [ '1.0a',  1        =>  1 ],
  54  [ '1.0',   '1a'     =>  1 ], # Same
  55  [ '1a',    '1b'     => -1 ],
  56  [ '1.1a',  '1.0b'   =>  1 ],
  57  [ '1.1a',  '1.01a'  =>  1 ],
  58  [ '1.01a', '1.010a' =>  0 ],
  59
  60  map( {
  61   [ '1.0',        "1.0_${_}"  =>  1 ],
  62   [ '1.0a',       "1.0_${_}"  =>  1 ],
  63   [ '1.0',        "1.0_${_}1" =>  1 ],
  64   [ "1.0_${_}1",  "1.0_${_}1" =>  0 ],
  65   [ "1.0_${_}1",  "1.0_${_}2" => -1 ],
  66   [ "1.0a_${_}1", "1.0_${_}2" =>  1 ],
  67   [ "1.1_${_}1",  "1.0_${_}2" =>  1 ],
  68  } qw(alpha beta pre rc)),
  69
  70  [ '1.0',     '1.0_p0' => -1 ],
  71  [ '1.0',     '1.0_p1' => -1 ],
  72  [ '1.0_p',   '1.0_p0' =>  0 ],
  73  [ '1.0a',    '1.0_p'  =>  1 ],
  74  [ '1.0',     '1.0_p1' => -1 ],
  75  [ '1.0_p1',  '1.0_p1' =>  0 ],
  76  [ '1.0_p1',  '1.0_p2' => -1 ],
  77  [ '1.0a_p1', '1.0_p2' =>  1 ],
  78  [ '1.1_p1',  '1.0_p2' =>  1 ],
  79
  80  [ '1.0_alpha1', '1.0_beta1' => -1 ],
  81  [ '1.0_beta1',  '1.0_pre1'  => -1 ],
  82  [ '1.0_pre1',   '1.0_rc1'   => -1 ],
  83  [ '1.0_rc1',    '1.0'       => -1 ],
  84
  85  [ '1.0_alpha', '1.0_alpha_alpha' =>  1 ],
  86  [ '1.0_beta',  '1.0_beta_beta'   =>  1 ],
  87  [ '1.0_pre',   '1.0_pre_pre'     =>  1 ],
  88  [ '1.0_rc',    '1.0_rc_rc'       =>  1 ],
  89  [ '1.0_p',     '1.0_p_p'         => -1 ],
  90
  91  [ '1.0_alpha',    '1.0_alpha_p'     => -1 ],
  92  [ '1.0_beta',     '1.0_alpha_beta'  =>  1 ],
  93  [ '1.0_beta',     '1.0_alpha_p'     =>  1 ],
  94  [ '1.0_pre1_rc2', '1.0_pre1_rc2'    =>  0 ],
  95  [ '1.0_pre1_rc2', '1.0_pre1_rc3'    => -1 ],
  96
  97  [ '1.0',    '1.0-r0' =>  0 ],
  98  [ '1.0',    '1.0-r1' => -1 ],
  99  [ '1.0-r1', '1.0-r1' =>  0 ],
 100  [ '1.0-r1', '1.0-r2' => -1 ],
 101  [ '1.1-r1', '1.0-r2' =>  1 ],
 102
 103  [ '1.2_p0-r0',      '1.2_p',             0 ],
 104  [ '1.2_p1-r1',      '1.2_p1',            1 ],
 105  [ '1.2_p1-r1',      '1.2_p1_p1',        -1 ],
 106  [ '1.2_p1_pre2-r1', '1.2_p1-r1',        -1 ],
 107  [ '1.2_p1_pre2-r1', '1.2_p1_beta3-r1',   1 ],
 108  [ '1.2_p1_pre2-r1', '1.2_p1_beta3-r4',   1 ],
 109  [ '1.2_p1_pre2-r1', '1.2_p2_beta3-r4',  -1 ],
 110  [ '1.2_p1_pre2-r1', '1.2a_p1_beta3-r1', -1 ],
 111 );
 112
 113 sub compare_ok {
 114  my ($a, $cmp, $b, $exp) = @_;
 115
 116  my $desc = join " $cmp ", map { ref() ? "V->new('$_')" : "'$_'" } $a, $b;
 117
 118  my ($err, $c);
 119  {
 120   local $@;
 121   $c   = eval "\$a $cmp \$b";
 122   $err = $@;
 123  }
 124
 125  if (ref $exp eq 'Regexp') {
 126   like $err, $exp, "$desc should fail";
 127  } elsif ($err) {
 128   fail "$desc failed but shouldn't: $err";
 129  } else {
 130   is $c, $exp, "$desc == '$exp'";
 131  }
 132 }
 133
 134 for (@tests) {
 135  my ($s1, $s2, $exp) = @$_;
 136
 137  my $v1 = eval { V->new($s1) };
 138  is $@, '', "'$s1' parses fine";
 139
 140  my $v2 = eval { V->new($s2) };
 141  is $@, '', "'$s2' parses fine";
 142
 143  for my $r (0 .. 1) {
 144   if ($r) {
 145    ($v1, $v2) = ($v2, $v1);
 146    ($s1, $s2) = ($s2, $s1);
 147    $exp = -$exp;
 148   }
 149
 150   compare_ok($v1, '<=>', $v2, $exp);
 151   compare_ok($v1, '<=>', $s2, $exp);
 152   compare_ok($s1, '<=>', $v2, $exp);
 153  }
 154 }