summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorDouglas Katzman <dougk@google.com>2022-07-17 20:51:05 -0400
committerDouglas Katzman <dougk@google.com>2022-07-17 20:51:05 -0400
commit039cfeb470c2036e88afb445d09d4eea82992a0b (patch)
treeae0adc25a6f42d0b3d80fdf4d52f7bb26d039550 /tests
parent453db9bf8bea6ad0fe8b5d03a16663ae115e01ae (diff)
Run most shell tests for #+win32
Diffstat (limited to 'tests')
-rwxr-xr-xtests/run-program.test.sh17
-rw-r--r--tests/run-tests.lisp23
-rw-r--r--tests/save6.test.sh18
-rwxr-xr-xtests/save9.test.sh4
-rw-r--r--tests/test-funs.lisp3
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*)))