lib/Module/Build/t/moduleinfo.t

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