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