diff options
author | Douglas Katzman <dougk@google.com> | 2022-07-17 20:51:05 -0400 |
---|---|---|
committer | Douglas Katzman <dougk@google.com> | 2022-07-17 20:51:05 -0400 |
commit | 039cfeb470c2036e88afb445d09d4eea82992a0b (patch) | |
tree | ae0adc25a6f42d0b3d80fdf4d52f7bb26d039550 /tests | |
parent | 453db9bf8bea6ad0fe8b5d03a16663ae115e01ae (diff) |
Run most shell tests for #+win32
Diffstat (limited to 'tests')
-rwxr-xr-x | tests/run-program.test.sh | 17 | ||||
-rw-r--r-- | tests/run-tests.lisp | 23 | ||||
-rw-r--r-- | tests/save6.test.sh | 18 | ||||
-rwxr-xr-x | tests/save9.test.sh | 4 | ||||
-rw-r--r-- | tests/test-funs.lisp | 3 |
5 files changed, 52 insertions, 13 deletions
diff --git a/tests/run-program.test.sh b/tests/run-program.test.sh index 749cee3d5..b05b6e2f7 100755 --- a/tests/run-program.test.sh +++ b/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) diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp index 2b19c5bf7..b907370b0 100644 --- a/tests/run-tests.lisp +++ b/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)))) diff --git a/tests/save6.test.sh b/tests/save6.test.sh index db9b3b5eb..7182ef485 100644 --- a/tests/save6.test.sh +++ b/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 diff --git a/tests/save9.test.sh b/tests/save9.test.sh index 695eda9ad..b194e6548 100755 --- a/tests/save9.test.sh +++ b/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 diff --git a/tests/test-funs.lisp b/tests/test-funs.lisp index 699ced112..4e802b6b4 100644 --- a/tests/test-funs.lisp +++ b/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*))) |