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 # 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 ---
 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 ---
 174 );
 175 my %modules = reverse @modules;
 176
 177 plan tests => 39 + 2 * keys( %modules );
 178
 179 require_ok('Module::Metadata');
 180
 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
 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
 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
 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
 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