Commit | Line | Data |
129318bd |
1 | #! /usr/local/perl -w |
a7ad731c |
2 | # Before `make install' is performed this script should be runnable with |
3 | # `make test'. After `make install' it should work as `perl test.pl' |
c8d69e4a |
4 | # $Revision: 2.4 $ |
a7ad731c |
5 | |
6 | ######################### |
7 | |
c8d69e4a |
8 | use Test::More tests => 73; |
129318bd |
9 | use_ok("version"); # If we made it this far, we are ok. |
a7ad731c |
10 | |
11 | my ($version, $new_version); |
12 | ######################### |
13 | |
14 | # Insert your test code below, the Test module is use()ed here so read |
15 | # its man page ( perldoc Test ) for help writing this test script. |
16 | |
129318bd |
17 | # Test bare number processing |
18 | diag "tests with bare numbers" unless $ENV{PERL_CORE}; |
19 | $version = new version 5.005_03; |
20 | is ( "$version" , "5.5.30" , '5.005_03 eq 5.5.30' ); |
21 | $version = new version 1.23; |
22 | is ( "$version" , "1.230" , '1.23 eq "1.230"' ); |
23 | |
24 | # Test quoted number processing |
25 | diag "tests with quoted numbers" unless $ENV{PERL_CORE}; |
26 | $version = new version "5.005_03"; |
27 | is ( "$version" , "5.5_3" , '"5.005_03" eq "5.5_3"' ); |
28 | $version = new version "v1.23"; |
29 | is ( "$version" , "1.23" , '"v1.23" eq "1.23"' ); |
30 | |
a7ad731c |
31 | # Test stringify operator |
32 | diag "tests with stringify" unless $ENV{PERL_CORE}; |
33 | $version = new version "5.005"; |
34 | is ( "$version" , "5.5" , '5.005 eq 5.5' ); |
a7ad731c |
35 | $version = new version "5.006.001"; |
36 | is ( "$version" , "5.6.1" , '5.006.001 eq 5.6.1' ); |
37 | $version = new version "1.2.3_4"; |
c8d69e4a |
38 | is ( "$version" , "1.2.3_4" , 'alpha version 1.2.3_4 eq 1.2.3_4' ); |
a7ad731c |
39 | |
40 | # test illegal formats |
41 | diag "test illegal formats" unless $ENV{PERL_CORE}; |
42 | eval {my $version = new version "1.2_3_4";}; |
43 | like($@, qr/multiple underscores/, |
44 | "Invalid version format (multiple underscores)"); |
45 | |
46 | eval {my $version = new version "1.2_3.4";}; |
47 | like($@, qr/underscores before decimal/, |
48 | "Invalid version format (underscores before decimal)"); |
49 | |
46314c13 |
50 | $version = new version "99 and 44/100 pure"; |
51 | ok ("$version" eq "99.0", '$version eq "99.0"'); |
52 | ok ($version->numify == 99.0, '$version->numify == 99.0'); |
53 | |
54 | $version = new version "something"; |
129318bd |
55 | ok (defined $version, 'defined $version'); |
56 | |
57 | # reset the test object to something reasonable |
58 | $version = new version "1.2.3"; |
46314c13 |
59 | |
a7ad731c |
60 | # Test boolean operator |
61 | ok ($version, 'boolean'); |
62 | |
63 | # Test ref operator |
64 | ok (ref($version) eq 'version','ref operator'); |
65 | |
66 | # Test comparison operators with self |
67 | diag "tests with self" unless $ENV{PERL_CORE}; |
68 | ok ( $version eq $version, '$version eq $version' ); |
69 | is ( $version cmp $version, 0, '$version cmp $version == 0' ); |
70 | ok ( $version == $version, '$version == $version' ); |
71 | |
72 | # test first with non-object |
73 | $version = new version "5.006.001"; |
74 | $new_version = "5.8.0"; |
75 | diag "tests with non-objects" unless $ENV{PERL_CORE}; |
76 | ok ( $version ne $new_version, '$version ne $new_version' ); |
77 | ok ( $version lt $new_version, '$version lt $new_version' ); |
78 | ok ( $new_version gt $version, '$new_version gt $version' ); |
79 | ok ( ref(\$new_version) eq 'SCALAR', 'no auto-upgrade'); |
80 | $new_version = "$version"; |
81 | ok ( $version eq $new_version, '$version eq $new_version' ); |
82 | ok ( $new_version eq $version, '$new_version eq $version' ); |
83 | |
84 | # now test with existing object |
85 | $new_version = new version "5.8.0"; |
86 | diag "tests with objects" unless $ENV{PERL_CORE}; |
87 | ok ( $version ne $new_version, '$version ne $new_version' ); |
88 | ok ( $version lt $new_version, '$version lt $new_version' ); |
89 | ok ( $new_version gt $version, '$new_version gt $version' ); |
90 | $new_version = new version "$version"; |
91 | ok ( $version eq $new_version, '$version eq $new_version' ); |
92 | |
93 | # Test Numeric Comparison operators |
94 | # test first with non-object |
95 | $new_version = "5.8.0"; |
96 | diag "numeric tests with non-objects" unless $ENV{PERL_CORE}; |
97 | ok ( $version == $version, '$version == $version' ); |
98 | ok ( $version < $new_version, '$version < $new_version' ); |
99 | ok ( $new_version > $version, '$new_version > $version' ); |
100 | ok ( $version != $new_version, '$version != $new_version' ); |
101 | |
102 | # now test with existing object |
103 | $new_version = new version $new_version; |
104 | diag "numeric tests with objects" unless $ENV{PERL_CORE}; |
105 | ok ( $version < $new_version, '$version < $new_version' ); |
106 | ok ( $new_version > $version, '$new_version > $version' ); |
107 | ok ( $version != $new_version, '$version != $new_version' ); |
108 | |
109 | # now test with actual numbers |
110 | diag "numeric tests with numbers" unless $ENV{PERL_CORE}; |
111 | ok ( $version->numify() == 5.006001, '$version->numify() == 5.006001' ); |
112 | ok ( $version->numify() <= 5.006001, '$version->numify() <= 5.006001' ); |
113 | ok ( $version->numify() < 5.008, '$version->numify() < 5.008' ); |
114 | #ok ( $version->numify() > v5.005_02, '$version->numify() > 5.005_02' ); |
115 | |
116 | # test with long decimals |
117 | diag "Tests with extended decimal versions" unless $ENV{PERL_CORE}; |
118 | $version = new version 1.002003; |
119 | ok ( $version eq "1.2.3", '$version eq "1.2.3"'); |
120 | ok ( $version->numify == 1.002003, '$version->numify == 1.002003'); |
121 | $version = new version "2002.09.30.1"; |
122 | ok ( $version eq "2002.9.30.1",'$version eq 2002.9.30.1'); |
123 | ok ( $version->numify == 2002.009030001, |
124 | '$version->numify == 2002.009030001'); |
125 | |
c8d69e4a |
126 | # now test with alpha version form with string |
a7ad731c |
127 | $version = new version "1.2.3"; |
128 | $new_version = "1.2.3_4"; |
c8d69e4a |
129 | diag "tests with alpha-style non-objects" unless $ENV{PERL_CORE}; |
a7ad731c |
130 | ok ( $version lt $new_version, '$version lt $new_version' ); |
131 | ok ( $new_version gt $version, '$new_version gt $version' ); |
132 | ok ( $version ne $new_version, '$version ne $new_version' ); |
133 | |
134 | $version = new version "1.2.4"; |
c8d69e4a |
135 | diag "numeric tests with alpha-style non-objects" unless $ENV{PERL_CORE}; |
a7ad731c |
136 | ok ( $version > $new_version, '$version > $new_version' ); |
137 | ok ( $new_version < $version, '$new_version < $version' ); |
138 | ok ( $version != $new_version, '$version != $new_version' ); |
139 | |
c8d69e4a |
140 | # now test with alpha version form with object |
a7ad731c |
141 | $version = new version "1.2.3"; |
142 | $new_version = new version "1.2.3_4"; |
c8d69e4a |
143 | diag "tests with alpha-style objects" unless $ENV{PERL_CORE}; |
a7ad731c |
144 | ok ( $version < $new_version, '$version < $new_version' ); |
145 | ok ( $new_version > $version, '$new_version > $version' ); |
146 | ok ( $version != $new_version, '$version != $new_version' ); |
c8d69e4a |
147 | ok ( !$version->is_alpha, '!$version->is_alpha'); |
148 | ok ( $new_version->is_alpha, '$new_version->is_alpha'); |
a7ad731c |
149 | |
150 | $version = new version "1.2.4"; |
c8d69e4a |
151 | diag "tests with alpha-style objects" unless $ENV{PERL_CORE}; |
a7ad731c |
152 | ok ( $version > $new_version, '$version > $new_version' ); |
153 | ok ( $new_version < $version, '$new_version < $version' ); |
154 | ok ( $version != $new_version, '$version != $new_version' ); |
155 | |
156 | $version = new version "1.2.4"; |
157 | $new_version = new version "1.2_4"; |
c8d69e4a |
158 | diag "tests with alpha-style objects with same subversion" unless $ENV{PERL_CORE}; |
a7ad731c |
159 | ok ( $version > $new_version, '$version > $new_version' ); |
160 | ok ( $new_version < $version, '$new_version < $version' ); |
161 | ok ( $version != $new_version, '$version != $new_version' ); |
162 | |
129318bd |
163 | diag "test implicit [in]equality" unless $ENV{PERL_CORE}; |
164 | $version = new version "v1.2"; |
165 | $new_version = new version "1.2.0"; |
166 | ok ( $version == $new_version, '$version == $new_version' ); |
167 | $new_version = new version "1.2_0"; |
168 | ok ( $version == $new_version, '$version == $new_version' ); |
169 | $new_version = new version "1.2.1"; |
170 | ok ( $version < $new_version, '$version < $new_version' ); |
171 | $new_version = new version "1.2_1"; |
172 | ok ( $version < $new_version, '$version < $new_version' ); |
173 | $new_version = new version "1.1.999"; |
174 | ok ( $version > $new_version, '$version > $new_version' ); |
175 | |
a7ad731c |
176 | # that which is not expressly permitted is forbidden |
177 | diag "forbidden operations" unless $ENV{PERL_CORE}; |
178 | ok ( !eval { $version++ }, "noop ++" ); |
179 | ok ( !eval { $version-- }, "noop --" ); |
180 | ok ( !eval { $version/1 }, "noop /" ); |
181 | ok ( !eval { $version*3 }, "noop *" ); |
182 | ok ( !eval { abs($version) }, "noop abs" ); |
183 | |
184 | # test reformed UNIVERSAL::VERSION |
185 | diag "Replacement UNIVERSAL::VERSION tests" unless $ENV{PERL_CORE}; |
186 | |
187 | # we know this file is here since we require it ourselves |
129318bd |
188 | $version = new version $Test::More::VERSION; |
a7ad731c |
189 | eval "use Test::More $version"; |
190 | unlike($@, qr/Test::More version $version required/, |
191 | 'Replacement eval works with exact version'); |
192 | |
129318bd |
193 | $version = new version $Test::More::VERSION+0.01; # this should fail even with old UNIVERSAL::VERSION |
a7ad731c |
194 | eval "use Test::More $version"; |
195 | like($@, qr/Test::More version $version required/, |
196 | 'Replacement eval works with incremented version'); |
197 | |
198 | chop($version); # shorten by 1 digit, should still succeed |
199 | eval "use Test::More $version"; |
200 | unlike($@, qr/Test::More version $version required/, |
201 | 'Replacement eval works with single digit'); |
202 | |
203 | $version += 0.1; # this would fail with old UNIVERSAL::VERSION |
204 | eval "use Test::More $version"; |
205 | unlike($@, qr/Test::More version $version required/, |
206 | 'Replacement eval works with incremented digit'); |
207 | |