2 # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
3 # vim:ts=8:sw=2:et:sta:sts=2
12 # parse various module $VERSION lines
13 # these will be reversed later to create %modules
15 $undef => <<'---', # no $VERSION line
18 $undef => <<'---', # undefined $VERSION
22 '1.23' => <<'---', # declared & defined on same line with 'our'
24 our $VERSION = '1.23';
26 '1.23' => <<'---', # declared & defined on separate lines with 'our'
31 '1.23' => <<'---', # commented & defined on same line
33 our $VERSION = '1.23'; # our $VERSION = '4.56';
35 '1.23' => <<'---', # commented & defined on separate lines
37 # our $VERSION = '4.56';
38 our $VERSION = '1.23';
40 '1.23' => <<'---', # use vars
42 use vars qw( $VERSION );
45 '1.23' => <<'---', # choose the right default package based on package/file name
46 package Simple::_private;
49 $VERSION = '1.23'; # this should be chosen for version
51 '1.23' => <<'---', # just read the first $VERSION line
53 $VERSION = '1.23'; # we should see this line
54 $VERSION = eval $VERSION; # and ignore this one
56 '1.23' => <<'---', # just read the first $VERSION line in reopened package (1)
59 package Error::Simple;
63 '1.23' => <<'---', # just read the first $VERSION line in reopened package (2)
65 package Error::Simple;
70 '1.23' => <<'---', # mentions another module's $VERSION
73 if ( $Other::VERSION ) {
77 '1.23' => <<'---', # mentions another module's $VERSION in a different package
81 if ( $Simple::VERSION ) {
85 '1.23' => <<'---', # $VERSION checked only in assignments, not regexp ops
88 if ( $VERSION =~ /1\.23/ ) {
92 '1.23' => <<'---', # $VERSION checked only in assignments, not relational ops
95 if ( $VERSION == 3.45 ) {
99 '1.23' => <<'---', # $VERSION checked only in assignments, not relational ops
103 if ( $Simple::VERSION == 3.45 ) {
107 '1.23' => <<'---', # Fully qualified $VERSION declared in package
109 $Simple::VERSION = 1.23;
111 '1.23' => <<'---', # Differentiate fully qualified $VERSION in a package
113 $Simple2::VERSION = '999';
114 $Simple::VERSION = 1.23;
116 '1.23' => <<'---', # Differentiate fully qualified $VERSION and unqualified
118 $Simple2::VERSION = '999';
121 '1.23' => <<'---', # $VERSION declared as package variable from within 'main' package
122 $Simple::VERSION = '1.23';
125 $x = $y, $cats = $dogs;
128 '1.23' => <<'---', # $VERSION wrapped in parens - space inside
130 ( $VERSION ) = '1.23';
132 '1.23' => <<'---', # $VERSION wrapped in parens - no space inside
136 '1.23' => <<'---', # $VERSION follows a spurious 'package' in a quoted construct
138 __PACKAGE__->mk_accessors(qw(
140 package filename line codeline subroutine finished));
142 our $VERSION = "1.23";
144 '1.23' => <<'---', # $VERSION using version.pm
146 use version; our $VERSION = version->new('1.23');
148 '1.23' => <<'---', # $VERSION using version.pm and qv()
150 use version; our $VERSION = qv('1.230');
152 '1.23' => <<'---', # Two version assignments, should ignore second one
153 $Simple::VERSION = '1.230';
154 $Simple::VERSION = eval $Simple::VERSION;
156 '1.23' => <<'---', # declared & defined on same line with 'our'
158 our $VERSION = '1.23_00_00';
160 '1.23' => <<'---', # package NAME VERSION
163 '1.23_01' => <<'---', # package NAME VERSION
164 package Simple 1.23_01;
166 'v1.2.3' => <<'---', # package NAME VERSION
167 package Simple v1.2.3;
169 'v1.2_3' => <<'---', # package NAME VERSION
170 package Simple v1.2_3;
172 '1.23' => <<'---', # trailing crud
175 $VERSION = '1.23-alpha';
177 '1.23' => <<'---', # trailing crud
182 '1.234' => <<'---', # multi_underscore
185 $VERSION = '1.2_3_4';
187 '0' => <<'---', # non-numeric
190 $VERSION = 'onetwothree';
192 $undef => <<'---', # package NAME BLOCK, undef $VERSION
197 '1.23' => <<'---', # package NAME BLOCK, with $VERSION
199 our $VERSION = '1.23';
202 '1.23' => <<'---', # package NAME VERSION BLOCK
203 package Simple 1.23 {
207 'v1.2.3_4' => <<'---', # package NAME VERSION BLOCK
208 package Simple v1.2.3_4 {
213 my %modules = reverse @modules;
216 [ 'Simple' ] => <<'---', # package NAME
219 [ 'Simple::Edward' ] => <<'---', # package NAME::SUBNAME
220 package Simple::Edward;
222 [ 'Simple::Edward::' ] => <<'---', # package NAME::SUBNAME::
223 package Simple::Edward::;
225 [ "Simple'Edward" ] => <<'---', # package NAME'SUBNAME
226 package Simple'Edward;
228 [ "Simple'Edward::" ] => <<'---', # package NAME'SUBNAME::
229 package Simple'Edward::;
231 [ 'Simple::::Edward' ] => <<'---', # package NAME::::SUBNAME
232 package Simple::::Edward;
234 [ '::Simple::Edward' ] => <<'---', # package ::NAME::SUBNAME
235 package ::Simple::Edward;
237 [ 'main' ] => <<'---', # package NAME:SUBNAME (fail)
238 package Simple:Edward;
240 [ 'main' ] => <<'---', # package NAME' (fail)
243 [ 'main' ] => <<'---', # package NAME::SUBNAME' (fail)
244 package Simple::Edward';
246 [ 'main' ] => <<'---', # package NAME''SUBNAME (fail)
247 package Simple''Edward;
249 [ 'main' ] => <<'---', # package NAME-SUBNAME (fail)
250 package Simple-Edward;
253 my %pkg_names = reverse @pkg_names;
255 plan tests => 54 + (2 * keys( %modules )) + (2 * keys( %pkg_names ));
257 require_ok('Module::Metadata');
259 # class method C<find_module_by_name>
260 my $module = Module::Metadata->find_module_by_name(
261 'Module::Metadata' );
262 ok( -e $module, 'find_module_by_name() succeeds' );
264 #########################
266 my $tmp = MBTest->tmpdir;
269 my $dist = DistGen->new( dir => $tmp );
275 # fail on invalid module name
276 my $pm_info = Module::Metadata->new_from_module(
277 'Foo::Bar', inc => [] );
278 ok( !defined( $pm_info ), 'fail if can\'t find module by module name' );
281 # fail on invalid filename
282 my $file = File::Spec->catfile( 'Foo', 'Bar.pm' );
283 $pm_info = Module::Metadata->new_from_file( $file, inc => [] );
284 ok( !defined( $pm_info ), 'fail if can\'t find module by file name' );
287 # construct from module filename
288 $file = File::Spec->catfile( 'lib', split( /::/, $dist->name ) ) . '.pm';
289 $pm_info = Module::Metadata->new_from_file( $file );
290 ok( defined( $pm_info ), 'new_from_file() succeeds' );
292 # construct from filehandle
293 my $handle = IO::File->new($file);
294 $pm_info = Module::Metadata->new_from_handle( $handle, $file );
295 ok( defined( $pm_info ), 'new_from_handle() succeeds' );
296 $pm_info = Module::Metadata->new_from_handle( $handle );
297 is( $pm_info, undef, "new_from_handle() without filename returns undef" );
300 # construct from module name, using custom include path
301 $pm_info = Module::Metadata->new_from_module(
302 $dist->name, inc => [ 'lib', @INC ] );
303 ok( defined( $pm_info ), 'new_from_module() succeeds' );
306 foreach my $module ( sort keys %modules ) {
307 my $expected = $modules{$module};
309 skip( "No our() support until perl 5.6", 2 )
310 if $] < 5.006 && $module =~ /\bour\b/;
311 skip( "No package NAME VERSION support until perl 5.11.1", 2 )
312 if $] < 5.011001 && $module =~ /package\s+[\w\:\']+\s+v?[0-9._]+/;
314 $dist->change_file( 'lib/Simple.pm', $module );
318 local $SIG{__WARN__} = sub { $warnings .= $_ for @_ };
319 my $pm_info = Module::Metadata->new_from_file( $file );
321 # Test::Builder will prematurely numify objects, so use this form
323 my $got = $pm_info->version;
324 if ( defined $expected ) {
325 ok( $got eq $expected,
326 "correct module version (expected '$expected')" )
330 "correct module version (expected undef)" )
333 is( $warnings, '', 'no warnings from parsing' ) or $errs++;
334 diag "Got: '$got'\nModule contents:\n$module" if $errs;
338 # revert to pristine state
339 $dist->regen( clean => 1 );
341 foreach my $pkg_name ( sort keys %pkg_names ) {
342 my $expected = $pkg_names{$pkg_name};
344 $dist->change_file( 'lib/Simple.pm', $pkg_name );
348 local $SIG{__WARN__} = sub { $warnings .= $_ for @_ };
349 my $pm_info = Module::Metadata->new_from_file( $file );
351 # Test::Builder will prematurely numify objects, so use this form
353 my @got = $pm_info->packages_inside();
354 is_deeply( \@got, $expected,
355 "correct package names (expected '" . join(', ', @$expected) . "')" )
357 is( $warnings, '', 'no warnings from parsing' ) or $errs++;
358 diag "Got: '" . join(', ', @got) . "'\nModule contents:\n$pkg_name" if $errs;
361 # revert to pristine state
362 $dist->regen( clean => 1 );
364 # Find each package only once
365 $dist->change_file( 'lib/Simple.pm', <<'---' );
368 package Error::Simple;
375 $pm_info = Module::Metadata->new_from_file( $file );
377 my @packages = $pm_info->packages_inside;
378 is( @packages, 2, 'record only one occurence of each package' );
381 # Module 'Simple.pm' does not contain package 'Simple';
382 # constructor should not complain, no default module name or version
383 $dist->change_file( 'lib/Simple.pm', <<'---' );
389 $pm_info = Module::Metadata->new_from_file( $file );
391 is( $pm_info->name, undef, 'no default package' );
392 is( $pm_info->version, undef, 'no version w/o default package' );
394 # Module 'Simple.pm' contains an alpha version
395 # constructor should report first $VERSION found
396 $dist->change_file( 'lib/Simple.pm', <<'---' );
398 $VERSION = '1.23_01';
399 $VERSION = eval $VERSION;
403 $pm_info = Module::Metadata->new_from_file( $file );
405 is( $pm_info->version, '1.23_01', 'alpha version reported');
407 # NOTE the following test has be done this way because Test::Builder is
408 # too smart for our own good and tries to see if the version object is a
409 # dual-var, which breaks with alpha versions:
410 # Argument "1.23_0100" isn't numeric in addition (+) at
411 # /usr/lib/perl5/5.8.7/Test/Builder.pm line 505.
413 ok( $pm_info->version > 1.23, 'alpha version greater than non');
415 # revert to pristine state
416 $dist->regen( clean => 1 );
418 # parse $VERSION lines scripts for package main
420 <<'---', # package main declared
425 <<'---', # on first non-comment line, non declared package main
429 <<'---', # after non-comment line
434 <<'---', # 1st declared package
441 <<'---', # 2nd declared package
448 <<'---', # split package
456 <<'---', # define 'main' version from other package
461 <<'---', # define 'main' version from other package
468 my ( $i, $n ) = ( 1, scalar( @scripts ) );
469 foreach my $script ( @scripts ) {
470 $dist->change_file( 'bin/simple.plx', $script );
472 $pm_info = Module::Metadata->new_from_file(
473 File::Spec->catfile( 'bin', 'simple.plx' ) );
475 is( $pm_info->version, '0.01', "correct script version ($i of $n)" );
480 # examine properties of a module: name, pod, etc
481 $dist->change_file( 'lib/Simple.pm', <<'---' );
495 You can find me on the IRC channel
496 #simon on irc.perl.org.
502 $pm_info = Module::Metadata->new_from_module(
503 $dist->name, inc => [ 'lib', @INC ] );
505 is( $pm_info->name, 'Simple', 'found default package' );
506 is( $pm_info->version, '0.01', 'version for default package' );
508 # got correct version for secondary package
509 is( $pm_info->version( 'Simple::Ex' ), '0.02',
510 'version for secondary package' );
512 my $filename = $pm_info->filename;
513 ok( defined( $filename ) && -e $filename,
514 'filename() returns valid path to module file' );
516 @packages = $pm_info->packages_inside;
517 is( @packages, 2, 'found correct number of packages' );
518 is( $packages[0], 'Simple', 'packages stored in order found' );
520 # we can detect presence of pod regardless of whether we are collecting it
521 ok( $pm_info->contains_pod, 'contains_pod() succeeds' );
523 my @pod = $pm_info->pod_inside;
524 is_deeply( \@pod, [qw(NAME AUTHOR)], 'found all pod sections' );
526 is( $pm_info->pod('NONE') , undef,
527 'return undef() if pod section not present' );
529 is( $pm_info->pod('NAME'), undef,
530 'return undef() if pod section not collected' );
534 $pm_info = Module::Metadata->new_from_module(
535 $dist->name, inc => [ 'lib', @INC ], collect_pod => 1 );
539 for my $section (qw(NAME AUTHOR)) {
540 my $content = $pm_info->pod( $section );
542 $content =~ s/^\s+//;
543 $content =~ s/\s+$//;
545 $pod{$section} = $content;
548 NAME => q|Simple - It's easy.|,
549 AUTHOR => <<'EXPECTED'
552 You can find me on the IRC channel
553 #simon on irc.perl.org.
556 for my $text (values %expected) {
560 is( $pod{NAME}, $expected{NAME}, 'collected NAME pod section' );
561 is( $pod{AUTHOR}, $expected{AUTHOR}, 'collected AUTHOR pod section' );
565 # test things that look like POD, but aren't
566 $dist->change_file( 'lib/Simple.pm', <<'---' );
571 our $VERSION = '999';
575 our $VERSION = '666';
580 =*no_this_does_not_start_pod;
582 our $VERSION = '1.23';
586 $pm_info = Module::Metadata->new_from_file('lib/Simple.pm');
587 is( $pm_info->name, 'Simple', 'found default package' );
588 is( $pm_info->version, '1.23', 'version for default package' );
592 # Make sure processing stops after __DATA__
593 $dist->change_file( 'lib/Simple.pm', <<'---' );
597 *UNIVERSAL::VERSION = sub {
603 $pm_info = Module::Metadata->new_from_file('lib/Simple.pm');
604 is( $pm_info->name, 'Simple', 'found default package' );
605 is( $pm_info->version, '0.01', 'version for default package' );
606 my @packages = $pm_info->packages_inside;
607 is_deeply(\@packages, ['Simple'], 'packages inside');
611 # Make sure we handle version.pm $VERSIONs well
612 $dist->change_file( 'lib/Simple.pm', <<'---' );
614 $VERSION = version->new('0.60.' . (qw$Revision: 128 $)[1]);
615 package Simple::Simon;
616 $VERSION = version->new('0.61.' . (qw$Revision: 129 $)[1]);
620 $pm_info = Module::Metadata->new_from_file('lib/Simple.pm');
621 is( $pm_info->name, 'Simple', 'found default package' );
622 is( $pm_info->version, '0.60.128', 'version for default package' );
623 my @packages = $pm_info->packages_inside;
624 is_deeply([sort @packages], ['Simple', 'Simple::Simon'], 'packages inside');
625 is( $pm_info->version('Simple::Simon'), '0.61.129', 'version for embedded package' );
628 # check that package_versions_from_directory works
630 $dist->change_file( 'lib/Simple.pm', <<'---' );
636 package main; # should ignore this
639 package DB; # should ignore this
642 package Simple::_private; # should ignore this
659 'file' => 'Simple.pm',
663 'file' => 'Simple.pm',
668 my $got_pvfd = Module::Metadata->package_versions_from_directory('lib');
670 is_deeply( $got_pvfd, $exp_pvfd, "package_version_from_directory()" )
671 or diag explain $got_pvfd;
674 my $got_provides = Module::Metadata->provides(dir => 'lib', version => 2);
677 'file' => 'lib/Simple.pm',
681 'file' => 'lib/Simple.pm',
686 is_deeply( $got_provides, $exp_provides, "provides()" )
687 or diag explain $got_provides;
691 my $got_provides = Module::Metadata->provides(dir => 'lib', prefix => 'other', version => 1.4);
694 'file' => 'other/Simple.pm',
698 'file' => 'other/Simple.pm',
703 is_deeply( $got_provides, $exp_provides, "provides()" )
704 or diag explain $got_provides;
707 # Check package_versions_from_directory with regard to case-sensitivity
709 $dist->change_file( 'lib/Simple.pm', <<'---' );
715 $pm_info = Module::Metadata->new_from_file('lib/Simple.pm');
716 is( $pm_info->name, undef, 'no default package' );
717 is( $pm_info->version, undef, 'version for default package' );
718 is( $pm_info->version('simple'), '0.01', 'version for lower-case package' );
719 is( $pm_info->version('Simple'), undef, 'version for capitalized package' );
721 $dist->change_file( 'lib/Simple.pm', <<'---' );
731 $pm_info = Module::Metadata->new_from_file('lib/Simple.pm');
732 is( $pm_info->name, 'Simple', 'found default package' );
733 is( $pm_info->version, '0.02', 'version for default package' );
734 is( $pm_info->version('simple'), '0.01', 'version for lower-case package' );
735 is( $pm_info->version('Simple'), '0.02', 'version for capitalized package' );
736 is( $pm_info->version('SiMpLe'), '0.03', 'version for mixed-case package' );