This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
version objects final(?) patch
[perl5.git] / lib / version.t
1 #! /usr/local/perl -w
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'
4 # $Revision: 2.3 $
5
6 #########################
7
8 use Test::More tests => 71;
9 use_ok("version"); # If we made it this far, we are ok.
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
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
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' );
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
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";
55 ok (defined $version, 'defined $version');
56
57 # reset the test object to something reasonable
58 $version = new version "1.2.3";
59
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
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
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
186 $version = new version $Test::More::VERSION;
187 eval "use Test::More $version";
188 unlike($@, qr/Test::More version $version required/,
189         'Replacement eval works with exact version');
190
191 $version = new version $Test::More::VERSION+0.01; # this should fail even with old UNIVERSAL::VERSION
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