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