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