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 ExtUtils::MM; 24use Test::More 25 !MM->can_run(make()) && $ENV{PERL_CORE} && $Config{'usecrosscompile'} 26 ? (skip_all => "cross-compiling and make not available") 27 : (tests => 188); 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 { 39 require Win32; 40 local $SIG{__WARN__} = sub {} if ( "$]" < 5.014 ); # suppress deprecation warning for inherited AUTOLOAD of Win32::GetConsoleCP() 41 $w32worked = $OLD_CP = Win32::GetConsoleCP(); 42 }; 43 $OLD_CP = $1 if !$w32worked and qx(chcp) =~ /(\d+)$/ and $? == 0; 44 if (defined $OLD_CP) { 45 if ($w32worked) { 46 Win32::SetConsoleCP(1252) 47 } else { 48 qx(chcp 1252); 49 } 50 } 51} 52END { 53 if ($^O eq "MSWin32" and defined $OLD_CP) { 54 if ($w32worked) { 55 Win32::SetConsoleCP($OLD_CP) 56 } else { 57 qx(chcp $OLD_CP); 58 } 59 } 60} 61 62chdir 't'; 63perl_lib; # sets $ENV{PERL5LIB} relative to t/ 64 65my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 ); 66use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup 67chdir $tmpdir; 68 69my $Touch_Time = calibrate_mtime(); 70 71$| = 1; 72 73ok( setup_recurs(), 'setup' ); 74 75ok( chdir('Big-Dummy'), "chdir'd to Big-Dummy" ) || 76 diag("chdir failed: $!"); 77 78sub extrachar { 79 return 's' 80 if 1; # until Perl gains native support for Unicode filenames 81# if $] <= 5.008 || $ENV{PERL_CORE} 82# || $^O =~ /bsd|dragonfly|mswin32/i; 83 'š'; 84} 85my $DUMMYINST = '../dummy-in'.extrachar().'tall'; 86my @mpl_out = run(qq{$perl Makefile.PL "PREFIX=$DUMMYINST"}); 87 88cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || 89 diag(@mpl_out); 90 91my $makefile = makefile_name(); 92ok( grep(/^Writing $makefile for Big::Dummy/, 93 @mpl_out) == 1, 94 'Makefile.PL output looks right'); 95 96ok( grep(/^Current package is: main$/, 97 @mpl_out) == 1, 98 'Makefile.PL run in package main'); 99 100ok( -e $makefile, 'Makefile exists' ); 101 102# -M is flakey on VMS 103my $mtime = (stat($makefile))[9]; 104cmp_ok( $Touch_Time, '<=', $mtime, ' been touched' ); 105 106my $make = make_run(); 107 108{ 109 # Suppress 'make manifest' noise 110 local $ENV{PERL_MM_MANIFEST_VERBOSE} = 0; 111 my $manifest_out = run("$make manifest"); 112 ok( -e 'MANIFEST', 'make manifest created a MANIFEST' ); 113 ok( -s 'MANIFEST', ' not empty' ); 114} 115 116my $ppd_out = run("$make ppd"); 117is( $?, 0, ' exited normally' ) || diag $ppd_out; 118ok( open(PPD, 'Big-Dummy.ppd'), ' .ppd file generated' ); 119my $ppd_html; 120{ local $/; $ppd_html = <PPD> } 121close PPD; 122like( $ppd_html, qr{^<SOFTPKG NAME="Big-Dummy" VERSION="0.01">}m, 123 ' <SOFTPKG>' ); 124like( $ppd_html, 125 qr{^\s*<ABSTRACT>Try "our" hot dog's, \$andwiche\$ and \$\(ub\)\$!</ABSTRACT>}m, 126 ' <ABSTRACT>'); 127like( $ppd_html, 128 qr{^\s*<AUTHOR>Michael G Schwern <schwern\@pobox.com></AUTHOR>}m, 129 ' <AUTHOR>' ); 130like( $ppd_html, qr{^\s*<IMPLEMENTATION>}m, ' <IMPLEMENTATION>'); 131like( $ppd_html, qr{^\s*<REQUIRE NAME="strict::" />}m, ' <REQUIRE>' ); 132unlike( $ppd_html, qr{^\s*<REQUIRE NAME="warnings::" />}m, 'no <REQUIRE> for build_require' ); 133 134my $archname = $Config{archname}; 135if( "$]" >= 5.008 ) { 136 # XXX This is a copy of the internal logic, so it's not a great test 137 $archname .= "-$Config{PERL_REVISION}.$Config{PERL_VERSION}"; 138} 139like( $ppd_html, qr{^\s*<ARCHITECTURE NAME="$archname" />}m, 140 ' <ARCHITECTURE>'); 141like( $ppd_html, qr{^\s*<CODEBASE HREF="" />}m, ' <CODEBASE>'); 142like( $ppd_html, qr{^\s*</IMPLEMENTATION>}m, ' </IMPLEMENTATION>'); 143like( $ppd_html, qr{^\s*</SOFTPKG>}m, ' </SOFTPKG>'); 144 145my $test_out = run("$make test"); 146like( $test_out, qr/All tests successful/, 'make test' ); 147is( $?, 0, ' exited normally' ) || 148 diag $test_out; 149 150# Test 'make test TEST_VERBOSE=1' 151my $make_test_verbose = make_macro($make, 'test', TEST_VERBOSE => 1); 152$test_out = run("$make_test_verbose"); 153like( $test_out, qr/ok \d+ - TEST_VERBOSE/, 'TEST_VERBOSE' ); 154like( $test_out, qr/ok \d+ - testing test.pl/, 'test.pl' ); # in test.pl 155like( $test_out, qr/ok \d+ - testing t\/\*.t/, 't/*.t' ); # in *.t 156like( $test_out, qr/All tests successful/, ' successful' ); 157is( $?, 0, ' exited normally' ) || 158 diag $test_out; 159 160# Test 'make testdb TEST_FILE=t/compile.t' 161# TESTDB_SW override is because perl -d is too clever for me to outwit 162my $make_testdb_file = make_macro( 163 $make, 164 'testdb', 165 TEST_FILE => 't/compile.t', 166 TESTDB_SW => '-Ixyzzy', 167); 168$test_out = run($make_testdb_file); 169unlike( $test_out, qr/harness/, 'no harness' ); 170unlike( $test_out, qr/sanity\.t/, 'no wrong test' ); 171like( $test_out, qr/compile\.t/, 'get right test' ); 172like( $test_out, qr/xyzzy/, 'signs of TESTDB_SW' ); 173is( $?, 0, ' exited normally' ) || 174 diag $test_out; 175 176# now simulate what Module::Install does, and edit $(PERL) to add flags 177open my $fh, '<', $makefile; 178my $mtext = join '', <$fh>; 179close $fh; 180$mtext =~ s/^(\s*PERL\s*=.*)$/$1 -Iinc/m; 181open $fh, '>', $makefile; 182print $fh $mtext; 183close $fh; 184 185my $install_out = run("$make install"); 186is( $?, 0, 'install' ) || diag $install_out; 187like( $install_out, qr/^Installing /m ); 188 189sub check_dummy_inst { 190 my ($loc, $skipsubdir) = @_; 191 my %files = (); 192 find( sub { 193 # do it case-insensitive for non-case preserving OSs 194 my $file = lc $_; 195 # VMS likes to put dots on the end of things that don't have them. 196 $file =~ s/\.$// if $Is_VMS; 197 $files{$file} = $File::Find::name; 198 }, $loc ); 199 ok( $files{'dummy.pm'}, ' Dummy.pm installed' ); 200 ok( $files{'liar.pm'}, ' Liar.pm installed' ) unless $skipsubdir; 201 ok( $files{'program'}, ' program installed' ); 202 ok( $files{'.packlist'}, ' packlist created' ); 203 ok( $files{'perllocal.pod'},' perllocal.pod created' ); 204 \%files; 205} 206 207SKIP: { 208 ok( -r $DUMMYINST, ' install dir created' ) 209 or skip "$DUMMYINST doesn't exist", 5; 210 check_dummy_inst($DUMMYINST); 211} 212 213SKIP: { 214 skip 'VMS install targets do not preserve $(PREFIX)', 8 if $Is_VMS; 215 216 $install_out = run("$make install PREFIX=elsewhere"); 217 is( $?, 0, 'install with PREFIX override' ) || diag $install_out; 218 like( $install_out, qr/^Installing /m ); 219 220 ok( -r 'elsewhere', ' install dir created' ); 221 check_dummy_inst('elsewhere'); 222 rmtree('elsewhere'); 223} 224 225 226SKIP: { 227 skip 'VMS install targets do not preserve $(DESTDIR)', 10 if $Is_VMS; 228 229 $install_out = run("$make install PREFIX= DESTDIR=other"); 230 is( $?, 0, 'install with DESTDIR' ) || 231 diag $install_out; 232 like( $install_out, qr/^Installing /m ); 233 234 ok( -d 'other', ' destdir created' ); 235 my $files = check_dummy_inst('other'); 236 237 ok( open(PERLLOCAL, $files->{'perllocal.pod'} ) ) || 238 diag("Can't open $files->{'perllocal.pod'}: $!"); 239 { local $/; 240 unlike(<PERLLOCAL>, qr/other/, 'DESTDIR should not appear in perllocal'); 241 } 242 close PERLLOCAL; 243 244# TODO not available in the min version of Test::Harness we require 245# ok( open(PACKLIST, $files{'.packlist'} ) ) || 246# diag("Can't open $files{'.packlist'}: $!"); 247# { local $/; 248# local $TODO = 'DESTDIR still in .packlist'; 249# unlike(<PACKLIST>, qr/other/, 'DESTDIR should not appear in .packlist'); 250# } 251# close PACKLIST; 252 253 rmtree('other'); 254} 255 256 257SKIP: { 258 skip 'VMS install targets do not preserve $(PREFIX)', 9 if $Is_VMS; 259 260 $install_out = run("$make install PREFIX=elsewhere DESTDIR=other/"); 261 is( $?, 0, 'install with PREFIX override and DESTDIR' ) || 262 diag $install_out; 263 like( $install_out, qr/^Installing /m ); 264 265 ok( !-d 'elsewhere', ' install dir not created' ); 266 ok( -d 'other/elsewhere', ' destdir created' ); 267 check_dummy_inst('other/elsewhere'); 268 rmtree('other'); 269} 270 271my ($dist_test_out, $distdir, $meta_yml, $mymeta_yml, $meta_json, $mymeta_json); 272SKIP: { 273 skip 'disttest depends on metafile, which is not run in core', 1 if $ENV{PERL_CORE}; 274 $dist_test_out = run("$make disttest"); 275 is( $?, 0, 'disttest' ) || diag($dist_test_out); 276 277 # Test META.yml generation 278 use ExtUtils::Manifest qw(maniread); 279 280 $distdir = 'Big-Dummy-0.01'; 281 $distdir =~ s/\./_/g if $Is_VMS; 282 $meta_yml = "$distdir/META.yml"; 283 $mymeta_yml = "$distdir/MYMETA.yml"; 284 $meta_json = "$distdir/META.json"; 285 $mymeta_json = "$distdir/MYMETA.json"; 286} 287 288note "META file validity"; SKIP: { 289 skip 'disttest depends on metafile, which is not run in core', 104 if $ENV{PERL_CORE}; 290 291 eval { require CPAN::Meta; }; 292 skip 'Loading CPAN::Meta failed', 104 if $@; 293 294 ok( !-f 'META.yml', 'META.yml not written to source dir' ); 295 ok( -f $meta_yml, 'META.yml written to dist dir' ); 296 ok( !-e "META_new.yml", 'temp META.yml file not left around' ); 297 298 ok( -f 'MYMETA.yml', 'MYMETA.yml is written to source dir' ); 299 ok( -f $mymeta_yml, 'MYMETA.yml is written to dist dir on disttest' ); 300 301 ok( !-f 'META.json', 'META.json not written to source dir' ); 302 ok( -f $meta_json, 'META.json written to dist dir' ); 303 ok( !-e "META_new.json", 'temp META.json file not left around' ); 304 305 ok( -f 'MYMETA.json', 'MYMETA.json is written to source dir' ); 306 ok( -f $mymeta_json, 'MYMETA.json is written to dist dir on disttest' ); 307 308 for my $case ( 309 ['META.yml', $meta_yml], 310 ['MYMETA.yml', $mymeta_yml], 311 ['META.json', $meta_json], 312 ['MYMETA.json', $mymeta_json], 313 ['MYMETA.yml', 'MYMETA.yml'], 314 ['MYMETA.json', 'MYMETA.json'], 315 ) { 316 my ($label, $meta_name) = @$case; 317 ok( 318 my $obj = eval { 319 CPAN::Meta->load_file($meta_name, {lazy_validation => 0}) 320 }, 321 "$label validates" 322 ); 323 my $is = sub { 324 my ($m,$e) = @_; 325 is($obj->$m, $e, "$label -> $m") 326 }; 327 my $is_list = sub { 328 my ($m,$e) = @_; 329 is_deeply([$obj->$m], $e, "$label -> $m") 330 }; 331 my $is_map = sub { 332 my ($m,$e) = @_; 333 is_deeply($obj->$m, $e, "$label -> $m") 334 }; 335 $is->( name => "Big-Dummy" ); 336 $is->( version => "0.01" ); 337 $is->( abstract => q{Try "our" hot dog's, $andwiche$ and $(ub)$!} ); 338 $is_list->( licenses => [q{unknown}] ); 339 $is_list->( authors => [ q{Michael G Schwern <schwern@pobox.com>} ] ); 340 $is_map->( prereqs => { 341 configure => { 342 requires => { 343 'ExtUtils::MakeMaker' => 0 344 }, 345 }, 346 build => { 347 requires => { 348 'warnings' => 0 349 } 350 }, 351 runtime => { 352 requires => { 353 'strict' => 0 354 } 355 }, 356 } 357 ); 358 $is_map->( 359 no_index => { 360 directory => [qw/t inc/], 361 } 362 ); 363 $is->( dynamic_config => ($label =~ /MYMETA/) ? 0 : 1 ); 364 } 365 366 my $manifest = maniread("$distdir/MANIFEST"); 367 # VMS is non-case preserving, so we can't know what the MANIFEST will 368 # look like. :( 369 _normalize($manifest); 370 is( $manifest->{'meta.yml'}, 'Module YAML meta-data (added by MakeMaker)', 371 "MANIFEST has META.yml" 372 ); 373 is( $manifest->{'meta.json'}, 'Module JSON meta-data (added by MakeMaker)', 374 "MANIFEST has META.json" 375 ); 376 377 # Test NO_META META.yml suppression 378 for my $f ( $meta_yml, $meta_json, 'MYMETA.yml', 'MYMETA.json' ) { 379 1 while unlink $f; 380 } 381 ok( !-f $meta_yml, 'META.yml deleted' ); 382 ok( !-f 'MYMETA.yml','MYMETA.yml deleted' ); 383 ok( !-f $meta_json, 'META.json deleted' ); 384 ok( !-f 'MYMETA.json','MYMETA.json deleted' ); 385 386 @mpl_out = run(qq{$perl Makefile.PL "NO_META=1"}); 387 ok( -f 'MYMETA.yml', 'MYMETA.yml generation not suppressed by NO_META' ); 388 ok( -f 'MYMETA.json', 'MYMETA.json generation not suppressed by NO_META' ); 389 cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out); 390 ok( !-f $meta_yml, 'META.yml generation suppressed by NO_META' ); 391 ok( !-f $meta_json, 'META.json generation suppressed by NO_META' ); 392 my $distdir_out = run("$make distdir"); 393 is( $?, 0, 'distdir' ) || diag($distdir_out); 394 ok( !-f $meta_yml, 'META.yml generation suppressed by NO_META' ); 395 ok( !-f $meta_json, 'META.json generation suppressed by NO_META' ); 396 397 for my $f ( 'MYMETA.yml', 'MYMETA.json' ) { 398 1 while unlink $f; 399 } 400 ok( !-f 'MYMETA.yml','MYMETA.yml deleted' ); 401 ok( !-f 'MYMETA.json','MYMETA.json deleted' ); 402 403 @mpl_out = run(qq{$perl Makefile.PL "NO_MYMETA=1"}); 404 cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out); 405 $distdir_out = run("$make distdir"); 406 is( $?, 0, 'distdir' ) || diag($distdir_out); 407 ok( !-f 'MYMETA.yml','MYMETA.yml generation suppressed by NO_MYMETA' ); 408 ok( !-f 'MYMETA.json','MYMETA.json generation suppressed by NO_MYMETA' ); 409 ok( -f $meta_yml, 'META.yml generation not suppressed by NO_MYMETA' ); 410 ok( -f $meta_json, 'META.json generation not suppressed by NO_MYMETA' ); 411 412 # Test MYMETA really comes from META except for prereqs 413 for my $f ( $meta_yml, $meta_json, 'MYMETA.yml', 'MYMETA.json' ) { 414 1 while unlink $f; 415 } 416 @mpl_out = run(qq{$perl Makefile.PL}); 417 cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out); 418 $distdir_out = run("$make distdir"); 419 is( $?, 0, 'distdir' ) || diag($distdir_out); 420 ok( -f $meta_yml, 'META.yml generated in distdir' ); 421 ok( -f $meta_json, 'META.json generated in distdir' ); 422 ok( ! -f $mymeta_yml, 'MYMETA.yml not yet generated in distdir' ); 423 ok( ! -f $mymeta_json, 'MYMETA.json generated in distdir' ); 424 my $edit_meta = CPAN::Meta->load_file($meta_json)->as_struct; 425 $edit_meta->{abstract} = "New abstract"; 426 my $meta_obj = CPAN::Meta->new($edit_meta); 427 is( $meta_obj->abstract, "New abstract", "MYMETA abstract from META, not Makefile.PL"); 428 ok( $meta_obj->save($meta_json), "Saved edited META.json in distdir" ); 429 ok( $meta_obj->save($meta_yml, {version => 1.4}), "Saved edited META.yml in distdir"); 430 ok( chdir $distdir ); 431 ok( -f 'META.yml', 'META.yml confirmed in distdir' ); 432 ok( -f 'META.json', 'META.json confirmed in distdir' ); 433 @mpl_out = run(qq{$perl Makefile.PL}); 434 cmp_ok( $?, '==', 0, 'Makefile.PL in distdir exited with zero' ) || diag(@mpl_out); 435 ok( chdir File::Spec->updir ); 436 ok( -f $mymeta_yml, 'MYMETA.yml generated in distdir' ); 437 ok( -f $mymeta_json, 'MYMETA.json generated in distdir' ); 438 $meta_obj = CPAN::Meta->load_file($meta_json); 439 is( $meta_obj->abstract, "New abstract", "META abstract is same as was saved"); 440 $meta_obj = CPAN::Meta->load_file($mymeta_json); 441 is( $meta_obj->abstract, "New abstract", "MYMETA abstract from META, not Makefile.PL"); 442} 443 444 445# Make sure init_dirscan doesn't go into the distdir 446# also with a "messup.PL" that will make a build fail 447open $fh, '>', 'messup.PL' or die "messup.PL: $!"; 448print $fh 'print "Extracting messup (with variable substitutions)\n";' . "\n"; 449print $fh 'die'; 450close $fh; 451@mpl_out = run(qq{$perl Makefile.PL "PREFIX=$DUMMYINST"}); 452 453cmp_ok( $?, '==', 0, 'Makefile.PL exited with zero' ) || diag(@mpl_out); 454 455ok( grep(/^Writing $makefile for Big::Dummy/, @mpl_out) == 1, 456 'init_dirscan skipped distdir') || 457 diag(@mpl_out); 458 459# "make test" straight after "perl Makefile.PL" is expected to work same as 460# "make all test" so check that with "messup.PL" that will make the 461# build step fail 462$test_out = run("$make test"); 463unlike( $test_out, qr/All tests successful/, 'make test caused build' ); 464isnt( $?, 0, ' build should fail' ) || 465 diag $test_out; 466 467# I know we'll get ignored errors from make here, that's ok. 468# Send STDERR off to oblivion. 469open(SAVERR, ">&STDERR") or die $!; 470open(STDERR, ">",File::Spec->devnull) or die $!; 471 472my $realclean_out = run("$make realclean"); 473is( $?, 0, 'realclean' ) || diag($realclean_out); 4741 while unlink 'messup.PL'; # also zap deliberate build-breaker 475 476open(STDERR, ">&SAVERR") or die $!; 477close SAVERR; 478 479# test linkext=>{LINKTYPE=>''} still installs a pure-perl installation 480# warning, edits the Makefile.PL so either rewrite after this or do this last 481my $file = 'Makefile.PL'; 482my $text = slurp $file; 483ok(($text =~ s#\);# linkext=>{LINKTYPE=>''},\n$&#), 'successful M.PL edit'); 484open $fh, '>', $file or die "$file: $!"; 485print $fh $text; 486close $fh; 487# now do with "Liar" subdir still there 488rmtree $DUMMYINST; # so no false positive from before 489@mpl_out = run(qq{$perl Makefile.PL "PREFIX=$DUMMYINST"}); 490$install_out = run("$make install"); 491check_dummy_inst($DUMMYINST); 492# now clean, delete "Liar" subdir, do again 493$realclean_out = run("$make realclean"); 494rmtree 'Liar'; 495rmtree $DUMMYINST; # so no false positive from before 496@mpl_out = run(qq{$perl Makefile.PL "PREFIX=$DUMMYINST"}); 497$install_out = run("$make install"); 498check_dummy_inst($DUMMYINST, 1); 499 500sub _normalize { 501 my $hash = shift; 502 503 %$hash= map { lc($_) => $hash->{$_} } keys %$hash; 504} 505