X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git;a=blobdiff_plain;f=t%2F20-version.t;h=51bbf05e3e3ff65a75c7d61b18f4dd1bf642e5cd;hp=16294aeb50814e41481a68d6111e80694dbaff34;hb=f7846983c923e0aac6f815d8c494fbd958cb3fbe;hpb=f1e11349a9e94499b1025601c2f7e4c73e18810e

diff --git a/t/20-version.t b/t/20-version.t
index 16294ae..51bbf05 100644
--- a/t/20-version.t
+++ b/t/20-version.t
@@ -3,12 +3,15 @@
 use strict;
 use warnings;
 
-use Test::More tests => 2 + 21 * (3 + 2);
+use Test::More tests => 3 + (2 + 2 * 3) * (50 + 4 * 7);
 
 use CPANPLUS::Dist::Gentoo::Version;
 
 sub V () { 'CPANPLUS::Dist::Gentoo::Version' }
 
+eval { V->new() };
+like $@, qr/You\s+must\s+specify\s+a\s+version\s+string/, "V->(undef)";
+
 eval { V->new('dongs') };
 like $@, qr/Couldn't\s+parse\s+version\s+string/, "V->('dongs')";
 
@@ -16,42 +19,115 @@ eval { my $res = 'dongs' < V->new(1) };
 like $@, qr/Couldn't\s+parse\s+version\s+string/, "'dongs' < V->new(1)";
 
 my @tests = (
- [ 0, 0,  0 ],
- [ 1, 0,  1 ],
- [ 0, 1, -1 ],
- [ 1, 1,  0 ],
-
- [ '1.0', 1,      0 ],
- [ '1.1', 1,      1 ],
- [ '1.1', '1.0',  1 ],
- [ 1,     '1.0',  0 ],
- [ 1,     '1.1', -1 ],
- [ '1.0', '1.1', -1 ],
-
- [ '1.0_p0',   '1.0_p0',    0 ],
- [ '1.0_p0',   '1.0_p1',   -1 ],
- [ '1.1_p0',   '1.0_p1',    1 ],
- [ '1.1_p0',   '1.1_p0.1', -1 ],
- [ '1.1_p0.1', '1.1_p0.1',  0 ],
-
- [ '1.2_p0-r0', '1.2_p0',  0 ],
- [ '1.2_p0-r1', '1.2_p0',  1 ],
- [ '1.2-r0',    '1.2_p0',  0 ],
- [ '1.2-r1',    '1.2_p0',  1 ],
- [ '1.2-r1',    '1.2_p1', -1 ],
- [ '1.2-r2',    '1.2_p1', -1 ],
+ [ 0, 0 =>  0 ],
+ [ 1, 0 =>  1 ],
+ [ 0, 1 => -1 ],
+ [ 1, 1 =>  0 ],
+
+ [ '1.0',   1       =>  0 ],
+ [ '1.1',   1       =>  1 ],
+ [ '1.1',   '1.0'   =>  1 ],
+ [ 1,       '1.0'   =>  0 ],
+ [ 1,       '1.1'   => -1 ],
+ [ '1.0',   '1.1'   => -1 ],
+ [ '1.0.1', '1.1'   => -1 ],
+ [ '1.0.1', '1.0.0' =>  1 ],
+
+ [ '1a',   1      =>  1 ],
+ [ '1.0a', 1      =>  1 ],
+ [ '1.0',  '1a'   => -1 ],
+ [ '1a',   '1b'   => -1 ],
+ [ '1.1a', '1.0b' =>  1 ],
+
+ map( {
+  [ '1.0',        "1.0_${_}"  =>  1 ],
+  [ '1.0a',       "1.0_${_}"  =>  1 ],
+  [ '1.0',        "1.0_${_}1" =>  1 ],
+  [ "1.0_${_}1",  "1.0_${_}1" =>  0 ],
+  [ "1.0_${_}1",  "1.0_${_}2" => -1 ],
+  [ "1.0a_${_}1", "1.0_${_}2" =>  1 ],
+  [ "1.1_${_}1",  "1.0_${_}2" =>  1 ],
+ } qw(alpha beta pre rc)),
+
+ [ '1.0',     '1.0_p'  => -1 ],
+ [ '1.0a',    '1.0_p'  =>  1 ],
+ [ '1.0',     '1.0_p1' => -1 ],
+ [ '1.0_p1',  '1.0_p1' =>  0 ],
+ [ '1.0_p1',  '1.0_p2' => -1 ],
+ [ '1.0a_p1', '1.0_p2' =>  1 ],
+ [ '1.1_p1',  '1.0_p2' =>  1 ],
+
+ [ '1.0_alpha1', '1.0_beta1' => -1 ],
+ [ '1.0_beta1',  '1.0_pre1'  => -1 ],
+ [ '1.0_pre1',   '1.0_rc1'   => -1 ],
+ [ '1.0_rc1',    '1.0'       => -1 ],
+ [ '1.0',        '1.0_p1'    => -1 ],
+
+ [ '1.0_alpha', '1.0_alpha_alpha' =>  1 ],
+ [ '1.0_beta',  '1.0_beta_beta'   =>  1 ],
+ [ '1.0_pre',   '1.0_pre_pre'     =>  1 ],
+ [ '1.0_rc',    '1.0_rc_rc'       =>  1 ],
+ [ '1.0_p',     '1.0_p_p'         => -1 ],
+
+ [ '1.0_alpha',    '1.0_alpha_p'     => -1 ],
+ [ '1.0_beta',     '1.0_alpha_beta'  =>  1 ],
+ [ '1.0_beta',     '1.0_alpha_p'     =>  1 ],
+ [ '1.0_pre1_rc2', '1.0_pre1_rc2'    =>  0 ],
+ [ '1.0_pre1_rc2', '1.0_pre1_rc3'    => -1 ],
+
+ [ '1.0',    '1.0-r1' => -1 ],
+ [ '1.0-r1', '1.0-r1' =>  0 ],
+ [ '1.0-r1', '1.0-r2' => -1 ],
+ [ '1.1-r1', '1.0-r2' =>  1 ],
+
+ [ '1.2_p1-r1',      '1.2_p1',            1 ],
+ [ '1.2_p1-r1',      '1.2_p1_p1',        -1 ],
+ [ '1.2_p1_pre2-r1', '1.2_p1-r1',        -1 ],
+ [ '1.2_p1_pre2-r1', '1.2_p1_beta3-r1',   1 ],
+ [ '1.2_p1_pre2-r1', '1.2_p1_beta3-r4',   1 ],
+ [ '1.2_p1_pre2-r1', '1.2_p2_beta3-r4',  -1 ],
+ [ '1.2_p1_pre2-r1', '1.2a_p1_beta3-r1', -1 ],
 );
 
+sub compare_ok {
+ my ($a, $cmp, $b, $exp) = @_;
+
+ my $desc = join " $cmp ", map { ref() ? "V->new('$_')" : "'$_'" } $a, $b;
+
+ my ($err, $c);
+ {
+  local $@;
+  $c   = eval "\$a $cmp \$b";
+  $err = $@;
+ }
+
+ if (ref $exp eq 'Regexp') {
+  like $err, $exp, "$desc should fail";
+ } elsif ($err) {
+  fail "$desc failed but shouldn't: $err";
+ } else {
+  is $c, $exp, "$desc == '$exp'";
+ }
+}
+
 for (@tests) {
- my ($s1, $s2, $res) = @$_;
+ my ($s1, $s2, $exp) = @$_;
+
+ my $v1 = eval { V->new($s1) };
+ is $@, '', "'$s1' parses fine";
 
- my $v1 = V->new($s1);
- my $v2 = V->new($s2);
+ my $v2 = eval { V->new($s2) };
+ is $@, '', "'$s2' parses fine";
 
- is $s1 <=> $v2, $res, "'$s1' <=> V->new('$s2')";
- is $v1 <=> $s2, $res, "V->new('$s1') <=> '$s2'";
- is $v1 <=> $v2, $res, "V->new('$s1') <=> V->new('$s2')";
+ for my $r (0 .. 1) {
+  if ($r) {
+   ($v1, $v2) = ($v2, $v1);
+   ($s1, $s2) = ($s2, $s1);
+   $exp = -$exp;
+  }
 
- cmp_ok "$v1", 'eq', $s1, "V->new('$s1') eq '$s1'";
- cmp_ok "$v2", 'eq', $s2, "V->new('$s2') eq '$s2'";
+  compare_ok($v1, '<=>', $v2, $exp);
+  compare_ok($v1, '<=>', $s2, $exp);
+  compare_ok($s1, '<=>', $v2, $exp);
+ }
 }