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 => 72;
   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     cmp_ok( $pm_info->version, '==', '1.23',
 191         "correct module version ($i of $n)" );
 192     is( $warnings, '', 'no warnings from parsing' );
 193     $i++;
 194   }
 195 }
 196
 197 # revert to pristine state
 198 chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 199 $dist->remove;
 200 $dist = DistGen->new( dir => $tmp );
 201 $dist->regen;
 202 chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
 203
 204
 205 # Find each package only once
 206 $dist->change_file( 'lib/Simple.pm', <<'---' );
 207 package Simple;
 208 $VERSION = '1.23';
 209 package Error::Simple;
 210 $VERSION = '2.34';
 211 package Simple;
 212 ---
 213
 214 $dist->regen;
 215
 216 $pm_info = Module::Build::ModuleInfo->new_from_file( $file );
 217
 218 my @packages = $pm_info->packages_inside;
 219 is( @packages, 2, 'record only one occurence of each package' );
 220
 221
 222 # Module 'Simple.pm' does not contain package 'Simple';
 223 # constructor should not complain, no default module name or version
 224 $dist->change_file( 'lib/Simple.pm', <<'---' );
 225 package Simple::Not;
 226 $VERSION = '1.23';
 227 ---
 228
 229 $dist->regen;
 230 $pm_info = Module::Build::ModuleInfo->new_from_file( $file );
 231
 232 is( $pm_info->name, undef, 'no default package' );
 233 is( $pm_info->version, undef, 'no version w/o default package' );
 234
 235 # Module 'Simple.pm' contains an alpha version
 236 # constructor should report first $VERSION found
 237 $dist->change_file( 'lib/Simple.pm', <<'---' );
 238 package Simple;
 239 $VERSION = '1.23_01';
 240 $VERSION = eval $VERSION;
 241 ---
 242
 243 $dist->regen;
 244 $pm_info = Module::Build::ModuleInfo->new_from_file( $file );
 245
 246 is( $pm_info->version, '1.23_01', 'alpha version reported');
 247
 248 # NOTE the following test has be done this way because Test::Builder is
 249 # too smart for our own good and tries to see if the version object is a
 250 # dual-var, which breaks with alpha versions:
 251 #    Argument "1.23_0100" isn't numeric in addition (+) at
 252 #    /usr/lib/perl5/5.8.7/Test/Builder.pm line 505.
 253
 254 ok( $pm_info->version > 1.23, 'alpha version greater than non');
 255
 256 # revert to pristine state
 257 chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 258 $dist->remove;
 259 $dist = DistGen->new( dir => $tmp );
 260 $dist->regen;
 261 chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
 262
 263
 264 # parse $VERSION lines scripts for package main
 265 my @scripts = (
 266   <<'---', # package main declared
 267 #!perl -w
 268 package main;
 269 $VERSION = '0.01';
 270 ---
 271   <<'---', # on first non-comment line, non declared package main
 272 #!perl -w
 273 $VERSION = '0.01';
 274 ---
 275   <<'---', # after non-comment line
 276 #!perl -w
 277 use strict;
 278 $VERSION = '0.01';
 279 ---
 280   <<'---', # 1st declared package
 281 #!perl -w
 282 package main;
 283 $VERSION = '0.01';
 284 package _private;
 285 $VERSION = '999';
 286 ---
 287   <<'---', # 2nd declared package
 288 #!perl -w
 289 package _private;
 290 $VERSION = '999';
 291 package main;
 292 $VERSION = '0.01';
 293 ---
 294   <<'---', # split package
 295 #!perl -w
 296 package main;
 297 package _private;
 298 $VERSION = '999';
 299 package main;
 300 $VERSION = '0.01';
 301 ---
 302   <<'---', # define 'main' version from other package
 303 package _private;
 304 $::VERSION = 0.01;
 305 $VERSION = '999';
 306 ---
 307   <<'---', # define 'main' version from other package
 308 package _private;
 309 $VERSION = '999';
 310 $::VERSION = 0.01;
 311 ---
 312 );
 313
 314 ( $i, $n ) = ( 1, scalar( @scripts ) );
 315 foreach my $script ( @scripts ) {
 316   $dist->change_file( 'bin/simple.plx', $script );
 317   $dist->regen;
 318   $pm_info = Module::Build::ModuleInfo->new_from_file(
 319                File::Spec->catfile( 'bin', 'simple.plx' ) );
 320
 321   is( $pm_info->version, '0.01', "correct script version ($i of $n)" );
 322   $i++;
 323 }
 324
 325
 326 # examine properties of a module: name, pod, etc
 327 $dist->change_file( 'lib/Simple.pm', <<'---' );
 328 package Simple;
 329 $VERSION = '0.01';
 330 package Simple::Ex;
 331 $VERSION = '0.02';
 332 =head1 NAME
 333
 334 Simple - It's easy.
 335
 336 =head1 AUTHOR
 337
 338 Simple Simon
 339
 340 =cut
 341 ---
 342 $dist->regen;
 343
 344 $pm_info = Module::Build::ModuleInfo->new_from_module(
 345              $dist->name, inc => [ 'lib', @INC ] );
 346
 347 is( $pm_info->name, 'Simple', 'found default package' );
 348
 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 # cleanup
 389 chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 390 $dist->remove;
 391
 392 use File::Path;
 393 rmtree( $tmp );