| 1 | #!./perl |
| 2 | |
| 3 | BEGIN { |
| 4 | chdir 't' if -d 't'; |
| 5 | require './test.pl'; |
| 6 | set_up_inc(qw '../lib ../cpan/version/lib'); |
| 7 | } |
| 8 | |
| 9 | # XXX remove this later -- dagolden, 2010-01-13 |
| 10 | # local *STDERR = *STDOUT; |
| 11 | |
| 12 | my @syntax_cases = ( |
| 13 | 'package Foo', |
| 14 | 'package Bar 1.23', |
| 15 | 'package Baz v1.2.3', |
| 16 | ); |
| 17 | |
| 18 | my @version_cases = <DATA>; |
| 19 | |
| 20 | plan tests => 7 * @syntax_cases + 7 * (grep { $_ !~ /^#/ } @version_cases) |
| 21 | + 2 * 3; |
| 22 | |
| 23 | use warnings qw/syntax/; |
| 24 | use version; |
| 25 | |
| 26 | for my $string ( @syntax_cases ) { |
| 27 | eval "$string"; |
| 28 | is( $@, '', qq/eval "$string"/ ); |
| 29 | eval "$string;"; |
| 30 | is( $@, '', qq/eval "$string;"/ ); |
| 31 | eval "$string ;"; |
| 32 | is( $@, '', qq/eval "$string ;"/ ); |
| 33 | eval "{$string}"; |
| 34 | is( $@, '', qq/eval "{$string}"/ ); |
| 35 | eval "{ $string }"; |
| 36 | is( $@, '', qq/eval "{ $string }"/ ); |
| 37 | eval "${string}{}"; |
| 38 | is( $@, '', qq/eval "${string}{}"/ ); |
| 39 | eval "$string {}"; |
| 40 | is( $@, '', qq/eval "$string {}"/ ); |
| 41 | } |
| 42 | |
| 43 | LINE: |
| 44 | for my $line (@version_cases) { |
| 45 | chomp $line; |
| 46 | # comments in data section are just diagnostics |
| 47 | if ($line =~ /^#/) { |
| 48 | diag $line; |
| 49 | next LINE; |
| 50 | } |
| 51 | |
| 52 | my ($v, $package, $quoted, $bare, $match) = split /\t+/, $line; |
| 53 | my $warning = ""; |
| 54 | local $SIG{__WARN__} = sub { $warning .= $_[0] . "\n" }; |
| 55 | $match = defined $match ? $match : ""; |
| 56 | $match =~ s/\s*\z//; # kill trailing spaces |
| 57 | |
| 58 | # First handle the 'package NAME VERSION' case |
| 59 | foreach my $suffix (";", "{}") { |
| 60 | $withversion::VERSION = undef; |
| 61 | if ($package eq 'fail') { |
| 62 | eval "package withversion $v$suffix"; |
| 63 | like($@, qr/$match/, "package withversion $v$suffix -> syntax error ($match)"); |
| 64 | ok(! version::is_strict($v), qq{... and "$v" should also fail STRICT regex}); |
| 65 | } |
| 66 | else { |
| 67 | my $ok = eval "package withversion $v$suffix $v eq \$withversion::VERSION"; |
| 68 | ok($ok, "package withversion $v$suffix") |
| 69 | or diag( $@ ? $@ : "and \$VERSION = $withversion::VERSION"); |
| 70 | ok( version::is_strict($v), qq{... and "$v" should pass STRICT regex}); |
| 71 | } |
| 72 | } |
| 73 | |
| 74 | # Now check the version->new("V") case |
| 75 | my $ver = undef; |
| 76 | eval qq/\$ver = version->new("$v")/; |
| 77 | if ($quoted eq 'fail') { |
| 78 | like($@, qr/$match/, qq{version->new("$v") -> invalid format ($match)}) |
| 79 | or diag( $@ ? $@ : "and \$ver = $ver" ); |
| 80 | ok( ! version::is_lax($v), qq{... and "$v" should fail LAX regex}); |
| 81 | } |
| 82 | else { |
| 83 | is($@, "", qq{version->new("$v")}); |
| 84 | ok( version::is_lax($v), qq{... and "$v" should pass LAX regex}); |
| 85 | } |
| 86 | |
| 87 | # Now check the version->new(V) case, unless we're skipping it |
| 88 | if ( $bare eq 'na' ) { |
| 89 | pass( "... skipping version->new($v)" ); |
| 90 | next LINE; |
| 91 | } |
| 92 | $ver = undef; |
| 93 | eval qq/\$ver = version->new($v)/; |
| 94 | if ($bare eq 'fail') { |
| 95 | like($@, qr/$match/m, qq{... and unquoted version->new($v) has same error}) |
| 96 | or diag( $@ ? $@ : "and \$ver = $ver" ); |
| 97 | } |
| 98 | else { |
| 99 | is($@, "", qq{... and version->new($v) is ok}); |
| 100 | } |
| 101 | } |
| 102 | |
| 103 | # |
| 104 | # Tests for #72432 - which reports a syntax error if there's a newline |
| 105 | # between the package name and the version. |
| 106 | # |
| 107 | # Note that we are using 'run_perl' here - there's no problem if |
| 108 | # "package Foo\n1;" is evalled. |
| 109 | # |
| 110 | for my $v ("1", "1.23", "v1.2.3") { |
| 111 | ok (run_perl (prog => "package Foo\n$v; print 1;"), |
| 112 | "New line between package name and version"); |
| 113 | ok (run_perl (prog => "package Foo\n$v { print 1; }"), |
| 114 | "New line between package name and version"); |
| 115 | } |
| 116 | |
| 117 | # The data is organized in tab delimited format with these columns: |
| 118 | # |
| 119 | # value package version->new version->new regex |
| 120 | # quoted unquoted |
| 121 | # |
| 122 | # For each value, it is tested using eval in the following expressions |
| 123 | # |
| 124 | # package foo $value; # column 2 |
| 125 | # and |
| 126 | # my $ver = version->new("$value"); # column 3 |
| 127 | # and |
| 128 | # my $ver = version->new($value); # column 4 |
| 129 | # |
| 130 | # The second through fourth columns can contain 'pass' or 'fail'. |
| 131 | # |
| 132 | # For any column with 'pass', the tests makes sure that no warning/error |
| 133 | # was thrown. For any column with 'fail', the tests make sure that the |
| 134 | # error thrown matches the regex in the last column. The unquoted column |
| 135 | # may also have 'na' indicating that it's pointless to test as behavior |
| 136 | # is subject to the perl parser before a stringifiable value is available |
| 137 | # to version->new |
| 138 | # |
| 139 | # If all columns are marked 'pass', the regex column is left empty. |
| 140 | # |
| 141 | # there are multiple ways that underscores can fail depending on strict |
| 142 | # vs lax format so these test do not distinguish between them |
| 143 | # |
| 144 | # If the DATA line begins with a # mark, it is used as a diag comment |
| 145 | __DATA__ |
| 146 | 1.00 pass pass pass |
| 147 | 1.00001 pass pass pass |
| 148 | 0.123 pass pass pass |
| 149 | 12.345 pass pass pass |
| 150 | 42 pass pass pass |
| 151 | 0 pass pass pass |
| 152 | 0.0 pass pass pass |
| 153 | v1.2.3 pass pass pass |
| 154 | v1.2.3.4 pass pass pass |
| 155 | v0.1.2 pass pass pass |
| 156 | v0.0.0 pass pass pass |
| 157 | 01 fail pass pass no leading zeros |
| 158 | 01.0203 fail pass pass no leading zeros |
| 159 | v01 fail pass pass no leading zeros |
| 160 | v01.02.03 fail pass pass no leading zeros |
| 161 | .1 fail pass pass 0 before decimal required |
| 162 | .1.2 fail pass pass 0 before decimal required |
| 163 | 1. fail pass pass fractional part required |
| 164 | 1.a fail fail na fractional part required |
| 165 | 1._ fail fail na fractional part required |
| 166 | 1.02_03 fail pass pass underscore |
| 167 | v1.2_3 fail pass pass underscore |
| 168 | v1.02_03 fail pass pass underscore |
| 169 | 0_ fail fail na underscore |
| 170 | 1_ fail fail na underscore |
| 171 | 1_. fail fail na underscore |
| 172 | 1.1_ fail fail na underscore |
| 173 | 1.02_03_04 fail fail na underscore |
| 174 | 1.2.3 fail pass pass dotted-decimal versions must begin with 'v' |
| 175 | v1.2 fail pass pass dotted-decimal versions require at least three parts |
| 176 | v0 fail pass pass dotted-decimal versions require at least three parts |
| 177 | v1 fail pass pass dotted-decimal versions require at least three parts |
| 178 | v.1.2.3 fail fail na dotted-decimal versions require at least three parts |
| 179 | v fail fail na dotted-decimal versions require at least three parts |
| 180 | v1.2345.6 fail pass pass maximum 3 digits between decimals |
| 181 | undef fail pass pass non-numeric data |
| 182 | 1a fail fail na non-numeric data |
| 183 | 1.2a3 fail fail na non-numeric data |
| 184 | bar fail fail na non-numeric data |
| 185 | _ fail fail na non-numeric data |