Commit | Line | Data |
---|---|---|
91152fc1 DG |
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 Z |
20 | plan tests => 7 * @syntax_cases + 7 * (grep { $_ !~ /^#/ } @version_cases) |
21 | + 2 * 3; | |
91152fc1 DG |
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 Z |
37 | eval "${string}{}"; |
38 | is( $@, '', qq/eval "${string}{}"/ ); | |
39 | eval "$string {}"; | |
40 | is( $@, '', qq/eval "$string {}"/ ); | |
91152fc1 DG |
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 Z |
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 DG |
72 | } |
73 | ||
91152fc1 DG |
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 A |
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 Z |
113 | ok (run_perl (prog => "package Foo\n$v { print 1; }"), |
114 | "New line between package name and version"); | |
872cbd3c | 115 | } |
91152fc1 DG |
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 |