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