Run most shell tests for #+win32

tests/run-program.test.sh

@@ -28,19 +28,27 @@ test `ulimit -n` -ge 1050 || ulimit -S -n 1050
 
 # This should probably be broken up into separate pieces.
 run_sbcl --eval "(defvar *exit-ok* $EXIT_LISP_WIN)" <<'EOF'
+(defmacro our-run-program (name &rest rest)
+  #+unix `(run-program ,name ,@rest)
+  #-unix `(run-program ,(subseq name (1+ (position #\/ name :from-end t)))
+                      ,@rest :search t))
+
   ;; test that $PATH is searched
   (assert (zerop (sb-ext:process-exit-code
                   (sb-ext:run-program "true" () :search t :wait t))))
   (assert (not (zerop (sb-ext:process-exit-code
                        (sb-ext:run-program "false" () :search t :wait t)))))
   (let ((string (with-output-to-string (stream)
-                  (sb-ext:run-program "/bin/echo"
+                  (our-run-program    "/bin/echo"
                                       '("foo" "bar")
                                       :output stream))))
     (assert (string= string "foo bar
 ")))
+  (format t ";;; Smoke tests: PASS~%")
+
   ;; Unix environment strings are ordinarily passed with SBCL convention
   ;; (instead of CMU CL alist-of-keywords convention).
+  #+unix ; env works differently for msys2 apparently
   (let ((string (with-output-to-string (stream)
                   (sb-ext:run-program "/usr/bin/env" ()
                                       :output stream
@@ -55,6 +63,7 @@ run_sbcl --eval "(defvar *exit-ok* $EXIT_LISP_WIN)" <<'EOF'
       (assert (> (alien-funcall dup (sb-impl::fd-stream-fd f)) 1024)))))
 
  ;; Unicode strings
+ #+unix
  (flet ((try (sb-impl::*default-external-format* x y)
          (let* ((process (run-program
                           "/bin/sh" (list "-c" (format nil "echo ~c, $SB_TEST_FOO." x))
@@ -74,6 +83,7 @@ run_sbcl --eval "(defvar *exit-ok* $EXIT_LISP_WIN)" <<'EOF'
   ;; The default Unix environment for the subprocess is the same as
   ;; for the parent process. (I.e., we behave like perl and lots of
   ;; other programs, but not like CMU CL.)
+  #+unix
   (let* ((sb-impl::*default-external-format* :latin-1)
          (sb-alien::*default-c-string-external-format* :latin-1)   
          (string (with-output-to-string (stream)
@@ -93,7 +103,7 @@ run_sbcl --eval "(defvar *exit-ok* $EXIT_LISP_WIN)" <<'EOF'
   ;; make sure that a stream input argument is basically reasonable.
   (let ((string (let ((i (make-string-input-stream "abcdef")))
                   (with-output-to-string (stream)
-                    (sb-ext:run-program "/bin/cat" ()
+                    (our-run-program "/bin/cat" ()
                                         :input i :output stream)))))
     (assert (= (length string) 6))
     (assert (string= string "abcdef")))
@@ -104,12 +114,13 @@ run_sbcl --eval "(defvar *exit-ok* $EXIT_LISP_WIN)" <<'EOF'
   ;; note: this test will be inconclusive if the child's stderr is
   ;; fully buffered.)
   (let ((str (with-output-to-string (s)
-               (run-program "/bin/sh"
+               (our-run-program "/bin/sh"
                             '("-c" "(echo Foo; sleep 2; echo Bar)>&2")
                             :output s :search t :error :output :wait t))))
     (assert (string= str (format nil "Foo~%Bar~%"))))
 
   ;; end of file in the middle of a UTF-8 character
+  ;; (FIXME: asserting failure without knowing why is almost as good as no test at all.)
   (typep (nth-value 1 (ignore-errors
                        (let ((sb-impl::*default-external-format* :utf-8))
                          (with-output-to-string (s)

tests/run-tests.lisp

@@ -59,7 +59,7 @@
     (pure-runner (pure-cload-files) 'cload-test log)
     (impure-runner (impure-load-files) 'load-test log)
     (impure-runner (impure-cload-files) 'cload-test log)
-    #-win32 (impure-runner (sh-files) 'sh-test log)
+    (impure-runner (sh-files) 'sh-test log)
     (log-file-elapsed-time "GRAND TOTAL" start-time log))
   (report)
   (sb-ext:exit :code (if (unexpected-failures) 1 104)))
@@ -567,4 +567,23 @@
   (filter-test-files "*.impure-cload.lisp"))
 
 (defun sh-files ()
-  (filter-test-files "*.test.sh"))
+  (let ((result (filter-test-files "*.test.sh")))
+    #+unix result
+    ;; Rather than hack up the shell scripts which don't pass on #-unix
+    ;; (which would require at least a few lines of shell script and lisp
+    ;; to invoke SBCL and exit with some other code), just confine the kludge
+    ;; to this file.
+    #-unix
+    (if *explicit-test-files*
+        result
+      (remove-if
+       (lambda (x)
+         (member (pathname-name x)
+                 '("filesys.test" ; too many assertions about symlinks to care about just yet
+                   ;; foreign-test-noop-dlclose-test.c:1:10: fatal error: dlfcn.h: No such file or directory
+                   "foreign.test"
+                   ;; No built SBCL here (.../tests/run-sbcl-test-5863): run 'sh make.sh' first!
+                   "run-sbcl.test"
+                   "side-effectful-pathnames.test") ; no idea
+                 :test 'string=))
+        result))))

tests/save6.test.sh

@@ -7,7 +7,10 @@ fi
 
 use_test_subdirectory
 
-tmpcore=$TEST_FILESTEM.core
+tmpcore=${TEST_FILESTEM}_a.core
+# unix can write a new file to same name as the one we're executing
+# but not all OSes can
+tmpcore2=${TEST_FILESTEM}_b.core
 
 # Regression test for https://bugs.launchpad.net/sbcl/+bug/411925
 # saving runtime options _from_ executable cores
@@ -16,15 +19,18 @@ run_sbcl <<EOF
 EOF
 chmod u+x "$tmpcore"
 ./"$tmpcore" --no-userinit --no-sysinit --noprint <<EOF
-  (save-lisp-and-die "$tmpcore" :executable t :save-runtime-options t)
+  (save-lisp-and-die "$tmpcore2" :executable t :save-runtime-options t)
 EOF
-chmod u+x "$tmpcore"
-./"$tmpcore" --no-userinit --no-sysinit --noprint --versions --eval '(exit)' <<EOF
-  (when (equal *posix-argv* '("./$tmpcore" "--versions" "--eval" "(exit)"))
+chmod u+x "$tmpcore2"
+./"$tmpcore2" --no-userinit --no-sysinit --noprint --versions --eval '(exit)' <<EOF
+  ;; tbh I have no idea how this asserts anything about saving options from executable
+  ;; cores with saved options
+  (when #+unix (equal *posix-argv* '("./$tmpcore2" "--versions" "--eval" "(exit)"))
+        #-unix (equal (cdr *posix-argv*) '("--versions" "--eval" "(exit)"))
     (exit :code 42))
 EOF
 status=$?
-rm "$tmpcore"
+rm "$tmpcore" "$tmpcore2"
 if [ $status -ne 42 ]; then
     echo "saving runtime options from executable failed"
     exit 1

tests/save9.test.sh

@@ -11,7 +11,9 @@ use_test_subdirectory
 tmpcore=$TEST_FILESTEM.core
 
 run_sbcl <<EOF
-  (defvar *s* (open "$this_file"))
+  (defvar *s* (open #+unix "$this_file"
+                    #-unix (format nil "~A/run-tests.lisp"
+                            (posix-getenv "SBCL_PWD"))))
   (save-lisp-and-die "$tmpcore")
 EOF
 set -e

tests/test-funs.lisp

@@ -83,7 +83,8 @@
   (progn
     (test-util::setenv "TEST_SBCL_EVALUATOR_MODE"
                         (string-downcase *test-evaluator-mode*))
-    (let ((process (sb-ext:run-program (or #+sunos (posix-getenv "SHELL")
+    ;; Why would it ever be wrong to use (posix-getenv "SHELL") ???
+    (let ((process (sb-ext:run-program (or #+(or sunos win32) (posix-getenv "SHELL")
                                            "/bin/sh")
                                        (list (native-namestring file))
                                        :output *error-output*)))