make/tests/run_make_tests.pl

#!/usr/bin/env perl
# -*-perl-*-

# Test driver for the Make test suite

# Usage:  run_make_tests  [testname]
#                         [-debug]
#                         [-help]
#                         [-verbose]
#                         [-keep]
#                         [-make <make prog>]
#                        (and others)

# Copyright (C) 1992-2023 Free Software Foundation, Inc.
# This file is part of GNU Make.
#
# GNU Make is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3 of the License, or (at your option) any later
# version.
#
# GNU Make is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# this program.  If not, see <https://www.gnu.org/licenses/>.

# Add the working directory to @INC and load the test driver
use FindBin;
use lib "$FindBin::Bin";

our $testsroot = $FindBin::Bin;

require "test_driver.pl";

use File::Spec;

use Cwd;
$cwdpath = cwd();
($cwdvol, $cwddir, $_) = File::Spec->splitpath($cwdpath, 1);

# Some target systems might not have the POSIX module...
$has_POSIX = eval { require "POSIX.pm" };

%FEATURES = ();
%DEFVARS = (
    AR => undef,
    CC => undef
);

$valgrind = 0;              # invoke make with valgrind
$valgrind_args = '';
$memcheck_args = '--num-callers=15 --tool=memcheck --leak-check=full --suppressions=guile.supp';
$massif_args = '--num-callers=15 --tool=massif --alloc-fn=xmalloc --alloc-fn=xcalloc --alloc-fn=xrealloc --alloc-fn=xstrdup --alloc-fn=xstrndup';
$pure_log = undef;

$make_path = undef;
@make_command = ();

$command_string = '';

$all_tests = 0;

# Shell commands

$sh_name = '/bin/sh';
$is_posix_sh = 1;

$CMD_rmfile = 'rm -f';

# rmdir broken in some Perls on VMS.
if ($^O eq 'VMS')
{
  require VMS::Filespec;
  VMS::Filespec->import();

  sub vms_rmdir {
    my $vms_file = vmspath($_[0]);
    $vms_file = fileify($vms_file);
    my $ret = unlink(vmsify($vms_file));
    return $ret
  };

  *CORE::GLOBAL::rmdir = \&vms_rmdir;

  $CMD_rmfile = 'delete_file -no_ask';
}

%CONFIG_FLAGS = ();

# Find the strings that will be generated for various error codes.
# We want them from the C locale regardless of our current locale.

$ERR_no_such_file = undef;
$ERR_no_such_file_code = "2";
$ERR_read_only_file = undef;
$ERR_unreadable_file = undef;
$ERR_nonexe_file = undef;
$ERR_exe_dir = undef;
$ERR_command_not_found = undef;

#$SIG{INT} = sub { print STDERR "Caught a signal!\n"; die @_; };

sub valid_option
{
   local($option) = @_;

   if ($option =~ /^-make([-_]?path)?$/i) {
       $make_path = shift @argv;
       if (! -f $make_path) {
           print "$option $make_path: Not found.\n";
           exit 1;
       }
       return 1;
   }

   if ($option =~ /^-all([-_]?tests)?$/i) {
       $all_tests = 1;
       return 1;
   }

   if ($option =~ /^-(valgrind|memcheck)$/i) {
       $valgrind = 1;
       $valgrind_args = $memcheck_args;
       return 1;
   }

   if ($option =~ /^-massif$/i) {
       $valgrind = 1;
       $valgrind_args = $massif_args;
       return 1;
   }

# This doesn't work--it _should_!  Someone badly needs to fix this.
#
#   elsif ($option =~ /^-work([-_]?dir)?$/)
#   {
#      $workdir = shift @argv;
#      return 1;
#   }

   return 0;
}


# This is an "all-in-one" function.  Arguments are as follows:
#
#  [0] (string):  The makefile to be tested.  undef means use the last one.
#  [1] (string):  Arguments to pass to make.
#  [2] (string):  Answer we should get back.
#  [3] (integer): Exit code we expect.  A missing code means 0 (success)

$makefile = undef;
$old_makefile = undef;
$mkpath = undef;
$make_name = undef;
$helptool = undef;

sub subst_make_string
{
    my $wd = cwd();
    local $_ = shift;
    $makefile and s/#MAKEFILE#/$makefile/g;
    s/#MAKEPATH#/$mkpath/g;
    s/#MAKE#/$make_name/g;
    s/#PERL#/$perl_name/g;
    s/#PWD#/$wd/g;
    s/#HELPER#/$perl_name $helptool/g;
    return $_;
}

sub run_make_test
{
  local ($makestring, $options, $answer, $err_code, $timeout) = @_;
  my @call = caller;

  # If the user specified a makefile string, create a new makefile to contain
  # it.  If the first value is not defined, use the last one (if there is
  # one).

  if (! defined $makestring) {
    defined $old_makefile
      or die "run_make_test(undef) invoked before run_make_test('...')\n";
    $makefile = $old_makefile;
  } elsif ($makestring) {
    if (! defined($makefile)) {
      $makefile = &get_tmpfile();
    }

    # Make sure it ends in a newline and substitute any special tokens.
    $makestring && $makestring !~ /\n$/s and $makestring .= "\n";
    $makestring = subst_make_string($makestring);

    # Populate the makefile!
    open(MAKEFILE, "> $makefile") or die "Failed to open $makefile: $!\n";
    print MAKEFILE $makestring;
    close(MAKEFILE) or die "Failed to write $makefile: $!\n";
  }

  # Do the same processing on $answer as we did on $makestring.
  if (defined $answer) {
      $answer && $answer !~ /\n$/s and $answer .= "\n";
      $answer = subst_make_string($answer);
  }

  run_make_with_options($makefile, $options, &get_logfile(0),
                        $err_code, $timeout, @call);
  &compare_output($answer, &get_logfile(1));

  $old_makefile = $makefile;
  $makefile = undef;
}

sub add_options {
  my $cmd = shift;

  foreach (@_) {
    if (ref($cmd)) {
      push(@$cmd, ref($_) ? @$_ : $_);
    } else {
      $cmd .= ' '.(ref($_) ? "@$_" : $_);
    }
  }

  return $cmd;
}

sub create_command {
  return !$_[0] || ref($_[0]) ? [@make_command] : join(' ', @make_command);
}

# The old-fashioned way...
# $options can be a scalar (string) or a ref to an array of options
# If it's a scalar the entire argument is passed to system/exec etc. as
# a single string.  If it's a ref then the array is passed to system/exec.
# Using a ref should be preferred as it's more portable but all the older
# invocations use strings.
sub run_make_with_options {
  my ($filename, $options, $logname, $expected_code, $timeout, @call) = @_;
  @call = caller unless @call;
  my $code;
  my $command = create_command($options);

  $expected_code = 0 unless defined($expected_code);

  # Reset to reflect this one test.
  $test_passed = 1;

  if ($filename) {
    $command = add_options($command, '-f', $filename);
  }

  if ($options) {
    if (!ref($options) && $^O eq 'VMS') {
      # Try to make sure arguments are properly quoted.
      # This does not handle all cases.
      # We should convert the tests to use array refs not strings

      # VMS uses double quotes instead of single quotes.
      $options =~ s/\'/\"/g;

      # If the leading quote is inside non-whitespace, then the
      # quote must be doubled, because it will be enclosed in another
      # set of quotes.
      $options =~ s/(\S)(\".*\")/$1\"$2\"/g;

      # Options must be quoted to preserve case if not already quoted.
      $options =~ s/(\S+)/\"$1\"/g;

      # Special fixup for embedded quotes.
      $options =~ s/(\"\".+)\"(\s+)\"(.+\"\")/$1$2$3/g;

      $options =~ s/(\A)(?:\"\")(.+)(?:\"\")/$1\"$2\"/g;

      # Special fixup for misc/general4 test.
      $options =~ s/""\@echo" "cc""/\@echo cc"/;
      $options =~ s/"\@echo link"""/\@echo link"/;

      # Remove shell escapes expected to be removed by bash
      if ($options !~ /path=pre/) {
        $options =~ s/\\//g;
      }

      # special fixup for options/eval
      $options =~ s/"--eval=\$\(info" "eval/"--eval=\$\(info eval/;

      print ("Options fixup = -$options-\n") if $debug;
    }

    $command = add_options($command, $options);
  }

  my $cmdstr = cmd2str($command);
  $command_string = "# $call[1]:$call[2]:\n$cmdstr\n";

  if ($valgrind) {
    print VALGRIND "\n\nExecuting: $cmdstr\n";
  }

  {
      my $old_timeout = $test_timeout;
      $timeout and $test_timeout = $timeout;

      # If valgrind is enabled, turn off the timeout check
      $valgrind and $test_timeout = 0;

      if (ref($command)) {
          $code = run_command_with_output($logname, @$command);
      } else {
          $code = run_command_with_output($logname, $command);
      }
      $test_timeout = $old_timeout;
  }

  # Check to see if we have Purify errors.  If so, keep the logfile.
  # For this to work you need to build with the Purify flag -exit-status=yes

  if ($pure_log && -f $pure_log) {
    if ($code & 0x7000) {
      $code &= ~0x7000;

      # If we have a purify log, save it
      $tn = $pure_testname . ($num_of_logfiles ? ".$num_of_logfiles" : "");
      print("Renaming purify log file to $tn\n") if $debug;
      rename($pure_log, "$tn") or die "Can't rename $pure_log to $tn: $!\n";
      ++$purify_errors;
    } else {
      unlink($pure_log);
    }
  }

  if ($code != $expected_code) {
    print "Error running @make_command (expected $expected_code; got $code)\n$call[1]:$call[2]: $cmdstr\n";
    $test_passed = 0;
    &create_file(get_runfile(), $command_string);
    # If it's a SIGINT, stop here
    if ($code & 127) {
      print STDERR "\nCaught signal ".($code & 127)."!\n";
      ($code & 127) == 2 and exit($code);
    }
    return 0;
  }

  if ($profile & $vos) {
    system "add_profile @make_command";
  }

  return 1;
}

sub print_usage
{
   &print_standard_usage ("run_make_tests",
                          "[-make MAKE_PATHNAME] [-memcheck] [-massif]",);
}

sub print_help
{
   &print_standard_help (
        "-make",
        "\tYou may specify the pathname of the copy of make to run.",
        "-valgrind",
        "-memcheck",
        "\tRun the test suite under valgrind's memcheck tool.",
        "\tChange the default valgrind args with the VALGRIND_ARGS env var.",
        "-massif",
        "\tRun the test suite under valgrind's massif tool.",
        "\tChange the default valgrind args with the VALGRIND_ARGS env var."
       );
}

sub set_defaults
{
  # $profile = 1;
  $testee = "GNU Make";
  $make_path = "make";
  $tmpfilesuffix = "mk";
  if ($port_type eq 'UNIX') {
    $scriptsuffix = '.sh';
  } elsif ($port_type eq 'VMS') {
    $scriptsuffix = '.com';
  } else {
    $scriptsuffix = '.bat';
  }

  $ENV{LC_ALL} = $makeENV{LC_ALL};
  $ENV{LANG} = $makeENV{LANG};
  $ENV{LANGUAGE} = $makeENV{LANGUAGE};

  use locale;

  my $loc = undef;
  if ($has_POSIX) {
      POSIX->import(qw(locale_h));
      # Windows has POSIX locale, but only LC_ALL not LC_MESSAGES
      $loc = POSIX::setlocale(&POSIX::LC_ALL);
      POSIX::setlocale(&POSIX::LC_ALL, 'C');
  }

  if (open(my $F, '<', 'file.none')) {
      print "Opened non-existent file! Skipping related tests.\n";
  } else {
      $ERR_no_such_file = "$!";
      if ($osname eq 'os390') {
          $ERR_no_such_file_code = "129";
      }
  }

  unlink('file.out');
  touch('file.out');

  chmod(0444, 'file.out');
  if (open(my $F, '>', 'file.out')) {
      print "Opened read-only file! Skipping related tests.\n";
      close($F);
  } else {
      $ERR_read_only_file = "$!";
  }

  $_ = `./file.out 2>&1`;
  if ($? == 0) {
      print "Executed non-executable file!  Skipping related tests.\n";
  } else {
      $ERR_nonexe_file = "$!";
  }

  if ($^O =~ /cygwin/i) {
      # For some reason the execute here gives a different answer than make's
      print "Skipping directory execution on $^O\n";
  } else {
      $_ = `./. 2>&1`;
      if ($? == 0) {
          print "Executed directory!  Skipping related tests.\n";
      } else {
          $ERR_exe_dir = "$!";
      }
  }

  chmod(0000, 'file.out');
  if (open(my $F, '<', 'file.out')) {
      print "Opened unreadable file!  Skipping related tests.\n";
      close($F);
  } else {
      $ERR_unreadable_file = "$!";
  }

  unlink('file.out') or die "Failed to delete file.out: $!\n";

  $_ = `/bin/sh -c 'bad-command 2>&1'`;
  if ($? == 0) {
      print "Invoked invalid file!  Skipping related tests.\n";
  } else {
      s/\r?\n//g;
      s/bad-command/#CMDNAME#/g;
      $ERR_command_not_found = $_;
  }

  $loc and POSIX::setlocale(&POSIX::LC_ALL, $loc);

  $ENV{LC_ALL} = $origENV{LC_ALL};
  $ENV{LANG} = $origENV{LANG};
  $ENV{LANGUAGE} = $origENV{LANGUAGE};
}

# This is no longer used: we import config-flags.pm instead
# sub parse_status
# {
#   if (open(my $fh, '<', "$_[0]/config.status")) {
#     while (my $line = <$fh>) {
#       $line =~ m/^[SD]\["([^\"]+)"\]=" *(.*)"/ and $CONFIG_FLAGS{$1} = $2;
#     }
#     return 1;
#   }
#   return 0;
# }

sub find_prog
{
  my $prog = $_[0];
  my ($v, $d, $f) = File::Spec->splitpath($prog);

  # If there's no directory then we need to search the PATH
  if (! $d) {
    foreach my $e (File::Spec->path()) {
      $prog = File::Spec->catfile($e, $f);
      if (-x $prog) {
        ($v, $d, $f) = File::Spec->splitpath($prog);
        last;
      }
    }
  }

  return ($v, $d, $f);
}

sub get_config
{
  return exists($CONFIG_FLAGS{$_[0]}) ? $CONFIG_FLAGS{$_[0]} : '';
}

sub set_more_defaults
{
  my $string;

  # Try to find and load config-flags.pm.  They may be in the local directory
  # or in the $srcpath if we're remote.

  my $d = $cwd;
  my $cfg = File::Spec->catfile($d, 'config-flags.pm');
  if (! -f $cfg) {
      # Nope, so look in the srcpath
      my $d = $srcpath;
      $cfg = File::Spec->catfile($d, 'config-flags.pm');
  }

  -f $cfg or die "Can't locate config-flags.pm in $cwd" . ($cwd eq $srcpath ? '' : " or $srcpath") . "\n";

  unshift(@INC, $d);
  require "config-flags.pm";

  # Find the full pathname of Make.  For DOS systems this is more
  # complicated, so we ask make itself.
  if ($osname eq 'VMS') {
    $port_type = 'VMS-DCL' unless defined $ENV{"SHELL"};
    # On VMS pre-setup make to be found with simply 'make'.
    $make_path = 'make';
  } else {
    create_file('make.mk', 'all:;$(info $(MAKE))');
    my $mk = `$make_path -sf make.mk`;
    unlink('make.mk');
    $mk =~ s/\r?\n$//;
    $mk or die "FATAL ERROR: Cannot determine the value of \$(MAKE)\n";
    $make_path = $mk;
  }
  ($mpv, $mpd, $mpf) = File::Spec->splitpath($make_path);

  # Ask make what shell to use
  create_file('shell.mk', 'all:;$(info $(SHELL))');
  $sh_name = `$make_path -sf shell.mk`;
  unlink('shell.mk');
  $sh_name =~ s/\r?\n$//;
  if (! $sh_name) {
      print "Cannot determine shell\n";
      $is_posix_sh = 0;
  } else {
      my $o = `$sh_name -c ': do nothing' 2>&1`;
      $is_posix_sh = $? == 0 && $o eq '';
  }

  $string = `$make_path -v`;
  $string =~ /^(GNU Make [^,\n]*)/ or die "$make_path is not GNU Make.  Version:\n$string";
  $testee_version = "$1\n";

  create_file('null.mk', '');

  my $redir = '2>&1';
  $redir = '' if os_name eq 'VMS';
  $string = `$make_path -f null.mk $redir`;
  if ($string =~ /(.*): \*\*\* No targets\.  Stop\./) {
    $make_name = $1;
  } else {
    $make_name = $mpf;
  }

  # prepend pwd if this is a relative path (ie, does not
  # start with a slash, but contains one).  Thanks for the
  # clue, Roland.

  if ($mpd && !File::Spec->file_name_is_absolute($make_path) && $cwdvol eq $mpv) {
     $mkpath = File::Spec->catpath($cwdvol, File::Spec->catdir($cwd, $mpd), $mpf);
  } else {
     $mkpath = $make_path;
  }

  # Find the helper tool
  $helptool = File::Spec->catfile($srcpath, 'thelp.pl');

  # It's difficult to quote this properly in all the places it's used so
  # ensure it doesn't need to be quoted.
  $helptool =~ s,\\,/,g if $port_type eq 'W32';
  $helptool =~ s, ,\\ ,g;

  # Get Purify log info--if any.

  if (exists $ENV{PURIFYOPTIONS}
      && $ENV{PURIFYOPTIONS} =~ /.*-logfile=([^ ]+)/) {
    $pure_log = $1 || '';
    $pure_log =~ s/%v/$make_name/;
    $purify_errors = 0;
  }

  $string = `$make_path -j 2 -f null.mk $redir`;
  if ($string =~ /not supported/) {
    $parallel_jobs = 0;
  }
  else {
    $parallel_jobs = 1;
  }

  unlink('null.mk');

  create_file('features.mk', 'all:;$(info $(.FEATURES))');
  %FEATURES = map { $_ => 1 } split /\s+/, `$make_path -sf features.mk`;
  print "$make_path FEATURES: @{[%FEATURES]}\n" if $verbose;
  unlink('features.mk');

  # Find the default values for different built-in variables
  my $s = "all:;\n";
  foreach (keys %DEFVARS) {
      $s .= "\$(info $_=\$($_))\n";
  }
  create_file('defvars.mk', $s);
  foreach (split "\n", `$make_path -sf defvars.mk`) {
      my @e = split /=/, $_, 2;
      $DEFVARS{$e[0]} = $e[1];
  }
  unlink('defvars.mk');

  # Set up for valgrind, if requested.

  @make_command = ($make_path);

  if ($valgrind) {
    my $args = $valgrind_args;
    open(VALGRIND, "> valgrind.out") or die "Cannot open valgrind.out: $!\n";
    #  -q --leak-check=yes
    exists $ENV{VALGRIND_ARGS} and $args = $ENV{VALGRIND_ARGS};
    @make_command = ('valgrind', '--log-fd='.fileno(VALGRIND));
    push(@make_command, split(' ', $args));
    push(@make_command, $make_path);
    # F_SETFD is 2
    fcntl(VALGRIND, 2, 0) or die "fcntl(setfd) failed: $!\n";
    system("echo Starting on `date` 1>&".fileno(VALGRIND));
    print "Enabled valgrind support.\n";
  }

  if ($debug) {
    print "Port type:    $port_type\n";
    print "Make command: @make_command\n";
    print "Shell path:   $sh_name".($is_posix_sh ? ' (POSIX)' : '')."\n";
    print "#PWD#:        $cwdpath\n";
    print "#PERL#:       $perl_name\n";
    print "#MAKEPATH#:   $mkpath\n";
    print "#MAKE#:       $make_name\n";
  }
}

sub setup_for_test
{
  $makefile = &get_tmpfile;
  if (-f $makefile) {
    unlink $makefile;
  }

  # Get rid of any Purify logs.
  if ($pure_log) {
    ($pure_testname = $testname) =~ tr,/,_,;
    $pure_testname = "$pure_log.$pure_testname";
    system("rm -f $pure_testname*");
    print("Purify testfiles are: $pure_testname*\n") if $debug;
  }
}

exit !&toplevel;