1#!/usr/bin/env perl 2# -*-perl-*- 3 4# Test driver for the Make test suite 5 6# Usage: run_make_tests [testname] 7# [-debug] 8# [-help] 9# [-verbose] 10# [-keep] 11# [-make <make prog>] 12# (and others) 13 14# Copyright (C) 1992-2020 Free Software Foundation, Inc. 15# This file is part of GNU Make. 16# 17# GNU Make is free software; you can redistribute it and/or modify it under 18# the terms of the GNU General Public License as published by the Free Software 19# Foundation; either version 3 of the License, or (at your option) any later 20# version. 21# 22# GNU Make is distributed in the hope that it will be useful, but WITHOUT ANY 23# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 24# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 25# details. 26# 27# You should have received a copy of the GNU General Public License along with 28# this program. If not, see <http://www.gnu.org/licenses/>. 29 30# Add the working directory to @INC and load the test driver 31use FindBin; 32use lib "$FindBin::Bin"; 33 34our $testsroot = $FindBin::Bin; 35 36require "test_driver.pl"; 37 38use File::Spec; 39 40use Cwd; 41$cwdpath = cwd(); 42($cwdvol, $cwddir, $_) = File::Spec->splitpath($cwdpath, 1); 43 44# Some target systems might not have the POSIX module... 45$has_POSIX = eval { require "POSIX.pm" }; 46 47%FEATURES = (); 48 49$valgrind = 0; # invoke make with valgrind 50$valgrind_args = ''; 51$memcheck_args = '--num-callers=15 --tool=memcheck --leak-check=full --suppressions=guile.supp'; 52$massif_args = '--num-callers=15 --tool=massif --alloc-fn=xmalloc --alloc-fn=xcalloc --alloc-fn=xrealloc --alloc-fn=xstrdup --alloc-fn=xstrndup'; 53$pure_log = undef; 54 55# The location of the GNU make source directory 56$srcdir = undef; 57$fqsrcdir = undef; 58$srcvol = undef; 59 60# The location of the build directory 61$blddir = undef; 62$fqblddir = undef; 63$bldvol = undef; 64 65$make_path = undef; 66@make_command = (); 67 68$command_string = ''; 69 70$all_tests = 0; 71 72# Shell commands 73 74$sh_name = '/bin/sh'; 75$is_posix_sh = 1; 76 77$CMD_rmfile = 'rm -f'; 78 79# rmdir broken in some Perls on VMS. 80if ($^O eq 'VMS') 81{ 82 require VMS::Filespec; 83 VMS::Filespec->import(); 84 85 sub vms_rmdir { 86 my $vms_file = vmspath($_[0]); 87 $vms_file = fileify($vms_file); 88 my $ret = unlink(vmsify($vms_file)); 89 return $ret 90 }; 91 92 *CORE::GLOBAL::rmdir = \&vms_rmdir; 93 94 $CMD_rmfile = 'delete_file -no_ask'; 95} 96 97%CONFIG_FLAGS = (); 98 99# Find the strings that will be generated for various error codes. 100# We want them from the C locale regardless of our current locale. 101 102$ERR_no_such_file = undef; 103$ERR_read_only_file = undef; 104$ERR_unreadable_file = undef; 105$ERR_nonexe_file = undef; 106$ERR_exe_dir = undef; 107 108{ 109 use locale; 110 111 my $loc = undef; 112 if ($has_POSIX) { 113 POSIX->import(qw(locale_h)); 114 # Windows has POSIX locale, but only LC_ALL not LC_MESSAGES 115 $loc = POSIX::setlocale(&POSIX::LC_ALL); 116 POSIX::setlocale(&POSIX::LC_ALL, 'C'); 117 } 118 119 if (open(my $F, '<', 'file.none')) { 120 print "Opened non-existent file! Skipping related tests.\n"; 121 } else { 122 $ERR_no_such_file = "$!"; 123 } 124 125 unlink('file.out'); 126 touch('file.out'); 127 128 chmod(0444, 'file.out'); 129 if (open(my $F, '>', 'file.out')) { 130 print "Opened read-only file! Skipping related tests.\n"; 131 close($F); 132 } else { 133 $ERR_read_only_file = "$!"; 134 } 135 136 $_ = `./file.out 2>/dev/null`; 137 if ($? == 0) { 138 print "Executed non-executable file! Skipping related tests.\n"; 139 } else { 140 $ERR_nonexe_file = "$!"; 141 } 142 143 $_ = `./. 2>/dev/null`; 144 if ($? == 0) { 145 print "Executed directory! Skipping related tests.\n"; 146 } else { 147 $ERR_exe_dir = "$!"; 148 } 149 150 chmod(0000, 'file.out'); 151 if (open(my $F, '<', 'file.out')) { 152 print "Opened unreadable file! Skipping related tests.\n"; 153 close($F); 154 } else { 155 $ERR_unreadable_file = "$!"; 156 } 157 158 unlink('file.out') or die "Failed to delete file.out: $!\n"; 159 160 $loc and POSIX::setlocale(&POSIX::LC_ALL, $loc); 161} 162 163#$SIG{INT} = sub { print STDERR "Caught a signal!\n"; die @_; }; 164 165sub valid_option 166{ 167 local($option) = @_; 168 169 if ($option =~ /^-make([-_]?path)?$/i) { 170 $make_path = shift @argv; 171 if (!-f $make_path) { 172 print "$option $make_path: Not found.\n"; 173 exit 0; 174 } 175 return 1; 176 } 177 178 if ($option =~ /^-srcdir$/i) { 179 $srcdir = shift @argv; 180 if (! -f File::Spec->catfile($srcdir, 'src', 'gnumake.h')) { 181 print "$option $srcdir: Not a valid GNU make source directory.\n"; 182 exit 0; 183 } 184 return 1; 185 } 186 187 if ($option =~ /^-all([-_]?tests)?$/i) { 188 $all_tests = 1; 189 return 1; 190 } 191 192 if ($option =~ /^-(valgrind|memcheck)$/i) { 193 $valgrind = 1; 194 $valgrind_args = $memcheck_args; 195 return 1; 196 } 197 198 if ($option =~ /^-massif$/i) { 199 $valgrind = 1; 200 $valgrind_args = $massif_args; 201 return 1; 202 } 203 204# This doesn't work--it _should_! Someone badly needs to fix this. 205# 206# elsif ($option =~ /^-work([-_]?dir)?$/) 207# { 208# $workdir = shift @argv; 209# return 1; 210# } 211 212 return 0; 213} 214 215 216# This is an "all-in-one" function. Arguments are as follows: 217# 218# [0] (string): The makefile to be tested. undef means use the last one. 219# [1] (string): Arguments to pass to make. 220# [2] (string): Answer we should get back. 221# [3] (integer): Exit code we expect. A missing code means 0 (success) 222 223$makefile = undef; 224$old_makefile = undef; 225$mkpath = undef; 226$make_name = undef; 227$helptool = undef; 228 229sub subst_make_string 230{ 231 local $_ = shift; 232 $makefile and s/#MAKEFILE#/$makefile/g; 233 s/#MAKEPATH#/$mkpath/g; 234 s/#MAKE#/$make_name/g; 235 s/#PERL#/$perl_name/g; 236 s/#PWD#/$cwdpath/g; 237 # If we're using a shell 238 s/#HELPER#/$perl_name $helptool/g; 239 return $_; 240} 241 242sub run_make_test 243{ 244 local ($makestring, $options, $answer, $err_code, $timeout) = @_; 245 my @call = caller; 246 247 # If the user specified a makefile string, create a new makefile to contain 248 # it. If the first value is not defined, use the last one (if there is 249 # one). 250 251 if (! defined $makestring) { 252 defined $old_makefile 253 or die "run_make_test(undef) invoked before run_make_test('...')\n"; 254 $makefile = $old_makefile; 255 } else { 256 if (! defined($makefile)) { 257 $makefile = &get_tmpfile(); 258 } 259 260 # Make sure it ends in a newline and substitute any special tokens. 261 $makestring && $makestring !~ /\n$/s and $makestring .= "\n"; 262 $makestring = subst_make_string($makestring); 263 264 # Populate the makefile! 265 open(MAKEFILE, "> $makefile") or die "Failed to open $makefile: $!\n"; 266 print MAKEFILE $makestring; 267 close(MAKEFILE) or die "Failed to write $makefile: $!\n"; 268 } 269 270 # Do the same processing on $answer as we did on $makestring. 271 if (defined $answer) { 272 $answer && $answer !~ /\n$/s and $answer .= "\n"; 273 $answer = subst_make_string($answer); 274 } 275 276 run_make_with_options($makefile, $options, &get_logfile(0), 277 $err_code, $timeout, @call); 278 &compare_output($answer, &get_logfile(1)); 279 280 $old_makefile = $makefile; 281 $makefile = undef; 282} 283 284sub add_options { 285 my $cmd = shift; 286 287 foreach (@_) { 288 if (ref($cmd)) { 289 push(@$cmd, ref($_) ? @$_ : $_); 290 } else { 291 $cmd .= ' '.(ref($_) ? "@$_" : $_); 292 } 293 } 294 295 return $cmd; 296} 297 298sub create_command { 299 return !$_[0] || ref($_[0]) ? [@make_command] : join(' ', @make_command); 300} 301 302# The old-fashioned way... 303# $options can be a scalar (string) or a ref to an array of options 304# If it's a scalar the entire argument is passed to system/exec etc. as 305# a single string. If it's a ref then the array is passed to system/exec. 306# Using a ref should be preferred as it's more portable but all the older 307# invocations use strings. 308sub run_make_with_options { 309 my ($filename,$options,$logname,$expected_code,$timeout,@call) = @_; 310 @call = caller unless @call; 311 my $code; 312 my $command = create_command($options); 313 314 $expected_code = 0 unless defined($expected_code); 315 316 # Reset to reflect this one test. 317 $test_passed = 1; 318 319 if ($filename) { 320 $command = add_options($command, '-f', $filename); 321 } 322 323 if ($options) { 324 if (!ref($options) && $^O eq 'VMS') { 325 # Try to make sure arguments are properly quoted. 326 # This does not handle all cases. 327 # We should convert the tests to use array refs not strings 328 329 # VMS uses double quotes instead of single quotes. 330 $options =~ s/\'/\"/g; 331 332 # If the leading quote is inside non-whitespace, then the 333 # quote must be doubled, because it will be enclosed in another 334 # set of quotes. 335 $options =~ s/(\S)(\".*\")/$1\"$2\"/g; 336 337 # Options must be quoted to preserve case if not already quoted. 338 $options =~ s/(\S+)/\"$1\"/g; 339 340 # Special fixup for embedded quotes. 341 $options =~ s/(\"\".+)\"(\s+)\"(.+\"\")/$1$2$3/g; 342 343 $options =~ s/(\A)(?:\"\")(.+)(?:\"\")/$1\"$2\"/g; 344 345 # Special fixup for misc/general4 test. 346 $options =~ s/""\@echo" "cc""/\@echo cc"/; 347 $options =~ s/"\@echo link"""/\@echo link"/; 348 349 # Remove shell escapes expected to be removed by bash 350 if ($options !~ /path=pre/) { 351 $options =~ s/\\//g; 352 } 353 354 # special fixup for options/eval 355 $options =~ s/"--eval=\$\(info" "eval/"--eval=\$\(info eval/; 356 357 print ("Options fixup = -$options-\n") if $debug; 358 } 359 360 $command = add_options($command, $options); 361 } 362 363 my $cmdstr = ref($command) ? "'".join("' '", @$command)."'" : $command; 364 365 if (@call) { 366 $command_string = "#$call[1]:$call[2]\n$cmdstr\n"; 367 } else { 368 $command_string = $cmdstr; 369 } 370 371 if ($valgrind) { 372 print VALGRIND "\n\nExecuting: $cmdstr\n"; 373 } 374 375 { 376 my $old_timeout = $test_timeout; 377 $timeout and $test_timeout = $timeout; 378 379 # If valgrind is enabled, turn off the timeout check 380 $valgrind and $test_timeout = 0; 381 382 if (ref($command)) { 383 $code = run_command_with_output($logname, @$command); 384 } else { 385 $code = run_command_with_output($logname, $command); 386 } 387 $test_timeout = $old_timeout; 388 } 389 390 # Check to see if we have Purify errors. If so, keep the logfile. 391 # For this to work you need to build with the Purify flag -exit-status=yes 392 393 if ($pure_log && -f $pure_log) { 394 if ($code & 0x7000) { 395 $code &= ~0x7000; 396 397 # If we have a purify log, save it 398 $tn = $pure_testname . ($num_of_logfiles ? ".$num_of_logfiles" : ""); 399 print("Renaming purify log file to $tn\n") if $debug; 400 rename($pure_log, "$tn") or die "Can't rename $pure_log to $tn: $!\n"; 401 ++$purify_errors; 402 } else { 403 unlink($pure_log); 404 } 405 } 406 407 if ($code != $expected_code) { 408 print "Error running @make_command (expected $expected_code; got $code): $cmdstr\n"; 409 $test_passed = 0; 410 &create_file (&get_runfile, $command_string); 411 # If it's a SIGINT, stop here 412 if ($code & 127) { 413 print STDERR "\nCaught signal ".($code & 127)."!\n"; 414 ($code & 127) == 2 and exit($code); 415 } 416 return 0; 417 } 418 419 if ($profile & $vos) { 420 system "add_profile @make_command"; 421 } 422 423 return 1; 424} 425 426sub print_usage 427{ 428 &print_standard_usage ("run_make_tests", 429 "[-make MAKE_PATHNAME] [-srcdir SRCDIR] [-memcheck] [-massif]",); 430} 431 432sub print_help 433{ 434 &print_standard_help ( 435 "-make", 436 "\tYou may specify the pathname of the copy of make to run.", 437 "-srcdir", 438 "\tSpecify the make source directory.", 439 "-valgrind", 440 "-memcheck", 441 "\tRun the test suite under valgrind's memcheck tool.", 442 "\tChange the default valgrind args with the VALGRIND_ARGS env var.", 443 "-massif", 444 "\tRun the test suite under valgrind's massif tool.", 445 "\tChange the default valgrind args with the VALGRIND_ARGS env var." 446 ); 447} 448 449sub set_defaults 450{ 451 # $profile = 1; 452 $testee = "GNU make"; 453 $make_path = "make"; 454 $tmpfilesuffix = "mk"; 455 if ($port_type eq 'UNIX') { 456 $scriptsuffix = '.sh'; 457 } elsif ($port_type eq 'VMS') { 458 $scriptsuffix = '.com'; 459 } else { 460 $scriptsuffix = '.bat'; 461 } 462} 463 464# This is no longer used: we import config-flags.pm instead 465# sub parse_status 466# { 467# if (open(my $fh, '<', "$_[0]/config.status")) { 468# while (my $line = <$fh>) { 469# $line =~ m/^[SD]\["([^\"]+)"\]=" *(.*)"/ and $CONFIG_FLAGS{$1} = $2; 470# } 471# return 1; 472# } 473# return 0; 474# } 475 476sub find_prog 477{ 478 my $prog = $_[0]; 479 my ($v, $d, $f) = File::Spec->splitpath($prog); 480 481 # If there's no directory then we need to search the PATH 482 if (! $d) { 483 foreach my $e (File::Spec->path()) { 484 $prog = File::Spec->catfile($e, $f); 485 if (-x $prog) { 486 ($v, $d, $f) = File::Spec->splitpath($prog); 487 last; 488 } 489 } 490 } 491 492 return ($v, $d, $f); 493} 494 495sub get_config 496{ 497 return exists($CONFIG_FLAGS{$_[0]}) ? $CONFIG_FLAGS{$_[0]} : ''; 498} 499 500sub set_more_defaults 501{ 502 my $string; 503 504 # Now that we have located make_path, locate the srcdir and blddir 505 my ($mpv, $mpd, $mpf) = find_prog($make_path); 506 507 # We have a make program so try to compute the blddir. 508 if ($mpd) { 509 my $f = File::Spec->catpath($mpv, File::Spec->catdir($mpd, 'tests'), 'config-flags.pm'); 510 if (-f $f) { 511 $bldvol = $mpv; 512 $blddir = $mpd; 513 } 514 } 515 516 # If srcdir wasn't provided on the command line, try to find it. 517 if (! $srcdir && $blddir) { 518 # See if the blddir is the srcdir 519 my $f = File::Spec->catpath($bldvol, File::Spec->catdir($blddir, 'src'), 'gnumake.h'); 520 if (-f $f) { 521 $srcdir = $blddir; 522 $srcvol = $bldvol; 523 } 524 } 525 526 if (! $srcdir) { 527 # Not found, see if our parent is the source dir 528 my $f = File::Spec->catpath($cwdvol, File::Spec->catdir(File::Spec->updir(), 'src'), 'gnumake.h'); 529 if (-f $f) { 530 $srcdir = File::Spec->updir(); 531 $srcvol = $cwdvol; 532 } 533 } 534 535 # If we have srcdir but not blddir, set them equal 536 if ($srcdir && !$blddir) { 537 $blddir = $srcdir; 538 $bldvol = $srcvol; 539 } 540 541 # Load the config flags 542 if (!$blddir) { 543 warn "Cannot locate config-flags.pm (no blddir)\n"; 544 } else { 545 my $f = File::Spec->catpath($bldvol, File::Spec->catdir($blddir, 'tests'), 'config-flags.pm'); 546 if (! -f $f) { 547 warn "Cannot locate $f\n"; 548 } else { 549 unshift(@INC, File::Spec->catpath($bldvol, File::Spec->catdir($blddir, 'tests'), '')); 550 require "config-flags.pm"; 551 } 552 } 553 554 # Find the full pathname of Make. For DOS systems this is more 555 # complicated, so we ask make itself. 556 if ($osname eq 'VMS') { 557 $port_type = 'VMS-DCL' unless defined $ENV{"SHELL"}; 558 # On VMS pre-setup make to be found with simply 'make'. 559 $make_path = 'make'; 560 } else { 561 create_file('make.mk', 'all:;$(info $(MAKE))'); 562 my $mk = `$make_path -sf make.mk`; 563 unlink('make.mk'); 564 chop $mk; 565 $mk or die "FATAL ERROR: Cannot determine the value of \$(MAKE)\n"; 566 $make_path = $mk; 567 } 568 ($mpv, $mpd, $mpf) = File::Spec->splitpath($make_path); 569 570 # Ask make what shell to use 571 create_file('shell.mk', 'all:;$(info $(SHELL))'); 572 $sh_name = `$make_path -sf shell.mk`; 573 unlink('shell.mk'); 574 chop $sh_name; 575 if (! $sh_name) { 576 print "Cannot determine shell\n"; 577 $is_posix_sh = 0; 578 } else { 579 my $o = `$sh_name -c ': do nothing' 2>&1`; 580 $is_posix_sh = $? == 0 && $o eq ''; 581 } 582 583 $string = `$make_path -v`; 584 $string =~ /^(GNU Make [^,\n]*)/ or die "$make_path is not GNU make. Version:\n$string"; 585 $testee_version = "$1\n"; 586 587 create_file('null.mk', ''); 588 589 my $redir = '2>&1'; 590 $redir = '' if os_name eq 'VMS'; 591 $string = `$make_path -f null.mk $redir`; 592 if ($string =~ /(.*): \*\*\* No targets\. Stop\./) { 593 $make_name = $1; 594 } else { 595 $make_name = $mpf; 596 } 597 598 # prepend pwd if this is a relative path (ie, does not 599 # start with a slash, but contains one). Thanks for the 600 # clue, Roland. 601 602 if ($mpd && !File::Spec->file_name_is_absolute($make_path) && $cwdvol == $mpv) { 603 $mkpath = File::Spec->catpath($cwdvol, File::Spec->catdir($cwd, $mpd), $mpf); 604 } else { 605 $mkpath = $make_path; 606 } 607 608 # Not with the make program, so see if we can get it out of the makefile 609 if (! $srcdir && open(MF, '<', File::Spec->catfile(File::Spec->updir(), 'Makefile'))) { 610 local $/ = undef; 611 $_ = <MF>; 612 close(MF); 613 /^abs_srcdir\s*=\s*(.*?)\s*$/m; 614 -f File::Spec->catfile($1, 'src', 'gnumake.h') and $srcdir = $1; 615 } 616 617 # At this point we should have srcdir and blddir: get fq versions 618 $fqsrcdir = File::Spec->rel2abs($srcdir); 619 $fqblddir = File::Spec->rel2abs($blddir); 620 621 # Find the helper tool 622 $helptool = File::Spec->catfile($fqsrcdir, 'tests', 'thelp.pl'); 623 624 # It's difficult to quote this properly in all the places it's used so 625 # ensure it doesn't need to be quoted. 626 $helptool =~ s,\\,/,g if $port_type eq 'W32'; 627 $helptool =~ s, ,\\ ,g; 628 629 # Get Purify log info--if any. 630 631 if (exists $ENV{PURIFYOPTIONS} 632 && $ENV{PURIFYOPTIONS} =~ /.*-logfile=([^ ]+)/) { 633 $pure_log = $1 || ''; 634 $pure_log =~ s/%v/$make_name/; 635 $purify_errors = 0; 636 } 637 638 $string = `$make_path -j 2 -f null.mk $redir`; 639 if ($string =~ /not supported/) { 640 $parallel_jobs = 0; 641 } 642 else { 643 $parallel_jobs = 1; 644 } 645 646 unlink('null.mk'); 647 648 create_file('features.mk', 'all:;$(info $(.FEATURES))'); 649 %FEATURES = map { $_ => 1 } split /\s+/, `$make_path -sf features.mk`; 650 unlink('features.mk'); 651 652 # Set up for valgrind, if requested. 653 654 @make_command = ($make_path); 655 656 if ($valgrind) { 657 my $args = $valgrind_args; 658 open(VALGRIND, "> valgrind.out") or die "Cannot open valgrind.out: $!\n"; 659 # -q --leak-check=yes 660 exists $ENV{VALGRIND_ARGS} and $args = $ENV{VALGRIND_ARGS}; 661 @make_command = ('valgrind', '--log-fd='.fileno(VALGRIND)); 662 push(@make_command, split(' ', $args)); 663 push(@make_command, $make_path); 664 # F_SETFD is 2 665 fcntl(VALGRIND, 2, 0) or die "fcntl(setfd) failed: $!\n"; 666 system("echo Starting on `date` 1>&".fileno(VALGRIND)); 667 print "Enabled valgrind support.\n"; 668 } 669 670 if ($debug) { 671 print "Port type: $port_type\n"; 672 print "Make command: @make_command\n"; 673 print "Shell path: $sh_name".($is_posix_sh ? ' (POSIX)' : '')."\n"; 674 print "#PWD#: $cwdpath\n"; 675 print "#PERL#: $perl_name\n"; 676 print "#MAKEPATH#: $mkpath\n"; 677 print "#MAKE#: $make_name\n"; 678 } 679} 680 681sub setup_for_test 682{ 683 $makefile = &get_tmpfile; 684 if (-f $makefile) { 685 unlink $makefile; 686 } 687 688 # Get rid of any Purify logs. 689 if ($pure_log) { 690 ($pure_testname = $testname) =~ tr,/,_,; 691 $pure_testname = "$pure_log.$pure_testname"; 692 system("rm -f $pure_testname*"); 693 print("Purify testfiles are: $pure_testname*\n") if $debug; 694 } 695} 696 697exit !&toplevel; 698