| 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 | |