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 => 66;
   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 );
 167
 168 my( $i, $n ) = ( 1, scalar( @modules ) );
 169 foreach my $module ( @modules ) {
 170  SKIP: {
 171     skip( "No our() support until perl 5.6", 2 )
 172         if $] < 5.006 && $module =~ /\bour\b/;
 173
 174     $dist->change_file( 'lib/Simple.pm', $module );
 175     $dist->regen;
 176
 177     my $warnings = '';
 178     local $SIG{__WARN__} = sub { $warnings .= $_ for @_ };
 179     my $pm_info = Module::Build::ModuleInfo->new_from_file( $file );
 180
 181     is( $pm_info->version, '1.23',
 182         "correct module version ($i of $n)" );
 183     is( $warnings, '', 'no warnings from parsing' );
 184     $i++;
 185   }
 186 }
 187
 188 # revert to pristine state
 189 chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 190 $dist->remove;
 191 $dist = DistGen->new( dir => $tmp );
 192 $dist->regen;
 193 chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
 194
 195
 196 # Find each package only once
 197 $dist->change_file( 'lib/Simple.pm', <<'---' );
 198 package Simple;
 199 $VERSION = '1.23';
 200 package Error::Simple;
 201 $VERSION = '2.34';
 202 package Simple;
 203 ---
 204
 205 $dist->regen;
 206
 207 $pm_info = Module::Build::ModuleInfo->new_from_file( $file );
 208
 209 my @packages = $pm_info->packages_inside;
 210 is( @packages, 2, 'record only one occurence of each package' );
 211
 212
 213 # Module 'Simple.pm' does not contain package 'Simple';
 214 # constructor should not complain, no default module name or version
 215 $dist->change_file( 'lib/Simple.pm', <<'---' );
 216 package Simple::Not;
 217 $VERSION = '1.23';
 218 ---
 219
 220 $dist->regen;
 221 $pm_info = Module::Build::ModuleInfo->new_from_file( $file );
 222
 223 is( $pm_info->name, undef, 'no default package' );
 224 is( $pm_info->version, undef, 'no version w/o default package' );
 225
 226
 227 # revert to pristine state
 228 chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 229 $dist->remove;
 230 $dist = DistGen->new( dir => $tmp );
 231 $dist->regen;
 232 chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
 233
 234
 235 # parse $VERSION lines scripts for package main
 236 my @scripts = (
 237   <<'---', # package main declared
 238 #!perl -w
 239 package main;
 240 $VERSION = '0.01';
 241 ---
 242   <<'---', # on first non-comment line, non declared package main
 243 #!perl -w
 244 $VERSION = '0.01';
 245 ---
 246   <<'---', # after non-comment line
 247 #!perl -w
 248 use strict;
 249 $VERSION = '0.01';
 250 ---
 251   <<'---', # 1st declared package
 252 #!perl -w
 253 package main;
 254 $VERSION = '0.01';
 255 package _private;
 256 $VERSION = '999';
 257 ---
 258   <<'---', # 2nd declared package
 259 #!perl -w
 260 package _private;
 261 $VERSION = '999';
 262 package main;
 263 $VERSION = '0.01';
 264 ---
 265   <<'---', # split package
 266 #!perl -w
 267 package main;
 268 package _private;
 269 $VERSION = '999';
 270 package main;
 271 $VERSION = '0.01';
 272 ---
 273   <<'---', # define 'main' version from other package
 274 package _private;
 275 $::VERSION = 0.01;
 276 $VERSION = '999';
 277 ---
 278   <<'---', # define 'main' version from other package
 279 package _private;
 280 $VERSION = '999';
 281 $::VERSION = 0.01;
 282 ---
 283 );
 284
 285 ( $i, $n ) = ( 1, scalar( @scripts ) );
 286 foreach my $script ( @scripts ) {
 287   $dist->change_file( 'bin/simple.plx', $script );
 288   $dist->regen;
 289   $pm_info = Module::Build::ModuleInfo->new_from_file(
 290                File::Spec->catfile( 'bin', 'simple.plx' ) );
 291
 292   is( $pm_info->version, '0.01', "correct script version ($i of $n)" );
 293   $i++;
 294 }
 295
 296
 297 # examine properties of a module: name, pod, etc
 298 $dist->change_file( 'lib/Simple.pm', <<'---' );
 299 package Simple;
 300 $VERSION = '0.01';
 301 package Simple::Ex;
 302 $VERSION = '0.02';
 303 =head1 NAME
 304
 305 Simple - It's easy.
 306
 307 =head1 AUTHOR
 308
 309 Simple Simon
 310
 311 =cut
 312 ---
 313 $dist->regen;
 314
 315 $pm_info = Module::Build::ModuleInfo->new_from_module(
 316              $dist->name, inc => [ 'lib', @INC ] );
 317
 318 is( $pm_info->name, 'Simple', 'found default package' );
 319
 320 is( $pm_info->version, '0.01', 'version for default package' );
 321
 322 # got correct version for secondary package
 323 is( $pm_info->version( 'Simple::Ex' ), '0.02',
 324     'version for secondary package' );
 325
 326 my $filename = $pm_info->filename;
 327 ok( defined( $filename ) && -e $filename,
 328     'filename() returns valid path to module file' );
 329
 330 @packages = $pm_info->packages_inside;
 331 is( @packages, 2, 'found correct number of packages' );
 332 is( $packages[0], 'Simple', 'packages stored in order found' );
 333
 334 # we can detect presence of pod regardless of whether we are collecting it
 335 ok( $pm_info->contains_pod, 'contains_pod() succeeds' );
 336
 337 my @pod = $pm_info->pod_inside;
 338 is_deeply( \@pod, [qw(NAME AUTHOR)], 'found all pod sections' );
 339
 340 is( $pm_info->pod('NONE') , undef,
 341     'return undef() if pod section not present' );
 342
 343 is( $pm_info->pod('NAME'), undef,
 344     'return undef() if pod section not collected' );
 345
 346
 347 # collect_pod
 348 $pm_info = Module::Build::ModuleInfo->new_from_module(
 349              $dist->name, inc => [ 'lib', @INC ], collect_pod => 1 );
 350
 351 my $name = $pm_info->pod('NAME');
 352 if ( $name ) {
 353   $name =~ s/^\s+//;
 354   $name =~ s/\s+$//;
 355 }
 356 is( $name, q|Simple - It's easy.|, 'collected pod section' );
 357
 358
 359 # cleanup
 360 chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 361 $dist->remove;
 362
 363 use File::Path;
 364 rmtree( $tmp );