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