6 use Test::More tests => 3 + (2 + 2 * 3) * (69 + 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)";
31 [ '1.0', 1 => 1 ], # Yes, 1.0 > 1. Deal with it
32 [ '1.0', '1.0' => 0 ],
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 ],
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 ],
54 [ '1.0', '1a' => 1 ], # Same
56 [ '1.1a', '1.0b' => 1 ],
57 [ '1.1a', '1.01a' => 1 ],
58 [ '1.01a', '1.010a' => 0 ],
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)),
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 ],
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 ],
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 ],
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 ],
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 ],
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 ],
114 my ($a, $cmp, $b, $exp) = @_;
116 my $desc = join " $cmp ", map { ref() ? "V->new('$_')" : "'$_'" } $a, $b;
121 $c = eval "\$a $cmp \$b";
125 if (ref $exp eq 'Regexp') {
126 like $err, $exp, "$desc should fail";
128 fail "$desc failed but shouldn't: $err";
130 is $c, $exp, "$desc == '$exp'";
135 my ($s1, $s2, $exp) = @$_;
137 my $v1 = eval { V->new($s1) };
138 is $@, '', "'$s1' parses fine";
140 my $v2 = eval { V->new($s2) };
141 is $@, '', "'$s2' parses fine";
145 ($v1, $v2) = ($v2, $v1);
146 ($s1, $s2) = ($s2, $s1);
150 compare_ok($v1, '<=>', $v2, $exp);
151 compare_ok($v1, '<=>', $s2, $exp);
152 compare_ok($s1, '<=>', $v2, $exp);