Commit | Line | Data |
---|---|---|
129318bd | 1 | #! /usr/local/perl -w |
a7ad731c HS |
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' | |
129318bd | 4 | # $Revision: 2.3 $ |
a7ad731c HS |
5 | |
6 | ######################### | |
7 | ||
129318bd JP |
8 | use Test::More tests => 71; |
9 | use_ok("version"); # If we made it this far, we are ok. | |
a7ad731c HS |
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 JP |
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 HS |
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 HS |
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"; | |
38 | is ( "$version" , "1.2.3_4" , 'beta version 1.2.3_4 eq 1.2.3_4' ); | |
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 JP |
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 JP |
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 HS |
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 | ||
126 | # now test with Beta version form with string | |
127 | $version = new version "1.2.3"; | |
128 | $new_version = "1.2.3_4"; | |
129 | diag "tests with beta-style non-objects" unless $ENV{PERL_CORE}; | |
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"; | |
135 | diag "numeric tests with beta-style non-objects" unless $ENV{PERL_CORE}; | |
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 | ||
140 | # now test with Beta version form with object | |
141 | $version = new version "1.2.3"; | |
142 | $new_version = new version "1.2.3_4"; | |
143 | diag "tests with beta-style objects" unless $ENV{PERL_CORE}; | |
144 | ok ( $version < $new_version, '$version < $new_version' ); | |
145 | ok ( $new_version > $version, '$new_version > $version' ); | |
146 | ok ( $version != $new_version, '$version != $new_version' ); | |
147 | ||
148 | $version = new version "1.2.4"; | |
149 | diag "tests with beta-style objects" unless $ENV{PERL_CORE}; | |
150 | ok ( $version > $new_version, '$version > $new_version' ); | |
151 | ok ( $new_version < $version, '$new_version < $version' ); | |
152 | ok ( $version != $new_version, '$version != $new_version' ); | |
153 | ||
154 | $version = new version "1.2.4"; | |
155 | $new_version = new version "1.2_4"; | |
156 | diag "tests with beta-style objects with same subversion" unless $ENV{PERL_CORE}; | |
157 | ok ( $version > $new_version, '$version > $new_version' ); | |
158 | ok ( $new_version < $version, '$new_version < $version' ); | |
159 | ok ( $version != $new_version, '$version != $new_version' ); | |
160 | ||
129318bd JP |
161 | diag "test implicit [in]equality" unless $ENV{PERL_CORE}; |
162 | $version = new version "v1.2"; | |
163 | $new_version = new version "1.2.0"; | |
164 | ok ( $version == $new_version, '$version == $new_version' ); | |
165 | $new_version = new version "1.2_0"; | |
166 | ok ( $version == $new_version, '$version == $new_version' ); | |
167 | $new_version = new version "1.2.1"; | |
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.1.999"; | |
172 | ok ( $version > $new_version, '$version > $new_version' ); | |
173 | ||
a7ad731c HS |
174 | # that which is not expressly permitted is forbidden |
175 | diag "forbidden operations" unless $ENV{PERL_CORE}; | |
176 | ok ( !eval { $version++ }, "noop ++" ); | |
177 | ok ( !eval { $version-- }, "noop --" ); | |
178 | ok ( !eval { $version/1 }, "noop /" ); | |
179 | ok ( !eval { $version*3 }, "noop *" ); | |
180 | ok ( !eval { abs($version) }, "noop abs" ); | |
181 | ||
182 | # test reformed UNIVERSAL::VERSION | |
183 | diag "Replacement UNIVERSAL::VERSION tests" unless $ENV{PERL_CORE}; | |
184 | ||
185 | # we know this file is here since we require it ourselves | |
129318bd | 186 | $version = new version $Test::More::VERSION; |
a7ad731c HS |
187 | eval "use Test::More $version"; |
188 | unlike($@, qr/Test::More version $version required/, | |
189 | 'Replacement eval works with exact version'); | |
190 | ||
129318bd | 191 | $version = new version $Test::More::VERSION+0.01; # this should fail even with old UNIVERSAL::VERSION |
a7ad731c HS |
192 | eval "use Test::More $version"; |
193 | like($@, qr/Test::More version $version required/, | |
194 | 'Replacement eval works with incremented version'); | |
195 | ||
196 | chop($version); # shorten by 1 digit, should still succeed | |
197 | eval "use Test::More $version"; | |
198 | unlike($@, qr/Test::More version $version required/, | |
199 | 'Replacement eval works with single digit'); | |
200 | ||
201 | $version += 0.1; # this would fail with old UNIVERSAL::VERSION | |
202 | eval "use Test::More $version"; | |
203 | unlike($@, qr/Test::More version $version required/, | |
204 | 'Replacement eval works with incremented digit'); | |
205 |