tests [WINDOWS32]: Support Strawberry Perl on Windows

Strawberry Perl has some different behaviors from ActiveState Perl which impact the test suite: - Avoid Perl's chomp() as it may not remove CRs; chomp() may remove only the final NL but not the CR in a CRNL line ending. - Strawberry Perl doesn't support ActiveState's system(1, ...) form. - Strawberry Perl (or msys?) does something weird with "/tmp" when provided to exec(), replacing it with the user's %TEMP%. - Strawberry Perl uses msys paths like /c/foo instead of C:\foo. * tests/test_driver.pl (get_osname): Strawberry Perl uses 'msys' as its $^O so if we see that use a port of 'W32'. (_run_with_timeout): Strawberry Perl doesn't support the special system(1, ...) form of system() so use POSIX standard fork/exec. (compare_answer): Paths generated by Strawberry Perl use msys path format (e.g., /c/foo instead of C:\foo); check for those differences and compare RE against both the unmodified and modified log. * tests/run_make_tests.pl (set_defaults): Switch from chomp to s/// to remove CRNL and NL line endings. * tests/scripts/features/errors: Executing directories on Strawberry will give an error; translate it to Windows error output format. * tests/scripts/features/output-sync: Ditto. * tests/scripts/features/temp_stdin: Ditto. * tests/scripts/functions/realpath: Ditto. * tests/scripts/options/dash-I: Ditto. * tests/scripts/variables/INCLUDE_DIRS: Ditto. * tests/scripts/misc/close_stdout: /dev/full is reported as existing on Strawberry Perl, but it doesn't do anything. Skip the test. * tests/scripts/variables/MAKEFLAGS: When an argument containing /tmp is passed to a program via exec(), something replaces it with the expansion of the %TEMP% variable. Instead of using /tmp create a local directory to use.
2024-11-24 20:20:35 +00:00 · 2022-12-19 00:24:42 -05:00 · 2022-12-19 00:24:42 -05:00 · a581146562
commit a581146562
parent b2c7446023
10 changed files with 65 additions and 35 deletions
--- a/tests/run_make_tests.pl
+++ b/tests/run_make_tests.pl
@ -469,7 +469,7 @@ sub set_defaults
  if ($? == 0) {
      print "Invoked invalid file!  Skipping related tests.\n";
  } else {
-      chomp($_);
+      s/\r?\n//g;
      s/bad-command/#CMDNAME#/g;
      $ERR_command_not_found = $_;
  }
--- a/tests/scripts/features/errors
+++ b/tests/scripts/features/errors
@ -35,12 +35,13 @@ all:

 sub errors_getinfo
 {
-    my ($cmd, $args) = @_;
+    my ($cmd, $args, $err) = @_;
    if ($port_type eq 'W32') {
-        return (2, "process_begin: CreateProcess(NULL, $cmd $args, ...) failed.\nmake (e=2): The system cannot find the file specified.");
+        return (2, "process_begin: CreateProcess(NULL, $cmd$args, ...) failed.\nmake (e=2): The system cannot find the file specified.");
    }

-    return (127, "#MAKE#: $cmd: $ERR_no_such_file");
+    if (!$err) { $err = $ERR_no_such_file; }
+    return (127, "#MAKE#: $cmd: $err");
 }

 # TEST #3
@ -50,7 +51,7 @@ sub errors_getinfo
 my $unk = './foobarbazbozblat';
 unlink($unk);

-my ($ernum, $erstr) = errors_getinfo($unk, "xx yy");
+my ($ernum, $erstr) = errors_getinfo($unk, " xx yy");
 run_make_test(qq!
 one: ; -$unk xx yy
 !, 'one',
@ -59,7 +60,7 @@ one: ; -$unk xx yy
 # TEST #4
 # -------

-($ernum, $erstr) = errors_getinfo($unk, "aa bb");
+($ernum, $erstr) = errors_getinfo($unk, " aa bb");
 run_make_test(qq!
 two: ; $unk aa bb
 !, 'two -i',
@ -73,7 +74,7 @@ run_make_test(undef, 'two',

 # SV #56918 : Test the unknown command as the second recipe line

-($ernum, $erstr) = errors_getinfo($unk, "qq rr");
+($ernum, $erstr) = errors_getinfo($unk, " qq rr");
 run_make_test(qq!
 three:
 \t\@echo one
@ -101,16 +102,26 @@ if ($ERR_nonexe_file) {
 if ($ERR_exe_dir) {
    mkdir('sd', 0775) or print "mkdir: sd: $!\n";

+    ($ernum, $erstr) = errors_getinfo('sd', '', $ERR_exe_dir);
+
    run_make_test(q!
 PATH := .
 all: ; sd
 !,
-              '', "sd\n#MAKE#: sd: $ERR_exe_dir\n#MAKE#: *** [#MAKEFILE#:3: all] Error 127", 512);
+              '', "sd\n$erstr\n#MAKE#: *** [#MAKEFILE#:3: all] Error $ernum", 512);
+
+    if ($port_type eq 'W32') {
+        $ernum = 5;
+        $erstr = "process_begin: CreateProcess(NULL, ./sd, ...) failed.\nmake (e=5): Access is denied.";
+    } else {
+        $ernum = 127;
+        $erstr = "#MAKE#: ./sd: $ERR_exe_dir";
+    }

    run_make_test(q!
 all: ; ./sd
 !,
-              '', "./sd\n#MAKE#: ./sd: $ERR_exe_dir\n#MAKE#: *** [#MAKEFILE#:2: all] Error 127", 512);
+              '', "./sd\n$erstr\n#MAKE#: *** [#MAKEFILE#:2: all] Error $ernum", 512);

    rmdir('sd');
 }
--- a/tests/scripts/features/output-sync
+++ b/tests/scripts/features/output-sync
@ -349,7 +349,7 @@ add_options($cmd, '-f', '/dev/null', '-E', q!all:;@echo $$PPID!);
 my $fout = 'ppidtest.out';
 run_command_with_output($fout, @$cmd);
 $_ = read_file_into_string($fout);
-chomp($_);
+s/\r?\n//g;
 if (/^[0-9]+$/) {
 use POSIX ();
 # SV 63157.
--- a/tests/scripts/features/temp_stdin
+++ b/tests/scripts/features/temp_stdin
@ -52,7 +52,7 @@ add_options($cmd, '-f', '/dev/null', '-E', q!all:;@echo $$PPID!);
 my $fout = 'ppidtest.out';
 run_command_with_output($fout, @$cmd);
 $_ = read_file_into_string($fout);
-chomp($_);
+s/\r?\n//g;
 if (/^[0-9]+$/) {
 use POSIX ();

--- a/tests/scripts/functions/realpath
+++ b/tests/scripts/functions/realpath
@ -26,7 +26,7 @@ all: ; @:
 create_file('root.mk', 'all:;$(info $(realpath /))');
 my $root = `$make_path -sf root.mk`;
 unlink('root.mk');
-chomp $root;
+$root =~ s/\r?\n//g;

 my $tst = '
 ifneq ($(realpath /.),#ROOT#)
--- a/tests/scripts/misc/close_stdout
+++ b/tests/scripts/misc/close_stdout
@ -4,6 +4,9 @@ $description = "Make sure make exits with an error if stdout is full.";

 -e '/dev/full' or return -1;

+# In Strawberry Perl, /dev/full "exists" but does nothing :-/
+$port_type eq 'W32' and return -1;
+
 run_make_test("\n", '-v > /dev/full', '/^#MAKE#: write error/', 256);

 1;
--- a/tests/scripts/options/dash-I
+++ b/tests/scripts/options/dash-I
@ -86,7 +86,7 @@ create_file('defaultdirs.mk', "\$(info \$(.INCLUDE_DIRS))\nall:;\@:\n");
 my $cmd = subst_make_string("#MAKEPATH# -f defaultdirs.mk");
 my @dirs = `$cmd`;
 my $dirs = $dirs[0];
-chomp $dirs;
+$dirs =~ s/\r?\n//g;
 unlink('defaultdirs.mk');

 my $fn = undef;
--- a/tests/scripts/variables/INCLUDE_DIRS
+++ b/tests/scripts/variables/INCLUDE_DIRS
@ -45,7 +45,7 @@ create_file('defaultdirs.mk', "\$(info \$(.INCLUDE_DIRS))\nall:;\@:\n");
 my $cmd = subst_make_string("#MAKEPATH# -f defaultdirs.mk");
 my @dirs = `$cmd`;
 my $dirs = $dirs[0];
-chomp $dirs;
+$dirs =~ s/\r?\n//g;
 unlink('defaultdirs.mk');

 run_make_test("
--- a/tests/scripts/variables/MAKEFLAGS
+++ b/tests/scripts/variables/MAKEFLAGS
@ -81,8 +81,13 @@ all:; \$(info makeflags='\$(MAKEFLAGS)')
 }
 }

+# Strawberry Perl's exec()--or someting!--appears to replace all /tmp with the
+# user's %TEMP% value so we can't use that for -I testing.  Make a directory.
+
+mkdir('localtmp', 0777);
+
 # Switches which carry arguments.
-@opts = (' -I/tmp', ' -Onone', ' --debug=b', ' -l2.5');
+@opts = (' -Ilocaltmp', ' -Onone', ' --debug=b', ' -l2.5');
 for my $fl (@flavors) {
 for my $opt (@opts) {
  run_make_test("
@ -106,7 +111,7 @@ all:; \$(info makeflags='\$(MAKEFLAGS)')

 # Test that make filters out duplicates.
 # Each option is specified in the makefile, env and on the command line.
-@opts = (' -I/tmp', ' -Onone', ' --debug=b', ' -l2.5');
+@opts = (' -Ilocaltmp', ' -Onone', ' --debug=b', ' -l2.5');
 for my $fl (@flavors) {
 for my $opt (@opts) {
 $ENV{'MAKEFLAGS'} = $opt;
@ -136,24 +141,24 @@ all:; \$(info makeflags='\$(MAKEFLAGS)')
 for my $fl (@flavors) {
 $ENV{'MAKEFLAGS'} = 'ikB --no-print-directory --warn-undefined-variables --trace';
 run_make_test("
-MAKEFLAGS${fl}iknqrswd -I/tmp -I/tmp -Onone -Onone -l2.5 -l2.5
+MAKEFLAGS${fl}iknqrswd -Ilocaltmp -Ilocaltmp -Onone -Onone -l2.5 -l2.5
 all:; \$(info makeflags='\$(MAKEFLAGS)')
 ",
-'-Onone -l2.5 -l2.5 -Onone -I/tmp -iknqrswd -i -n -s -k -I/tmp',
-"/makeflags='Bdiknqrsw -I/tmp -l2.5 -Onone --trace --warn-undefined-variables'/");
+'-Onone -l2.5 -l2.5 -Onone -Ilocaltmp -iknqrswd -i -n -s -k -Ilocaltmp',
+"/makeflags='Bdiknqrsw -Ilocaltmp -l2.5 -Onone --trace --warn-undefined-variables'/");
 }

 # Verify MAKEFLAGS are all available to shell function at parse time.
 for my $fl (@flavors) {
-my $answer = 'Biknqrs -I/tmp -l2.5 -Onone --no-print-directory --warn-undefined-variables';
+my $answer = 'Biknqrs -Ilocaltmp -l2.5 -Onone --no-print-directory --warn-undefined-variables';
 $ENV{'MAKEFLAGS'} = 'ikB --no-print-directory --warn-undefined-variables';
 run_make_test("
-MAKEFLAGS${fl}iknqrsw -I/tmp -I/tmp -Onone -Onone -l2.5 -l2.5 --no-print-directory
+MAKEFLAGS${fl}iknqrsw -Ilocaltmp -Ilocaltmp -Onone -Onone -l2.5 -l2.5 --no-print-directory
 \$(info at parse time '\$(MAKEFLAGS)')
 XX := \$(shell echo \"\$\$MAKEFLAGS\")
 all:; \$(info at build time makeflags='\$(XX)')
 ",
-'-Onone -l2.5 -l2.5 -Onone -I/tmp -iknqrs -i -n -s -k -I/tmp',
+'-Onone -l2.5 -l2.5 -Onone -Ilocaltmp -iknqrs -i -n -s -k -Ilocaltmp',
 "at parse time '$answer'
 at build time makeflags='$answer'");
 }
@ -161,14 +166,14 @@ at build time makeflags='$answer'");
 # Verify MAKEFLAGS and command line definitions are all available to shell function at parse time.
 for my $fl (@flavors) {
 $ENV{'MAKEFLAGS'} = 'ikB --no-print-directory --warn-undefined-variables';
-my $answer = 'Biknqrs -I/tmp -l2.5 -Onone --no-print-directory --warn-undefined-variables -- hello=world';
+my $answer = 'Biknqrs -Ilocaltmp -l2.5 -Onone --no-print-directory --warn-undefined-variables -- hello=world';
 run_make_test("
-MAKEFLAGS${fl}iknqrsw -I/tmp -I/tmp -Onone -Onone -l2.5 -l2.5 --no-print-directory
+MAKEFLAGS${fl}iknqrsw -Ilocaltmp -Ilocaltmp -Onone -Onone -l2.5 -l2.5 --no-print-directory
 \$(info at parse time '\$(MAKEFLAGS)')
 XX := \$(shell echo \"\$\$MAKEFLAGS\")
 all:; \$(info at build time makeflags='\$(XX)')
 ",
-'-Onone -l2.5 -l2.5 -Onone -I/tmp -iknqrs -i -n -s -k -I/tmp hello=world',
+'-Onone -l2.5 -l2.5 -Onone -Ilocaltmp -iknqrs -i -n -s -k -Ilocaltmp hello=world',
 "at parse time '$answer'
 at build time makeflags='$answer'");
 }
@ -891,5 +896,7 @@ hello:; touch \$@

 unlink('hello');

+rmdir('localtmp');
+
 # This tells the test driver that the perl test script executed properly.
 1;
--- a/tests/test_driver.pl
+++ b/tests/test_driver.pl
@ -394,7 +394,7 @@ sub get_osname
  #
  # This is probably not specific enough.
  #
-  if ($osname =~ /MSWin32/i || $osname =~ /Windows/i
+  if ($osname =~ /MSWin32/i || $osname =~ /Windows/i || $osname =~ /msys/i
      || $osname =~ /MINGW32/i || $osname =~ /CYGWIN_NT/i) {
    $port_type = 'W32';
  }
@ -922,20 +922,28 @@ sub compare_answer
  $log =~ s,\r\n,\n,gs;
  return 1 if ($log eq $kgo);

+  # Keep these in case it's a regex
+  $mkgo = $kgo;
+  $mlog = $log;
+
+  # Some versions of Perl on Windows use /c instead of C:
+  $mkgo =~ s,\b([A-Z]):,/\L$1,g;
+  $mlog =~ s,\b([A-Z]):,/\L$1,g;
+  return 1 if ($mlog eq $mkgo);
+
  # See if it is a backslash problem (only on W32?)
-  ($mkgo = $kgo) =~ tr,\\,/,;
-  ($mlog = $log) =~ tr,\\,/,;
-  return 1 if ($log eq $kgo);
+  $mkgo =~ tr,\\,/,;
+  $mlog =~ tr,\\,/,;
+  return 1 if ($mlog eq $mkgo);

  # VMS is a whole thing...
-  return 1 if ($^O eq 'VMS' && compare_answer_vms($mkgo, $mlog));
+  return 1 if ($^O eq 'VMS' && compare_answer_vms($kgo, $log));

  # See if the answer might be a regex.
  if ($kgo =~ m,^/(.+)/$,) {
+    # Check the regex against both the original and modified strings
    return 1 if ($log =~ /$1/);
-
-    # We can't test with backslashes converted to forward slashes, because
-    # backslashes could be escaping RE special characters!
+    return 1 if ($mlog =~ /$1/);
  }

  return 0;
@ -1095,9 +1103,10 @@ sub _run_with_timeout
      $code = (($vms_code & 0xFFF) >> 3) * 256;
    }

-  } elsif ($port_type eq 'W32') {
+  } elsif ($port_type eq 'W32' && $^O ne 'msys') {
+    # Using ActiveState Perl (?)
    my $pid = system(1, @_);
-    $pid > 0 or die "Cannot execute $_[0]\n";
+    $pid > 0 or die "Cannot execute $_[0]: $!\n";
    local $SIG{ALRM} = sub {
      my $e = $ERRSTACK[0];
      print $e "\nTest timed out after $test_timeout seconds\n";