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' |
3 | # $Revision: 2.0 $ |
4 | |
5 | ######################### |
6 | |
7 | use Test::More tests => 60; |
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 | |
37 | # Test boolean operator |
38 | ok ($version, 'boolean'); |
39 | |
40 | # Test ref operator |
41 | ok (ref($version) eq 'version','ref operator'); |
42 | |
43 | # Test comparison operators with self |
44 | diag "tests with self" unless $ENV{PERL_CORE}; |
45 | ok ( $version eq $version, '$version eq $version' ); |
46 | is ( $version cmp $version, 0, '$version cmp $version == 0' ); |
47 | ok ( $version == $version, '$version == $version' ); |
48 | |
49 | # test first with non-object |
50 | $version = new version "5.006.001"; |
51 | $new_version = "5.8.0"; |
52 | diag "tests with non-objects" unless $ENV{PERL_CORE}; |
53 | ok ( $version ne $new_version, '$version ne $new_version' ); |
54 | ok ( $version lt $new_version, '$version lt $new_version' ); |
55 | ok ( $new_version gt $version, '$new_version gt $version' ); |
56 | ok ( ref(\$new_version) eq 'SCALAR', 'no auto-upgrade'); |
57 | $new_version = "$version"; |
58 | ok ( $version eq $new_version, '$version eq $new_version' ); |
59 | ok ( $new_version eq $version, '$new_version eq $version' ); |
60 | |
61 | # now test with existing object |
62 | $new_version = new version "5.8.0"; |
63 | diag "tests with objects" unless $ENV{PERL_CORE}; |
64 | ok ( $version ne $new_version, '$version ne $new_version' ); |
65 | ok ( $version lt $new_version, '$version lt $new_version' ); |
66 | ok ( $new_version gt $version, '$new_version gt $version' ); |
67 | $new_version = new version "$version"; |
68 | ok ( $version eq $new_version, '$version eq $new_version' ); |
69 | |
70 | # Test Numeric Comparison operators |
71 | # test first with non-object |
72 | $new_version = "5.8.0"; |
73 | diag "numeric tests with non-objects" unless $ENV{PERL_CORE}; |
74 | ok ( $version == $version, '$version == $version' ); |
75 | ok ( $version < $new_version, '$version < $new_version' ); |
76 | ok ( $new_version > $version, '$new_version > $version' ); |
77 | ok ( $version != $new_version, '$version != $new_version' ); |
78 | |
79 | # now test with existing object |
80 | $new_version = new version $new_version; |
81 | diag "numeric tests with objects" unless $ENV{PERL_CORE}; |
82 | ok ( $version < $new_version, '$version < $new_version' ); |
83 | ok ( $new_version > $version, '$new_version > $version' ); |
84 | ok ( $version != $new_version, '$version != $new_version' ); |
85 | |
86 | # now test with actual numbers |
87 | diag "numeric tests with numbers" unless $ENV{PERL_CORE}; |
88 | ok ( $version->numify() == 5.006001, '$version->numify() == 5.006001' ); |
89 | ok ( $version->numify() <= 5.006001, '$version->numify() <= 5.006001' ); |
90 | ok ( $version->numify() < 5.008, '$version->numify() < 5.008' ); |
91 | #ok ( $version->numify() > v5.005_02, '$version->numify() > 5.005_02' ); |
92 | |
93 | # test with long decimals |
94 | diag "Tests with extended decimal versions" unless $ENV{PERL_CORE}; |
95 | $version = new version 1.002003; |
96 | ok ( $version eq "1.2.3", '$version eq "1.2.3"'); |
97 | ok ( $version->numify == 1.002003, '$version->numify == 1.002003'); |
98 | $version = new version "2002.09.30.1"; |
99 | ok ( $version eq "2002.9.30.1",'$version eq 2002.9.30.1'); |
100 | ok ( $version->numify == 2002.009030001, |
101 | '$version->numify == 2002.009030001'); |
102 | |
103 | # now test with Beta version form with string |
104 | $version = new version "1.2.3"; |
105 | $new_version = "1.2.3_4"; |
106 | diag "tests with beta-style non-objects" unless $ENV{PERL_CORE}; |
107 | ok ( $version lt $new_version, '$version lt $new_version' ); |
108 | ok ( $new_version gt $version, '$new_version gt $version' ); |
109 | ok ( $version ne $new_version, '$version ne $new_version' ); |
110 | |
111 | $version = new version "1.2.4"; |
112 | diag "numeric tests with beta-style non-objects" unless $ENV{PERL_CORE}; |
113 | ok ( $version > $new_version, '$version > $new_version' ); |
114 | ok ( $new_version < $version, '$new_version < $version' ); |
115 | ok ( $version != $new_version, '$version != $new_version' ); |
116 | |
117 | # now test with Beta version form with object |
118 | $version = new version "1.2.3"; |
119 | $new_version = new version "1.2.3_4"; |
120 | diag "tests with beta-style 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 | $version = new version "1.2.4"; |
126 | diag "tests with beta-style objects" unless $ENV{PERL_CORE}; |
127 | ok ( $version > $new_version, '$version > $new_version' ); |
128 | ok ( $new_version < $version, '$new_version < $version' ); |
129 | ok ( $version != $new_version, '$version != $new_version' ); |
130 | |
131 | $version = new version "1.2.4"; |
132 | $new_version = new version "1.2_4"; |
133 | diag "tests with beta-style objects with same subversion" unless $ENV{PERL_CORE}; |
134 | ok ( $version > $new_version, '$version > $new_version' ); |
135 | ok ( $new_version < $version, '$new_version < $version' ); |
136 | ok ( $version != $new_version, '$version != $new_version' ); |
137 | |
138 | # that which is not expressly permitted is forbidden |
139 | diag "forbidden operations" unless $ENV{PERL_CORE}; |
140 | ok ( !eval { $version++ }, "noop ++" ); |
141 | ok ( !eval { $version-- }, "noop --" ); |
142 | ok ( !eval { $version/1 }, "noop /" ); |
143 | ok ( !eval { $version*3 }, "noop *" ); |
144 | ok ( !eval { abs($version) }, "noop abs" ); |
145 | |
146 | # test reformed UNIVERSAL::VERSION |
147 | diag "Replacement UNIVERSAL::VERSION tests" unless $ENV{PERL_CORE}; |
148 | |
149 | # we know this file is here since we require it ourselves |
150 | $version = $Test::More::VERSION; |
151 | eval "use Test::More $version"; |
152 | unlike($@, qr/Test::More version $version required/, |
153 | 'Replacement eval works with exact version'); |
154 | |
155 | $version += 0.01; # this should fail even with old UNIVERSAL::VERSION |
156 | eval "use Test::More $version"; |
157 | like($@, qr/Test::More version $version required/, |
158 | 'Replacement eval works with incremented version'); |
159 | |
160 | chop($version); # shorten by 1 digit, should still succeed |
161 | eval "use Test::More $version"; |
162 | unlike($@, qr/Test::More version $version required/, |
163 | 'Replacement eval works with single digit'); |
164 | |
165 | $version += 0.1; # this would fail with old UNIVERSAL::VERSION |
166 | eval "use Test::More $version"; |
167 | unlike($@, qr/Test::More version $version required/, |
168 | 'Replacement eval works with incremented digit'); |
169 | |