1#!/usr/bin/perl -w 2 3# This test puts MakeMaker through the paces of a basic perl module 4# build, test and installation of the Big::Fat::Dummy module. 5 6# Module::Install relies on being able to patch the generated Makefile 7# to add flags to $(PERL) 8# This test includes adding ' -Iinc' to $(PERL), and checking 'make install' 9# after that works. Done here as back-compat is considered basic. 10 11BEGIN { 12 unshift @INC, 't/lib'; 13} 14 15use strict; 16use Config; 17use ExtUtils::MakeMaker; 18use utf8; 19 20use MakeMaker::Test::Utils; 21use MakeMaker::Test::Setup::BFD; 22use Config; 23use Test::More; 24use ExtUtils::MM; 25plan !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} 26 ? (skip_all => "cross-compiling and make not available") 27 : (tests => 171); 28use File::Find; 29use File::Spec; 30use File::Path; 31use File::Temp qw[tempdir]; 32 33my $perl = which_perl(); 34my $Is_VMS = $^O eq 'VMS'; 35my $OLD_CP; # crude but... 36my $w32worked; # or whether we had to fallback to chcp 37if ($^O eq "MSWin32") { 38 eval { require Win32; $w32worked = $OLD_CP = Win32::GetConsoleCP() }; 39 $OLD_CP = $1 if !$w32worked and qx(chcp) =~ /(\d+)$/ and $? == 0; 40 if (defined $OLD_CP) { 41 if ($w32worked) { 42 Win32::SetConsoleCP(1252) 43 } else { 44 qx(chcp 1252); 45 } 46 } 47} 48END { 49 if ($^O eq "MSWin32" and defined $OLD_CP) { 50 if ($w32worked) { 51 Win32::SetConsoleCP($OLD_CP) 52 } else { 53 qx(chcp $OLD_CP); 54 } 55 } 56} 57 58my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 ); 59chdir $tmpdir; 60 61perl_lib; 62 63my $Touch_Time = calibrate_mtime(); 64 65$| = 1; 66 67ok( setup_recurs(), 'setup' ); 68END { 69 ok chdir File::Spec->updir or die; 70 ok teardown_recurs, "teardown"; 71} 72 73ok( chdir('Big-Dummy'), "chdir'd to Big-Dummy" ) || 74 diag("chdir failed: $!"); 75 76sub extrachar { $] > 5.008 && !$ENV{PERL_CORE} ? utf8::decode(my $c='š') : 's' } 77my $DUMMYINST = '../dummy-in'.extrachar().'tall'; 78my @mpl_out = run(qq{$perl Makefile.PL "PREFIX=$DUMMYINST"}); 79END { rmtree $DUMMYINST; } 80 81cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || 82 diag(@mpl_out); 83 84my $makefile = makefile_name(); 85ok( grep(/^Writing $makefile for Big::Dummy/, 86 @mpl_out) == 1, 87 'Makefile.PL output looks right'); 88 89ok( grep(/^Current package is: main$/, 90 @mpl_out) == 1, 91 'Makefile.PL run in package main'); 92 93ok( -e $makefile, 'Makefile exists' ); 94 95# -M is flakey on VMS 96my $mtime = (stat($makefile))[9]; 97cmp_ok( $Touch_Time, '<=', $mtime, ' been touched' ); 98 99END { unlink makefile_name(), makefile_backup() } 100 101my $make = make_run(); 102 103{ 104 # Suppress 'make manifest' noise 105 local $ENV{PERL_MM_MANIFEST_VERBOSE} = 0; 106 my $manifest_out = run("$make manifest"); 107 ok( -e 'MANIFEST', 'make manifest created a MANIFEST' ); 108 ok( -s 'MANIFEST', ' not empty' ); 109} 110 111END { unlink 'MANIFEST'; } 112 113my $ppd_out = run("$make ppd"); 114is( $?, 0, ' exited normally' ) || diag $ppd_out; 115ok( open(PPD, 'Big-Dummy.ppd'), ' .ppd file generated' ); 116my $ppd_html; 117{ local $/; $ppd_html = <PPD> } 118close PPD; 119like( $ppd_html, qr{^<SOFTPKG NAME="Big-Dummy" VERSION="0.01">}m, 120 ' <SOFTPKG>' ); 121like( $ppd_html, 122 qr{^\s*<ABSTRACT>Try "our" hot dog's, \$andwiche\$ and \$\(ub\)\$!</ABSTRACT>}m, 123 ' <ABSTRACT>'); 124like( $ppd_html, 125 qr{^\s*<AUTHOR>Michael G Schwern <schwern\@pobox.com></AUTHOR>}m, 126 ' <AUTHOR>' ); 127like( $ppd_html, qr{^\s*<IMPLEMENTATION>}m, ' <IMPLEMENTATION>'); 128like( $ppd_html, qr{^\s*<REQUIRE NAME="strict::" />}m, ' <REQUIRE>' ); 129unlike( $ppd_html, qr{^\s*<REQUIRE NAME="warnings::" />}m, 'no <REQUIRE> for build_require' ); 130 131my $archname = $Config{archname}; 132if( $] >= 5.008 ) { 133 # XXX This is a copy of the internal logic, so it's not a great test 134 $archname .= "-$Config{PERL_REVISION}.$Config{PERL_VERSION}"; 135} 136like( $ppd_html, qr{^\s*<ARCHITECTURE NAME="$archname" />}m, 137 ' <ARCHITECTURE>'); 138like( $ppd_html, qr{^\s*<CODEBASE HREF="" />}m, ' <CODEBASE>'); 139like( $ppd_html, qr{^\s*</IMPLEMENTATION>}m, ' </IMPLEMENTATION>'); 140like( $ppd_html, qr{^\s*</SOFTPKG>}m, ' </SOFTPKG>'); 141END { unlink 'Big-Dummy.ppd' } 142 143 144my $test_out = run("$make test"); 145like( $test_out, qr/All tests successful/, 'make test' ); 146is( $?, 0, ' exited normally' ) || 147 diag $test_out; 148 149# Test 'make test TEST_VERBOSE=1' 150my $make_test_verbose = make_macro($make, 'test', TEST_VERBOSE => 1); 151$test_out = run("$make_test_verbose"); 152like( $test_out, qr/ok \d+ - TEST_VERBOSE/, 'TEST_VERBOSE' ); 153like( $test_out, qr/All tests successful/, ' successful' ); 154is( $?, 0, ' exited normally' ) || 155 diag $test_out; 156 157# now simulate what Module::Install does, and edit $(PERL) to add flags 158open my $fh, '<', $makefile; 159my $mtext = join '', <$fh>; 160close $fh; 161$mtext =~ s/^(\s*PERL\s*=.*)$/$1 -Iinc/m; 162open $fh, '>', $makefile; 163print $fh $mtext; 164close $fh; 165 166my $install_out = run("$make install"); 167is( $?, 0, 'install' ) || diag $install_out; 168like( $install_out, qr/^Installing /m ); 169 170sub check_dummy_inst { 171 my $loc = shift; 172 my %files = (); 173 find( sub { 174 # do it case-insensitive for non-case preserving OSs 175 my $file = lc $_; 176 # VMS likes to put dots on the end of things that don't have them. 177 $file =~ s/\.$// if $Is_VMS; 178 $files{$file} = $File::Find::name; 179 }, $loc ); 180 ok( $files{'dummy.pm'}, ' Dummy.pm installed' ); 181 ok( $files{'liar.pm'}, ' Liar.pm installed' ); 182 ok( $files{'program'}, ' program installed' ); 183 ok( $files{'.packlist'}, ' packlist created' ); 184 ok( $files{'perllocal.pod'},' perllocal.pod created' ); 185 \%files; 186} 187 188SKIP: { 189 ok( -r $DUMMYINST, ' install dir created' ) 190 or skip "$DUMMYINST doesn't exist", 5; 191 check_dummy_inst($DUMMYINST); 192} 193 194SKIP: { 195 skip 'VMS install targets do not preserve $(PREFIX)', 8 if $Is_VMS; 196 197 $install_out = run("$make install PREFIX=elsewhere"); 198 is( $?, 0, 'install with PREFIX override' ) || diag $install_out; 199 like( $install_out, qr/^Installing /m ); 200 201 ok( -r 'elsewhere', ' install dir created' ); 202 check_dummy_inst('elsewhere'); 203 rmtree('elsewhere'); 204} 205 206 207SKIP: { 208 skip 'VMS install targets do not preserve $(DESTDIR)', 10 if $Is_VMS; 209 210 $install_out = run("$make install PREFIX= DESTDIR=other"); 211 is( $?, 0, 'install with DESTDIR' ) || 212 diag $install_out; 213 like( $install_out, qr/^Installing /m ); 214 215 ok( -d 'other', ' destdir created' ); 216 my $files = check_dummy_inst('other'); 217 218 ok( open(PERLLOCAL, $files->{'perllocal.pod'} ) ) || 219 diag("Can't open $files->{'perllocal.pod'}: $!"); 220 { local $/; 221 unlike(<PERLLOCAL>, qr/other/, 'DESTDIR should not appear in perllocal'); 222 } 223 close PERLLOCAL; 224 225# TODO not available in the min version of Test::Harness we require 226# ok( open(PACKLIST, $files{'.packlist'} ) ) || 227# diag("Can't open $files{'.packlist'}: $!"); 228# { local $/; 229# local $TODO = 'DESTDIR still in .packlist'; 230# unlike(<PACKLIST>, qr/other/, 'DESTDIR should not appear in .packlist'); 231# } 232# close PACKLIST; 233 234 rmtree('other'); 235} 236 237 238SKIP: { 239 skip 'VMS install targets do not preserve $(PREFIX)', 9 if $Is_VMS; 240 241 $install_out = run("$make install PREFIX=elsewhere DESTDIR=other/"); 242 is( $?, 0, 'install with PREFIX override and DESTDIR' ) || 243 diag $install_out; 244 like( $install_out, qr/^Installing /m ); 245 246 ok( !-d 'elsewhere', ' install dir not created' ); 247 ok( -d 'other/elsewhere', ' destdir created' ); 248 check_dummy_inst('other/elsewhere'); 249 rmtree('other'); 250} 251 252 253my $dist_test_out = run("$make disttest"); 254is( $?, 0, 'disttest' ) || diag($dist_test_out); 255 256# Test META.yml generation 257use ExtUtils::Manifest qw(maniread); 258 259my $distdir = 'Big-Dummy-0.01'; 260$distdir =~ s/\./_/g if $Is_VMS; 261my $meta_yml = "$distdir/META.yml"; 262my $mymeta_yml = "$distdir/MYMETA.yml"; 263my $meta_json = "$distdir/META.json"; 264my $mymeta_json = "$distdir/MYMETA.json"; 265 266note "META file validity"; { 267 require CPAN::Meta; 268 269 ok( !-f 'META.yml', 'META.yml not written to source dir' ); 270 ok( -f $meta_yml, 'META.yml written to dist dir' ); 271 ok( !-e "META_new.yml", 'temp META.yml file not left around' ); 272 273 ok( -f 'MYMETA.yml', 'MYMETA.yml is written to source dir' ); 274 ok( -f $mymeta_yml, 'MYMETA.yml is written to dist dir on disttest' ); 275 276 ok( !-f 'META.json', 'META.json not written to source dir' ); 277 ok( -f $meta_json, 'META.json written to dist dir' ); 278 ok( !-e "META_new.json", 'temp META.json file not left around' ); 279 280 ok( -f 'MYMETA.json', 'MYMETA.json is written to source dir' ); 281 ok( -f $mymeta_json, 'MYMETA.json is written to dist dir on disttest' ); 282 283 for my $case ( 284 ['META.yml', $meta_yml], 285 ['MYMETA.yml', $mymeta_yml], 286 ['META.json', $meta_json], 287 ['MYMETA.json', $mymeta_json], 288 ['MYMETA.yml', 'MYMETA.yml'], 289 ['MYMETA.json', 'MYMETA.json'], 290 ) { 291 my ($label, $meta_name) = @$case; 292 ok( 293 my $obj = eval { 294 CPAN::Meta->load_file($meta_name, {lazy_validation => 0}) 295 }, 296 "$label validates" 297 ); 298 my $is = sub { 299 my ($m,$e) = @_; 300 is($obj->$m, $e, "$label -> $m") 301 }; 302 my $is_list = sub { 303 my ($m,$e) = @_; 304 is_deeply([$obj->$m], $e, "$label -> $m") 305 }; 306 my $is_map = sub { 307 my ($m,$e) = @_; 308 is_deeply($obj->$m, $e, "$label -> $m") 309 }; 310 $is->( name => "Big-Dummy" ); 311 $is->( version => "0.01" ); 312 $is->( abstract => q{Try "our" hot dog's, $andwiche$ and $(ub)$!} ); 313 $is_list->( licenses => [q{unknown}] ); 314 $is_list->( authors => [ q{Michael G Schwern <schwern@pobox.com>} ] ); 315 $is_map->( prereqs => { 316 configure => { 317 requires => { 318 'ExtUtils::MakeMaker' => 0 319 }, 320 }, 321 build => { 322 requires => { 323 'warnings' => 0 324 } 325 }, 326 runtime => { 327 requires => { 328 'strict' => 0 329 } 330 }, 331 } 332 ); 333 $is_map->( 334 no_index => { 335 directory => [qw/t inc/], 336 } 337 ); 338 $is->( dynamic_config => ($label =~ /MYMETA/) ? 0 : 1 ); 339 } 340 341 my $manifest = maniread("$distdir/MANIFEST"); 342 # VMS is non-case preserving, so we can't know what the MANIFEST will 343 # look like. :( 344 _normalize($manifest); 345 is( $manifest->{'meta.yml'}, 'Module YAML meta-data (added by MakeMaker)', 346 "MANIFEST has META.yml" 347 ); 348 is( $manifest->{'meta.json'}, 'Module JSON meta-data (added by MakeMaker)', 349 "MANFIEST has META.json" 350 ); 351 352 # Test NO_META META.yml suppression 353 for my $f ( $meta_yml, $meta_json, 'MYMETA.yml', 'MYMETA.json' ) { 354 1 while unlink $f; 355 } 356 ok( !-f $meta_yml, 'META.yml deleted' ); 357 ok( !-f 'MYMETA.yml','MYMETA.yml deleted' ); 358 ok( !-f $meta_json, 'META.json deleted' ); 359 ok( !-f 'MYMETA.json','MYMETA.json deleted' ); 360 361 @mpl_out = run(qq{$perl Makefile.PL "NO_META=1"}); 362 ok( -f 'MYMETA.yml', 'MYMETA.yml generation not suppressed by NO_META' ); 363 ok( -f 'MYMETA.json', 'MYMETA.json generation not suppressed by NO_META' ); 364 cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out); 365 ok( !-f $meta_yml, 'META.yml generation suppressed by NO_META' ); 366 ok( !-f $meta_json, 'META.json generation suppressed by NO_META' ); 367 my $distdir_out = run("$make distdir"); 368 is( $?, 0, 'distdir' ) || diag($distdir_out); 369 ok( !-f $meta_yml, 'META.yml generation suppressed by NO_META' ); 370 ok( !-f $meta_json, 'META.json generation suppressed by NO_META' ); 371 372 for my $f ( 'MYMETA.yml', 'MYMETA.json' ) { 373 1 while unlink $f; 374 } 375 ok( !-f 'MYMETA.yml','MYMETA.yml deleted' ); 376 ok( !-f 'MYMETA.json','MYMETA.json deleted' ); 377 378 @mpl_out = run(qq{$perl Makefile.PL "NO_MYMETA=1"}); 379 cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out); 380 $distdir_out = run("$make distdir"); 381 is( $?, 0, 'distdir' ) || diag($distdir_out); 382 ok( !-f 'MYMETA.yml','MYMETA.yml generation suppressed by NO_MYMETA' ); 383 ok( !-f 'MYMETA.json','MYMETA.json generation suppressed by NO_MYMETA' ); 384 ok( -f $meta_yml, 'META.yml generation not suppressed by NO_MYMETA' ); 385 ok( -f $meta_json, 'META.json generation not suppressed by NO_MYMETA' ); 386 387 # Test MYMETA really comes from META except for prereqs 388 for my $f ( $meta_yml, $meta_json, 'MYMETA.yml', 'MYMETA.json' ) { 389 1 while unlink $f; 390 } 391 @mpl_out = run(qq{$perl Makefile.PL}); 392 cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out); 393 $distdir_out = run("$make distdir"); 394 is( $?, 0, 'distdir' ) || diag($distdir_out); 395 ok( -f $meta_yml, 'META.yml generated in distdir' ); 396 ok( -f $meta_json, 'META.json generated in distdir' ); 397 ok( ! -f $mymeta_yml, 'MYMETA.yml not yet generated in distdir' ); 398 ok( ! -f $mymeta_json, 'MYMETA.json generated in distdir' ); 399 my $edit_meta = CPAN::Meta->load_file($meta_json)->as_struct; 400 $edit_meta->{abstract} = "New abstract"; 401 my $meta_obj = CPAN::Meta->new($edit_meta); 402 is( $meta_obj->abstract, "New abstract", "MYMETA abstract from META, not Makefile.PL"); 403 ok( $meta_obj->save($meta_json), "Saved edited META.json in distdir" ); 404 ok( $meta_obj->save($meta_yml, {version => 1.4}), "Saved edited META.yml in distdir"); 405 ok( chdir $distdir ); 406 ok( -f 'META.yml', 'META.yml confirmed in distdir' ); 407 ok( -f 'META.json', 'META.json confirmed in distdir' ); 408 @mpl_out = run(qq{$perl Makefile.PL}); 409 cmp_ok( $?, '==', 0, 'Makefile.PL in distdir exited with zero' ) || diag(@mpl_out); 410 ok( chdir File::Spec->updir ); 411 ok( -f $mymeta_yml, 'MYMETA.yml generated in distdir' ); 412 ok( -f $mymeta_json, 'MYMETA.json generated in distdir' ); 413 $meta_obj = CPAN::Meta->load_file($meta_json); 414 is( $meta_obj->abstract, "New abstract", "META abstract is same as was saved"); 415 $meta_obj = CPAN::Meta->load_file($mymeta_json); 416 is( $meta_obj->abstract, "New abstract", "MYMETA abstract from META, not Makefile.PL"); 417} 418 419 420 421# Make sure init_dirscan doesn't go into the distdir 422@mpl_out = run(qq{$perl Makefile.PL "PREFIX=$DUMMYINST"}); 423 424cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out); 425 426ok( grep(/^Writing $makefile for Big::Dummy/, @mpl_out) == 1, 427 'init_dirscan skipped distdir') || 428 diag(@mpl_out); 429 430# I know we'll get ignored errors from make here, that's ok. 431# Send STDERR off to oblivion. 432open(SAVERR, ">&STDERR") or die $!; 433open(STDERR, ">",File::Spec->devnull) or die $!; 434 435my $realclean_out = run("$make realclean"); 436is( $?, 0, 'realclean' ) || diag($realclean_out); 437 438open(STDERR, ">&SAVERR") or die $!; 439close SAVERR; 440 441sub _normalize { 442 my $hash = shift; 443 444 %$hash= map { lc($_) => $hash->{$_} } keys %$hash; 445} 446