Commit | Line | Data |
91152fc1 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't'; |
5 | @INC = '../lib'; |
6 | require './test.pl'; |
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 | |
36f77d71 |
20 | plan tests => 7 * @syntax_cases + 7 * (grep { $_ !~ /^#/ } @version_cases) |
21 | + 2 * 3; |
91152fc1 |
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 }"/ ); |
36f77d71 |
37 | eval "${string}{}"; |
38 | is( $@, '', qq/eval "${string}{}"/ ); |
39 | eval "$string {}"; |
40 | is( $@, '', qq/eval "$string {}"/ ); |
91152fc1 |
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 |
36f77d71 |
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 | } |
91152fc1 |
72 | } |
73 | |
91152fc1 |
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 | |
872cbd3c |
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"); |
36f77d71 |
113 | ok (run_perl (prog => "package Foo\n$v { print 1; }"), |
114 | "New line between package name and version"); |
872cbd3c |
115 | } |
91152fc1 |
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 | v1.2_3_4 fail fail fail underscore |
170 | v1.2_3.4 fail fail fail underscore |
171 | 1.2_3.4 fail fail fail underscore |
172 | 0_ fail fail na underscore |
173 | 1_ fail fail na underscore |
174 | 1_. fail fail na underscore |
175 | 1.1_ fail fail na underscore |
176 | 1.02_03_04 fail fail na underscore |
177 | 1.2.3 fail pass pass dotted-decimal versions must begin with 'v' |
178 | v1.2 fail pass pass dotted-decimal versions require at least three parts |
179 | v0 fail pass pass dotted-decimal versions require at least three parts |
180 | v1 fail pass pass dotted-decimal versions require at least three parts |
181 | v.1.2.3 fail fail na dotted-decimal versions require at least three parts |
182 | v fail fail na dotted-decimal versions require at least three parts |
183 | v1.2345.6 fail pass pass maximum 3 digits between decimals |
184 | undef fail pass pass non-numeric data |
185 | 1a fail fail na non-numeric data |
186 | 1.2a3 fail fail na non-numeric data |
187 | bar fail fail na non-numeric data |
188 | _ fail fail na non-numeric data |