Commit | Line | Data |
7a4e305a |
1 | #!/usr/bin/perl -w |
2 | # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*- |
3 | # vim:ts=8:sw=2:et:sta:sts=2 |
4 | |
5 | use strict; |
6 | use lib 't/lib'; |
f33c0a6c |
7 | use IO::File; |
7a4e305a |
8 | use MBTest; |
9 | |
10 | # parse various module $VERSION lines |
11 | # these will be reversed later to create %modules |
12 | my @modules = ( |
13 | '1.23' => <<'---', # declared & defined on same line with 'our' |
14 | package Simple; |
15 | our $VERSION = '1.23'; |
16 | --- |
17 | '1.23' => <<'---', # declared & defined on separate lines with 'our' |
18 | package Simple; |
19 | our $VERSION; |
20 | $VERSION = '1.23'; |
21 | --- |
22 | '1.23' => <<'---', # use vars |
23 | package Simple; |
24 | use vars qw( $VERSION ); |
25 | $VERSION = '1.23'; |
26 | --- |
27 | '1.23' => <<'---', # choose the right default package based on package/file name |
28 | package Simple::_private; |
29 | $VERSION = '0'; |
30 | package Simple; |
31 | $VERSION = '1.23'; # this should be chosen for version |
32 | --- |
33 | '1.23' => <<'---', # just read the first $VERSION line |
34 | package Simple; |
35 | $VERSION = '1.23'; # we should see this line |
36 | $VERSION = eval $VERSION; # and ignore this one |
37 | --- |
38 | '1.23' => <<'---', # just read the first $VERSION line in reopened package (1) |
39 | package Simple; |
40 | $VERSION = '1.23'; |
41 | package Error::Simple; |
42 | $VERSION = '2.34'; |
43 | package Simple; |
44 | --- |
45 | '1.23' => <<'---', # just read the first $VERSION line in reopened package (2) |
46 | package Simple; |
47 | package Error::Simple; |
48 | $VERSION = '2.34'; |
49 | package Simple; |
50 | $VERSION = '1.23'; |
51 | --- |
52 | '1.23' => <<'---', # mentions another module's $VERSION |
53 | package Simple; |
54 | $VERSION = '1.23'; |
55 | if ( $Other::VERSION ) { |
56 | # whatever |
57 | } |
58 | --- |
59 | '1.23' => <<'---', # mentions another module's $VERSION in a different package |
60 | package Simple; |
61 | $VERSION = '1.23'; |
62 | package Simple2; |
63 | if ( $Simple::VERSION ) { |
64 | # whatever |
65 | } |
66 | --- |
67 | '1.23' => <<'---', # $VERSION checked only in assignments, not regexp ops |
68 | package Simple; |
69 | $VERSION = '1.23'; |
70 | if ( $VERSION =~ /1\.23/ ) { |
71 | # whatever |
72 | } |
73 | --- |
74 | '1.23' => <<'---', # $VERSION checked only in assignments, not relational ops |
75 | package Simple; |
76 | $VERSION = '1.23'; |
77 | if ( $VERSION == 3.45 ) { |
78 | # whatever |
79 | } |
80 | --- |
81 | '1.23' => <<'---', # $VERSION checked only in assignments, not relational ops |
82 | package Simple; |
83 | $VERSION = '1.23'; |
84 | package Simple2; |
85 | if ( $Simple::VERSION == 3.45 ) { |
86 | # whatever |
87 | } |
88 | --- |
89 | '1.23' => <<'---', # Fully qualified $VERSION declared in package |
90 | package Simple; |
91 | $Simple::VERSION = 1.23; |
92 | --- |
93 | '1.23' => <<'---', # Differentiate fully qualified $VERSION in a package |
94 | package Simple; |
95 | $Simple2::VERSION = '999'; |
96 | $Simple::VERSION = 1.23; |
97 | --- |
98 | '1.23' => <<'---', # Differentiate fully qualified $VERSION and unqualified |
99 | package Simple; |
100 | $Simple2::VERSION = '999'; |
101 | $VERSION = 1.23; |
102 | --- |
103 | '1.23' => <<'---', # $VERSION declared as package variable from within 'main' package |
104 | $Simple::VERSION = '1.23'; |
105 | { |
106 | package Simple; |
107 | $x = $y, $cats = $dogs; |
108 | } |
109 | --- |
110 | '1.23' => <<'---', # $VERSION wrapped in parens - space inside |
111 | package Simple; |
112 | ( $VERSION ) = '1.23'; |
113 | --- |
114 | '1.23' => <<'---', # $VERSION wrapped in parens - no space inside |
115 | package Simple; |
116 | ($VERSION) = '1.23'; |
117 | --- |
118 | '1.23' => <<'---', # $VERSION follows a spurious 'package' in a quoted construct |
119 | package Simple; |
120 | __PACKAGE__->mk_accessors(qw( |
121 | program socket proc |
122 | package filename line codeline subroutine finished)); |
123 | |
124 | our $VERSION = "1.23"; |
125 | --- |
126 | '1.23' => <<'---', # $VERSION using version.pm |
127 | package Simple; |
128 | use version; our $VERSION = version->new('1.23'); |
129 | --- |
130 | '1.23' => <<'---', # $VERSION using version.pm and qv() |
131 | package Simple; |
132 | use version; our $VERSION = qv('1.230'); |
133 | --- |
134 | '1.23' => <<'---', # Two version assignments, should ignore second one |
135 | $Simple::VERSION = '1.230'; |
136 | $Simple::VERSION = eval $Simple::VERSION; |
137 | --- |
138 | '1.23' => <<'---', # declared & defined on same line with 'our' |
139 | package Simple; |
140 | our $VERSION = '1.23_00_00'; |
141 | --- |
142 | '1.23' => <<'---', # package NAME VERSION |
143 | package Simple 1.23; |
144 | --- |
145 | '1.23_01' => <<'---', # package NAME VERSION |
146 | package Simple 1.23_01; |
147 | --- |
148 | 'v1.2.3' => <<'---', # package NAME VERSION |
149 | package Simple v1.2.3; |
150 | --- |
151 | 'v1.2_3' => <<'---', # package NAME VERSION |
152 | package Simple v1.2_3; |
153 | --- |
92ad06ed |
154 | '1.23' => <<'---', # trailing crud |
155 | package Simple; |
156 | our $VERSION; |
157 | $VERSION = '1.23-alpha'; |
158 | --- |
159 | '1.23' => <<'---', # trailing crud |
160 | package Simple; |
161 | our $VERSION; |
162 | $VERSION = '1.23b'; |
163 | --- |
164 | '1.234' => <<'---', # multi_underscore |
165 | package Simple; |
166 | our $VERSION; |
167 | $VERSION = '1.2_3_4'; |
168 | --- |
169 | '0' => <<'---', # non-numeric |
170 | package Simple; |
171 | our $VERSION; |
172 | $VERSION = 'onetwothree'; |
173 | --- |
7a4e305a |
174 | ); |
175 | my %modules = reverse @modules; |
176 | |
f33c0a6c |
177 | plan tests => 39 + 2 * keys( %modules ); |
7a4e305a |
178 | |
179 | require_ok('Module::Metadata'); |
180 | |
1abfcc9a |
181 | # class method C<find_module_by_name> |
182 | my $module = Module::Metadata->find_module_by_name( |
183 | 'Module::Metadata' ); |
184 | ok( -e $module, 'find_module_by_name() succeeds' ); |
185 | |
186 | ######################### |
187 | |
7a4e305a |
188 | my $tmp = MBTest->tmpdir; |
189 | |
190 | use DistGen; |
191 | my $dist = DistGen->new( dir => $tmp ); |
192 | $dist->regen; |
193 | |
194 | $dist->chdir_in; |
195 | |
7a4e305a |
196 | |
197 | # fail on invalid module name |
198 | my $pm_info = Module::Metadata->new_from_module( |
199 | 'Foo::Bar', inc => [] ); |
200 | ok( !defined( $pm_info ), 'fail if can\'t find module by module name' ); |
201 | |
202 | |
203 | # fail on invalid filename |
204 | my $file = File::Spec->catfile( 'Foo', 'Bar.pm' ); |
205 | $pm_info = Module::Metadata->new_from_file( $file, inc => [] ); |
206 | ok( !defined( $pm_info ), 'fail if can\'t find module by file name' ); |
207 | |
208 | |
209 | # construct from module filename |
210 | $file = File::Spec->catfile( 'lib', split( /::/, $dist->name ) ) . '.pm'; |
211 | $pm_info = Module::Metadata->new_from_file( $file ); |
212 | ok( defined( $pm_info ), 'new_from_file() succeeds' ); |
213 | |
f33c0a6c |
214 | # construct from filehandle |
215 | my $handle = IO::File->new($file); |
216 | $pm_info = Module::Metadata->new_from_handle( $handle, $file ); |
217 | ok( defined( $pm_info ), 'new_from_handle() succeeds' ); |
218 | $pm_info = Module::Metadata->new_from_handle( $handle ); |
219 | is( $pm_info, undef, "new_from_handle() without filename returns undef" ); |
220 | |
221 | |
7a4e305a |
222 | # construct from module name, using custom include path |
223 | $pm_info = Module::Metadata->new_from_module( |
224 | $dist->name, inc => [ 'lib', @INC ] ); |
225 | ok( defined( $pm_info ), 'new_from_module() succeeds' ); |
226 | |
227 | |
228 | foreach my $module ( sort keys %modules ) { |
229 | my $expected = $modules{$module}; |
230 | SKIP: { |
231 | skip( "No our() support until perl 5.6", 2 ) |
232 | if $] < 5.006 && $module =~ /\bour\b/; |
233 | skip( "No package NAME VERSION support until perl 5.11.1", 2 ) |
234 | if $] < 5.011001 && $module =~ /package\s+[\w\:\']+\s+v?[0-9._]+/; |
235 | |
236 | $dist->change_file( 'lib/Simple.pm', $module ); |
237 | $dist->regen; |
238 | |
239 | my $warnings = ''; |
240 | local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; |
241 | my $pm_info = Module::Metadata->new_from_file( $file ); |
242 | |
243 | # Test::Builder will prematurely numify objects, so use this form |
244 | my $errs; |
245 | ok( $pm_info->version eq $expected, |
246 | "correct module version (expected '$expected')" ) |
247 | or $errs++; |
248 | is( $warnings, '', 'no warnings from parsing' ) or $errs++; |
249 | diag "Got: '@{[$pm_info->version]}'\nModule contents:\n$module" if $errs; |
250 | } |
251 | } |
252 | |
253 | # revert to pristine state |
254 | $dist->regen( clean => 1 ); |
255 | |
256 | # Find each package only once |
257 | $dist->change_file( 'lib/Simple.pm', <<'---' ); |
258 | package Simple; |
259 | $VERSION = '1.23'; |
260 | package Error::Simple; |
261 | $VERSION = '2.34'; |
262 | package Simple; |
263 | --- |
264 | |
265 | $dist->regen; |
266 | |
267 | $pm_info = Module::Metadata->new_from_file( $file ); |
268 | |
269 | my @packages = $pm_info->packages_inside; |
270 | is( @packages, 2, 'record only one occurence of each package' ); |
271 | |
272 | |
273 | # Module 'Simple.pm' does not contain package 'Simple'; |
274 | # constructor should not complain, no default module name or version |
275 | $dist->change_file( 'lib/Simple.pm', <<'---' ); |
276 | package Simple::Not; |
277 | $VERSION = '1.23'; |
278 | --- |
279 | |
280 | $dist->regen; |
281 | $pm_info = Module::Metadata->new_from_file( $file ); |
282 | |
283 | is( $pm_info->name, undef, 'no default package' ); |
284 | is( $pm_info->version, undef, 'no version w/o default package' ); |
285 | |
286 | # Module 'Simple.pm' contains an alpha version |
287 | # constructor should report first $VERSION found |
288 | $dist->change_file( 'lib/Simple.pm', <<'---' ); |
289 | package Simple; |
290 | $VERSION = '1.23_01'; |
291 | $VERSION = eval $VERSION; |
292 | --- |
293 | |
294 | $dist->regen; |
295 | $pm_info = Module::Metadata->new_from_file( $file ); |
296 | |
297 | is( $pm_info->version, '1.23_01', 'alpha version reported'); |
298 | |
299 | # NOTE the following test has be done this way because Test::Builder is |
300 | # too smart for our own good and tries to see if the version object is a |
301 | # dual-var, which breaks with alpha versions: |
302 | # Argument "1.23_0100" isn't numeric in addition (+) at |
303 | # /usr/lib/perl5/5.8.7/Test/Builder.pm line 505. |
304 | |
305 | ok( $pm_info->version > 1.23, 'alpha version greater than non'); |
306 | |
307 | # revert to pristine state |
308 | $dist->regen( clean => 1 ); |
309 | |
310 | # parse $VERSION lines scripts for package main |
311 | my @scripts = ( |
312 | <<'---', # package main declared |
313 | #!perl -w |
314 | package main; |
315 | $VERSION = '0.01'; |
316 | --- |
317 | <<'---', # on first non-comment line, non declared package main |
318 | #!perl -w |
319 | $VERSION = '0.01'; |
320 | --- |
321 | <<'---', # after non-comment line |
322 | #!perl -w |
323 | use strict; |
324 | $VERSION = '0.01'; |
325 | --- |
326 | <<'---', # 1st declared package |
327 | #!perl -w |
328 | package main; |
329 | $VERSION = '0.01'; |
330 | package _private; |
331 | $VERSION = '999'; |
332 | --- |
333 | <<'---', # 2nd declared package |
334 | #!perl -w |
335 | package _private; |
336 | $VERSION = '999'; |
337 | package main; |
338 | $VERSION = '0.01'; |
339 | --- |
340 | <<'---', # split package |
341 | #!perl -w |
342 | package main; |
343 | package _private; |
344 | $VERSION = '999'; |
345 | package main; |
346 | $VERSION = '0.01'; |
347 | --- |
348 | <<'---', # define 'main' version from other package |
349 | package _private; |
350 | $::VERSION = 0.01; |
351 | $VERSION = '999'; |
352 | --- |
353 | <<'---', # define 'main' version from other package |
354 | package _private; |
355 | $VERSION = '999'; |
356 | $::VERSION = 0.01; |
357 | --- |
358 | ); |
359 | |
360 | my ( $i, $n ) = ( 1, scalar( @scripts ) ); |
361 | foreach my $script ( @scripts ) { |
362 | $dist->change_file( 'bin/simple.plx', $script ); |
363 | $dist->regen; |
364 | $pm_info = Module::Metadata->new_from_file( |
365 | File::Spec->catfile( 'bin', 'simple.plx' ) ); |
366 | |
367 | is( $pm_info->version, '0.01', "correct script version ($i of $n)" ); |
368 | $i++; |
369 | } |
370 | |
371 | |
372 | # examine properties of a module: name, pod, etc |
373 | $dist->change_file( 'lib/Simple.pm', <<'---' ); |
374 | package Simple; |
375 | $VERSION = '0.01'; |
376 | package Simple::Ex; |
377 | $VERSION = '0.02'; |
378 | =head1 NAME |
379 | |
380 | Simple - It's easy. |
381 | |
382 | =head1 AUTHOR |
383 | |
384 | Simple Simon |
385 | |
386 | =cut |
387 | --- |
388 | $dist->regen; |
389 | |
390 | $pm_info = Module::Metadata->new_from_module( |
391 | $dist->name, inc => [ 'lib', @INC ] ); |
392 | |
393 | is( $pm_info->name, 'Simple', 'found default package' ); |
394 | is( $pm_info->version, '0.01', 'version for default package' ); |
395 | |
396 | # got correct version for secondary package |
397 | is( $pm_info->version( 'Simple::Ex' ), '0.02', |
398 | 'version for secondary package' ); |
399 | |
400 | my $filename = $pm_info->filename; |
401 | ok( defined( $filename ) && -e $filename, |
402 | 'filename() returns valid path to module file' ); |
403 | |
404 | @packages = $pm_info->packages_inside; |
405 | is( @packages, 2, 'found correct number of packages' ); |
406 | is( $packages[0], 'Simple', 'packages stored in order found' ); |
407 | |
408 | # we can detect presence of pod regardless of whether we are collecting it |
409 | ok( $pm_info->contains_pod, 'contains_pod() succeeds' ); |
410 | |
411 | my @pod = $pm_info->pod_inside; |
412 | is_deeply( \@pod, [qw(NAME AUTHOR)], 'found all pod sections' ); |
413 | |
414 | is( $pm_info->pod('NONE') , undef, |
415 | 'return undef() if pod section not present' ); |
416 | |
417 | is( $pm_info->pod('NAME'), undef, |
418 | 'return undef() if pod section not collected' ); |
419 | |
420 | |
421 | # collect_pod |
422 | $pm_info = Module::Metadata->new_from_module( |
423 | $dist->name, inc => [ 'lib', @INC ], collect_pod => 1 ); |
424 | |
425 | my $name = $pm_info->pod('NAME'); |
426 | if ( $name ) { |
427 | $name =~ s/^\s+//; |
428 | $name =~ s/\s+$//; |
429 | } |
430 | is( $name, q|Simple - It's easy.|, 'collected pod section' ); |
431 | |
432 | |
433 | { |
434 | # Make sure processing stops after __DATA__ |
435 | $dist->change_file( 'lib/Simple.pm', <<'---' ); |
436 | package Simple; |
437 | $VERSION = '0.01'; |
438 | __DATA__ |
439 | *UNIVERSAL::VERSION = sub { |
440 | foo(); |
441 | }; |
442 | --- |
443 | $dist->regen; |
444 | |
445 | $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); |
446 | is( $pm_info->name, 'Simple', 'found default package' ); |
447 | is( $pm_info->version, '0.01', 'version for default package' ); |
448 | my @packages = $pm_info->packages_inside; |
449 | is_deeply(\@packages, ['Simple'], 'packages inside'); |
450 | } |
451 | |
452 | { |
453 | # Make sure we handle version.pm $VERSIONs well |
454 | $dist->change_file( 'lib/Simple.pm', <<'---' ); |
455 | package Simple; |
456 | $VERSION = version->new('0.60.' . (qw$Revision: 128 $)[1]); |
457 | package Simple::Simon; |
458 | $VERSION = version->new('0.61.' . (qw$Revision: 129 $)[1]); |
459 | --- |
460 | $dist->regen; |
461 | |
462 | $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); |
463 | is( $pm_info->name, 'Simple', 'found default package' ); |
464 | is( $pm_info->version, '0.60.128', 'version for default package' ); |
465 | my @packages = $pm_info->packages_inside; |
466 | is_deeply([sort @packages], ['Simple', 'Simple::Simon'], 'packages inside'); |
467 | is( $pm_info->version('Simple::Simon'), '0.61.129', 'version for embedded package' ); |
468 | } |
469 | |