6 use Test::More tests => 3 + (2 + 2 * 3) * (52 + 4 * 7);
8 use CPANPLUS::Dist::Gentoo::Version;
10 sub V () { 'CPANPLUS::Dist::Gentoo::Version' }
13 like $@, qr/You\s+must\s+specify\s+a\s+version\s+string/, "V->(undef)";
15 eval { V->new('dongs') };
16 like $@, qr/Couldn't\s+parse\s+version\s+string/, "V->('dongs')";
18 eval { my $res = 'dongs' < V->new(1) };
19 like $@, qr/Couldn't\s+parse\s+version\s+string/, "'dongs' < V->new(1)";
27 [ '1.0', 1 => 1 ], # Yes, 1.0 > 1. Deal with it
28 [ '1.0', '1.0' => 0 ],
30 [ '1.1', '1.0' => 1 ],
31 [ '1.0', '1.1' => -1 ],
32 [ '1.0.0', 1 => 1 ], # Ditto
33 [ '1.0.0', '1.0' => 1 ], # Tritto
34 [ '1.0.0', '1.0.0' => 0 ],
35 [ '1.0.1', '1.1' => -1 ],
36 [ '1.0.1', '1.0.0' => 1 ],
40 [ '1.0', '1a' => 1 ], # Same
42 [ '1.1a', '1.0b' => 1 ],
45 [ '1.0', "1.0_${_}" => 1 ],
46 [ '1.0a', "1.0_${_}" => 1 ],
47 [ '1.0', "1.0_${_}1" => 1 ],
48 [ "1.0_${_}1", "1.0_${_}1" => 0 ],
49 [ "1.0_${_}1", "1.0_${_}2" => -1 ],
50 [ "1.0a_${_}1", "1.0_${_}2" => 1 ],
51 [ "1.1_${_}1", "1.0_${_}2" => 1 ],
52 } qw(alpha beta pre rc)),
54 [ '1.0', '1.0_p' => -1 ],
55 [ '1.0a', '1.0_p' => 1 ],
56 [ '1.0', '1.0_p1' => -1 ],
57 [ '1.0_p1', '1.0_p1' => 0 ],
58 [ '1.0_p1', '1.0_p2' => -1 ],
59 [ '1.0a_p1', '1.0_p2' => 1 ],
60 [ '1.1_p1', '1.0_p2' => 1 ],
62 [ '1.0_alpha1', '1.0_beta1' => -1 ],
63 [ '1.0_beta1', '1.0_pre1' => -1 ],
64 [ '1.0_pre1', '1.0_rc1' => -1 ],
65 [ '1.0_rc1', '1.0' => -1 ],
66 [ '1.0', '1.0_p1' => -1 ],
68 [ '1.0_alpha', '1.0_alpha_alpha' => 1 ],
69 [ '1.0_beta', '1.0_beta_beta' => 1 ],
70 [ '1.0_pre', '1.0_pre_pre' => 1 ],
71 [ '1.0_rc', '1.0_rc_rc' => 1 ],
72 [ '1.0_p', '1.0_p_p' => -1 ],
74 [ '1.0_alpha', '1.0_alpha_p' => -1 ],
75 [ '1.0_beta', '1.0_alpha_beta' => 1 ],
76 [ '1.0_beta', '1.0_alpha_p' => 1 ],
77 [ '1.0_pre1_rc2', '1.0_pre1_rc2' => 0 ],
78 [ '1.0_pre1_rc2', '1.0_pre1_rc3' => -1 ],
80 [ '1.0', '1.0-r1' => -1 ],
81 [ '1.0-r1', '1.0-r1' => 0 ],
82 [ '1.0-r1', '1.0-r2' => -1 ],
83 [ '1.1-r1', '1.0-r2' => 1 ],
85 [ '1.2_p1-r1', '1.2_p1', 1 ],
86 [ '1.2_p1-r1', '1.2_p1_p1', -1 ],
87 [ '1.2_p1_pre2-r1', '1.2_p1-r1', -1 ],
88 [ '1.2_p1_pre2-r1', '1.2_p1_beta3-r1', 1 ],
89 [ '1.2_p1_pre2-r1', '1.2_p1_beta3-r4', 1 ],
90 [ '1.2_p1_pre2-r1', '1.2_p2_beta3-r4', -1 ],
91 [ '1.2_p1_pre2-r1', '1.2a_p1_beta3-r1', -1 ],
95 my ($a, $cmp, $b, $exp) = @_;
97 my $desc = join " $cmp ", map { ref() ? "V->new('$_')" : "'$_'" } $a, $b;
102 $c = eval "\$a $cmp \$b";
106 if (ref $exp eq 'Regexp') {
107 like $err, $exp, "$desc should fail";
109 fail "$desc failed but shouldn't: $err";
111 is $c, $exp, "$desc == '$exp'";
116 my ($s1, $s2, $exp) = @$_;
118 my $v1 = eval { V->new($s1) };
119 is $@, '', "'$s1' parses fine";
121 my $v2 = eval { V->new($s2) };
122 is $@, '', "'$s2' parses fine";
126 ($v1, $v2) = ($v2, $v1);
127 ($s1, $s2) = ($s2, $s1);
131 compare_ok($v1, '<=>', $v2, $exp);
132 compare_ok($v1, '<=>', $s2, $exp);
133 compare_ok($s1, '<=>', $v2, $exp);