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