From a581146562009407649b85fac48f4e7cafe5eaa0 Mon Sep 17 00:00:00 2001 From: Paul Smith Date: Mon, 19 Dec 2022 00:24:42 -0500 Subject: 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. --- tests/run_make_tests.pl | 2 +- tests/scripts/features/errors | 27 +++++++++++++++++++-------- tests/scripts/features/output-sync | 2 +- tests/scripts/features/temp_stdin | 2 +- tests/scripts/functions/realpath | 2 +- tests/scripts/misc/close_stdout | 3 +++ tests/scripts/options/dash-I | 2 +- tests/scripts/variables/INCLUDE_DIRS | 2 +- tests/scripts/variables/MAKEFLAGS | 29 ++++++++++++++++++----------- tests/test_driver.pl | 29 +++++++++++++++++++---------- 10 files changed, 65 insertions(+), 35 deletions(-) (limited to 'tests') diff --git a/tests/run_make_tests.pl b/tests/run_make_tests.pl index 5fc37595..06589cc5 100644 --- 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 2cdaf31d..54beaf31 100644 --- 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 18c85c0a..a5884cec 100644 --- 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 3bd53e02..92cb6980 100644 --- 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 fcea5155..492db598 100644 --- 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 c8c839e7..c4edbd66 100644 --- 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 64ee7c58..37178b3d 100644 --- 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 68812924..353630df 100644 --- 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 902a24f8..24264c23 100644 --- 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 3d9a641b..26b59998 100644 --- 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"; -- cgit v1.2.1