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.

diff --git a/tests/run_make_tests.pl b/tests/run_make_tests.pl
index 5fc375958234ce1c057db03364f6af09e8193e39..06589cc5197cfb6012187d331d56d4741a6637b7 100644 (file)
--- 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 = $_;
   }

diff --git a/tests/scripts/features/errors b/tests/scripts/features/errors
index 2cdaf31ded7958f62f2a57358bdb550a76147184..54beaf31b4d83e4f13913085734e9c8475def6d9 100644 (file)
--- 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');
 }

diff --git a/tests/scripts/features/output-sync b/tests/scripts/features/output-sync
index 18c85c0ab4acc9902f7a40fe1c45cb6c8d9548a1..a5884cec9ed721390a0e77e47ee590e772373132 100644 (file)
--- 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.

diff --git a/tests/scripts/features/temp_stdin b/tests/scripts/features/temp_stdin
index 3bd53e0224c1c192bae1fad012c324dde215f3a0..92cb6980f166023a383fd5f54c2684e842d463ff 100644 (file)
--- 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 ();
 

diff --git a/tests/scripts/functions/realpath b/tests/scripts/functions/realpath
index fcea515522ba2fd3573d65765047ce8e47848105..492db598aabd58ab1c1a13ef2bfdeda066bb2784 100644 (file)
--- 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#)

diff --git a/tests/scripts/misc/close_stdout b/tests/scripts/misc/close_stdout
index c8c839e7f2d0d7ca6cd8134a574e2a76438ad521..c4edbd660c67bbe5c81b9c33631366c912a7bbb6 100644 (file)
--- 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;

diff --git a/tests/scripts/options/dash-I b/tests/scripts/options/dash-I
index 64ee7c58165a4de337c5178fcb8f99f6714abec7..37178b3d5b07fcd49c80ccac067a6d0d16ad1e6a 100644 (file)
--- 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;

diff --git a/tests/scripts/variables/INCLUDE_DIRS b/tests/scripts/variables/INCLUDE_DIRS
index 6881292486b4620524a6345a3ba17fa79dde4a9d..353630df0401b1130cbb6ea6461f04d055e31c09 100644 (file)
--- 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("

diff --git a/tests/scripts/variables/MAKEFLAGS b/tests/scripts/variables/MAKEFLAGS
index 902a24f85064892a63e20c4f2bbd6c7ef3ec7f1a..24264c235a95ef7fe1482ab3db97164320bb10aa 100644 (file)
--- 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;

diff --git a/tests/test_driver.pl b/tests/test_driver.pl
index 3d9a641b12cf77607c59700a1ddd27afad864802..26b599984124e07b27ad6f898b28a425070d7864 100644 (file)
--- 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";