sbcl_pwd() {
if [ "$OSTYPE" = "cygwin" ] ; then
- SBCL_PWD=`cygpath -m "$(pwd)"`
+ SBCL_PWD="`cygpath -m \"$(pwd)\"`"
else
- SBCL_PWD=`pwd`
+ SBCL_PWD="`pwd`"
fi
export SBCL_PWD
}
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
-# Remember where we came from so we can find local support files later.
-originalpwd=`pwd`
+. ./subr.sh
# Find clocc ansi-test (or just punt, returning success).
+set +u
if [ "$SBCL_CLOCC_ANSI_TEST" = "" ] ; then
echo //punting clocc ansi-test because SBCL_CLOCC_ANSI_TEST is undefined
- exit 104
+ exit $EXIT_TEST_WIN
else
echo //going on to run clocc ansi-test in $SBCL_CLOCC_ANSI_TEST
cd $SBCL_CLOCC_ANSI_TEST
fi
+set -u
# The condition system is for the weak.
tmpprefix="${TMPDIR:-/tmp}/sbcl-clocc-ansi-test-$$"
bugsfilename="$tmpprefix-bugs.tmp"
# Go SBCL go.
-$SBCL <<EOF >$rawfilename
+run_sbcl <<EOF >$rawfilename
(in-package :cl-user)
;;; Tell ansi-test about our known bugs.
-(load "$originalpwd/clocc-ansi-test-known-bugs.lisp")
+(load "$SBCL_PWD/clocc-ansi-test-known-bugs.lisp")
;;; Actually run ansi-test.
(load "tests.lisp")
;;; Return a special status code to show that we reached the end
. ./expect.sh
-base_tmpfilename="clos-test-$$-tmp"
-tmpfilename="$base_tmpfilename.lisp"
-compiled_tmpfilename="$base_tmpfilename.fasl"
+use_test_subdirectory
+
+tmpfilename="$TEST_FILESTEM.lisp"
# This should fail, but didn't until sbcl-0.6.12.7, with Martin
# Atzmueller's port of Pierre Mai's fixes.
EOF
expect_clean_compile $tmpfilename
-rm $tmpfilename
-rm $compiled_tmpfilename
-
# success
-exit 104
+exit $EXIT_TEST_WIN
. ./expect.sh
-base_tmpfilename="compiler-test-$$-tmp"
-tmpfilename="$base_tmpfilename.lisp"
-compiled_tmpfilename="$base_tmpfilename.fasl"
+use_test_subdirectory
+
+tmpfilename="$TEST_FILESTEM.lisp"
# This should fail, as type inference should show that the call to FOO
# will return something of the wrong type.
EOF
expect_aborted_compile $tmpfilename
-rm $tmpfilename
-
# success
-exit 104
+exit $EXIT_TEST_WIN
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
-tmpcore="core-test-sh-$$.core"
-tmpoutput="core-test-sh-$$.output.txt"
-rm -f "$tmpcore" "$tmpoutput"
+. ./subr.sh
+
+use_test_subdirectory
+
+tmpcore=$TEST_FILESTEM.core
+tmpoutput=$TEST_FILESTEM.txt
# In sbcl-0.7.7 SAVE-LISP-AND-DIE didn't work at all because of
# flakiness caused by consing/GC/purify twice-and-at-least-twice
# -- Eric Marsden, <http://tunes.org/~nef/logs/lisp/02.09.15>
#
# diagnosed and fixed by Dan Barlow in sbcl-0.7.7.29
-$SBCL <<EOF
+run_sbcl <<EOF
(defun foo (x) (+ x 11))
(save-lisp-and-die "$tmpcore")
EOF
-$SBCL_ALLOWING_CORE --core "$tmpcore" \
---userinit /dev/null --sysinit /dev/null <<EOF
+run_sbcl_with_core "$tmpcore" --no-userinit --no-sysinit <<EOF
(quit :unix-status (foo 10))
EOF
-if [ $? = 21 ]; then
- echo "/Basic SAVE-LISP-AND-DIE worked, good."
-else
- echo "failure in basic SAVE-LISP-AND-DIE: $?"
- exit 1
-fi
+check_status_maybe_lose "Basic SAVE-LISP-AND-DIE" $? 21 "(saved core ran)"
# In sbcl-0.9.8 saving cores with callbacks didn't work on gencgc platforms
-$SBCL <<EOF
+run_sbcl <<EOF
(defun bar ()
(format t "~&Callbacks not supported, skipping~%")
(quit :unix-status 42))
(defun bar () (quit :unix-status (alien-funcall foo))))
(save-lisp-and-die "$tmpcore")
EOF
-$SBCL_ALLOWING_CORE --core "$tmpcore" \
---userinit /dev/null --sysinit /dev/null <<EOF
+run_sbcl_with_core "$tmpcore" --no-userinit --no-sysinit <<EOF
(bar)
EOF
-if [ $? = 42 ]; then
- echo "/Callbacks after SAVE-LISP-AND-DIE worked, good."
-else
- echo "failure in basic SAVE-LISP-AND-DIE: $?"
- exit 1
-fi
+check_status_maybe_lose "Callbacks after SAVE-LISP-AND-DIE" $? \
+ 42 "(callback function ran)"
# test suppression of banner in executable cores
-$SBCL <<EOF
+run_sbcl <<EOF
(save-lisp-and-die "$tmpcore" :executable t)
EOF
chmod u+x "$tmpcore"
-./"$tmpcore" >"$tmpoutput" \
- --no-userinit --no-sysinit --eval '(quit :unix-status 71)'
-if [ $? != 71 ]; then
- echo "failure in banner suppression: $?"
+./"$tmpcore" > "$tmpoutput" --no-userinit --no-sysinit --noprint <<EOF
+ (quit :unix-status 71)
+EOF
+status=$?
+if [ $status != 71 ]; then
+ echo "failure in banner suppression: $status"
exit 1
elif [ -s "$tmpoutput" ]; then
echo "failure in banner suppression: nonempty output:"
exit 1
fi
-rm -f "$tmpcore"
-rm -f "$tmpoutput"
-echo "/returning success from core.test.sh"
-exit 104
+exit $EXIT_TEST_WIN
# file to be sourced by scripts wanting to test the compiler
+. ./subr.sh
+
# Check that compiling and loading the file $1 generates an error
# at load time; also that just loading it directly (into the
# interpreter) generates an error.
expect_load_error ()
{
# Test compiling and loading.
- $SBCL <<EOF
+ run_sbcl <<EOF
(compile-file "$1")
;;; But loading the file should fail.
(multiple-value-bind (value0 value1) (ignore-errors (load *))
(assert (null value0))
(format t "VALUE1=~S (~A)~%" value1 value1)
(assert (typep value1 'error)))
- (sb-ext:quit :unix-status 52)
+ (sb-ext:quit :unix-status $EXIT_LISP_WIN)
EOF
- if [ $? != 52 ]; then
- echo compile-and-load $1 test failed: $?
- exit 1
- fi
+ check_status_maybe_lose compile-and-load $?
# Test loading into the interpreter.
- $SBCL <<EOF
+ run_sbcl <<EOF
(multiple-value-bind (value0 value1) (ignore-errors (load "$1"))
(assert (null value0))
(format t "VALUE1=~S (~A)~%" value1 value1)
(assert (typep value1 'error)))
- (sb-ext:quit :unix-status 52)
+ (sb-ext:quit :unix-status $EXIT_LISP_WIN)
EOF
- if [ $? != 52 ]; then
- echo load-into-interpreter $1 test failed: $?
- exit 1
- fi
+ check_status_maybe_lose load-into-interpreter $?
}
# Test that a file compiles cleanly, with no ERRORs, WARNINGs or
# STYLE-WARNINGs.
expect_clean_compile ()
{
- $SBCL <<EOF
+ run_sbcl <<EOF
(multiple-value-bind (pathname warnings-p failure-p)
(compile-file "$1")
(declare (ignore pathname))
(assert (not warnings-p))
(assert (not failure-p))
- (sb-ext:quit :unix-status 52))
+ (sb-ext:quit :unix-status $EXIT_LISP_WIN))
EOF
- if [ $? != 52 ]; then
- echo clean-compile $1 test failed: $?
- exit 1
- fi
+ check_status_maybe_lose clean-compile $?
}
expect_warned_compile ()
{
- $SBCL <<EOF
+ run_sbcl <<EOF
(multiple-value-bind (pathname warnings-p failure-p)
(compile-file "$1")
(declare (ignore pathname))
(assert warnings-p)
(assert (not failure-p))
- (sb-ext:quit :unix-status 52))
+ (sb-ext:quit :unix-status $EXIT_LISP_WIN))
EOF
- if [ $? != 52 ]; then
- echo warn-compile $1 test failed: $?
- exit 1
- fi
+ check_status_maybe_lose warn-compile $?
}
expect_failed_compile ()
{
- $SBCL <<EOF
+ run_sbcl <<EOF
(multiple-value-bind (pathname warnings-p failure-p)
(compile-file "$1")
(declare (ignore pathname warnings-p))
(assert failure-p)
- (sb-ext:quit :unix-status 52))
+ (sb-ext:quit :unix-status $EXIT_LISP_WIN))
EOF
- if [ $? != 52 ]; then
- echo fail-compile $1 test failed: $?
- exit 1
- fi
+ check_status_maybe_lose fail-compile $?
}
expect_aborted_compile ()
{
- $SBCL <<EOF
+ run_sbcl <<EOF
(let* ((lisp "$1")
(fasl (compile-file-pathname lisp)))
(multiple-value-bind (pathname warnings-p failure-p)
(assert failure-p)
(assert warnings-p)
(assert (not (probe-file fasl))))
- (sb-ext:quit :unix-status 52))
+ (sb-ext:quit :unix-status $EXIT_LISP_WIN))
EOF
- if [ $? != 52 ]; then
- echo abort-compile $1 test failed: $?
- exit 1
- fi
+ check_status_maybe_lose abort-compile $?
}
fail_on_compiler_note ()
{
- $SBCL <<EOF
+ run_sbcl <<EOF
(handler-bind ((sb-ext:compiler-note #'error))
(compile-file "$1")
- (sb-ext:quit :unix-status 52))
+ (sb-ext:quit :unix-status $EXIT_LISP_WIN))
EOF
- if [ $? != 52 ]; then
- echo fail-on-compiler-note $1 test failed: $?
- exit 1
- fi
+ check_status_maybe_lose fail-on-compiler-note $?
}
expect_compiler_note ()
{
- $SBCL <<EOF
+ run_sbcl <<EOF
(handler-bind ((sb-ext:compiler-note (lambda (c)
(declare (ignore c))
- (sb-ext:quit :unix-status 52))))
+ (sb-ext:quit :unix-status
+ $EXIT_LISP_WIN))))
(compile-file "$1"))
EOF
- if [ $? != 52 ]; then
- echo expect-compiler-note $1 test failed: $?
- exit 1
- fi
+ check_status_maybe_lose expect-compiler-note $?
}
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
+. ./subr.sh
+
+use_test_subdirectory
+testdir="`pwd -P`" # resolve symbolic links in the directory.
+
+set -f # disable filename expansion in the shell.
+
# Test DIRECTORY and TRUENAME.
-testdir=`/bin/pwd`"/filesys-test-$$"
-mkdir $testdir
-echo this is a test > $testdir/test-1.tmp
-echo this is a test > $testdir/test-2.tmp
-echo this is a test > $testdir/wild\?test.tmp
-cd $testdir
-ln -s $testdir dirlinktest
+echo this is a test > test-1.tmp
+echo this is a test > test-2.tmp
+echo this is a test > wild?test.tmp
+
+ln -s "$testdir" dirlinktest
ln -s test-1.tmp link-1
-ln -s `pwd`/test-2.tmp link-2
+ln -s "$testdir/test-2.tmp" link-2
ln -s i-do-not-exist link-3
ln -s link-4 link-4
ln -s link-5 link-6
-ln -s `pwd`/link-6 link-5
-expected_truenames=\
-"'(#p\"$testdir/\"\
- #p\"$testdir/link-3\"\
- #p\"$testdir/link-4\"\
- #p\"$testdir/link-5\"\
- #p\"$testdir/link-6\"\
- #p\"$testdir/test-1.tmp\"\
- #p\"$testdir/test-2.tmp\"\
- #p\"$testdir/wild\\\\?test.tmp\")"
-$SBCL <<EOF
+ln -s "$testdir/link-6" link-5
+expected_truenames=`cat<<EOF
+(list #p"$testdir/"
+ #p"$testdir/link-3"
+ #p"$testdir/link-4"
+ #p"$testdir/link-5"
+ #p"$testdir/link-6"
+ #p"$testdir/test-1.tmp"
+ #p"$testdir/test-2.tmp"
+ #p"$testdir/wild\\\\\?test.tmp")
+EOF
+`
+# FIXME: the following tests probably can't succeed at all if the
+# testdir name contains wildcard characters or quotes.
+run_sbcl <<EOF
(in-package :cl-user)
(let* ((directory (directory "./*.*"))
(truenames (sort directory #'string< :key #'pathname-name)))
(assert (equal (truename "link-4") #p"$testdir/link-4"))
(assert (equal (truename "link-5") #p"$testdir/link-5"))
(assert (equal (truename "link-6") #p"$testdir/link-6"))
- (sb-ext:quit :unix-status 52)
+ (sb-ext:quit :unix-status $EXIT_LISP_WIN)
EOF
-if [ $? != 52 ]; then
- echo DIRECTORY/TRUENAME test part 1 failed, unexpected SBCL return code=$?
- exit 1
-fi
-cd ..
-$SBCL <<EOF
+check_status_maybe_lose "DIRECTORY/TRUENAME part 1" $?
+
+cd "$SBCL_PWD"
+run_sbcl <<EOF
(in-package :cl-user)
(let* ((directory (directory "$testdir/*.*"))
(truenames (sort directory #'string< :key #'pathname-name)))
(assert (equal (truename "$testdir/link-4") #p"$testdir/link-4"))
(assert (equal (truename "$testdir/link-5") #p"$testdir/link-5"))
(assert (equal (truename "$testdir/link-6") #p"$testdir/link-6"))
- (sb-ext:quit :unix-status 52)
+ (sb-ext:quit :unix-status $EXIT_LISP_WIN)
EOF
-if [ $? != 52 ]; then
- echo DIRECTORY/TRUENAME test part 2 failed, unexpected SBCL return code=$?
- exit 1
-fi
-rm -r $testdir
+check_status_maybe_lose "DIRECTORY/TRUENAME part 2" $?
+cleanup_test_subdirectory
# Test DIRECTORY on a tree structure of directories.
-mkdir $testdir
-cd $testdir
+use_test_subdirectory
+
touch water dirt
mkdir animal plant
mkdir animal/vertebrate animal/invertebrate
touch animal/vertebrate/mammal/ruminant/cow
touch animal/vertebrate/snake/python
touch plant/kingsfoil plant/pipeweed
-$SBCL <<EOF
+run_sbcl <<EOF
(in-package :cl-user)
(defun absolutify (pathname)
"Convert a possibly-relative pathname to absolute."
#+nil
(need-match "animal/vertebrate/mammal/robot/../**/../**/*.*" nil))
(need-matches)
-(sb-ext:quit :unix-status 52)
+(sb-ext:quit :unix-status $EXIT_LISP_WIN)
EOF
-if [ $? != 52 ]; then
- echo DIRECTORY/TRUENAME test part 1 failed, unexpected SBCL return code=$?
- exit 1
-fi
-cd ..
-rm -r $testdir
+check_status_maybe_lose "DIRECTORY/TRUENAME part 3" $?
# success convention for script
-exit 104
+exit $EXIT_TEST_WIN
# hang the test-suite, as the typical failure mode used to be SBCL
# hanging uninterruptible in GC.
-echo //entering finalize.test.sh
+. ./subr.sh
+
+use_test_subdirectory
-rm -f finalize-test-passed finalize-test-failed
+echo //entering finalize.test.sh
-${SBCL:-sbcl} <<EOF > /dev/null &
+run_sbcl <<EOF > /dev/null &
(defvar *tmp* 0.0)
(defvar *count* 0)
if [ -f finalize-test-passed ]; then
echo "OK"
rm finalize-test-passed
- exit 104 # Success
+ exit $EXIT_TEST_WIN
elif [ -f finalize-test-failed ]; then
echo "Failed"
rm finalize-test-failed
- exit 1 # Failure
+ exit $EXIT_LOSE
fi
sleep 1
WAITED="x$WAITED"
echo
echo "timeout, killing SBCL"
kill -9 $SBCL_PID
- exit 1 # Failure, SBCL probably hanging in GC
+ exit $EXIT_LOSE # Failure, SBCL probably hanging in GC
fi
done
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
+. ./subr.sh
+use_test_subdirectory
+
echo //entering foreign.test.sh
# simple way to make sure we're not punting by accident:
# setting PUNT to anything other than 104 will make non-dlopen
# and non-linkage-table platforms fail this
-PUNT=104
-
-testfiledir=sbcl-foreign-test-$$
-testfilestem=`pwd`/$testfiledir/sbcl-foreign-test
+PUNT=$EXIT_TEST_WIN
-mkdir $testfiledir
## Make some shared object files to test with.
-build_so() {
+build_so() (
echo building $1.so
- if [ "`uname -m`" = x86_64 -o "`uname -m`" = amd64 -o \
- "`uname -m`" = mips -o "`uname -m`" = mips64 ]; then
- CFLAGS="$CFLAGS -fPIC"
- fi
+ set +u
+ case "`uname -m`" in
+ x86_64|amd64|mips|mips64)
+ CFLAGS="$CFLAGS -fPIC"
+ ;;
+ esac
if [ "`uname`" = Darwin ]; then
SO_FLAGS="-bundle"
else
fi
cc -c $1.c -o $1.o $CFLAGS
ld $SO_FLAGS -o $1.so $1.o
-}
+)
+
+# We want to bail out in case any of these Unix programs fails.
+set -e
-cat > $testfilestem.c <<EOF
+cat > $TEST_FILESTEM.c <<EOF
int summish(int x, int y) { return 1 + x + y; }
int numberish = 42;
}
EOF
-build_so $testfilestem
+build_so $TEST_FILESTEM
-echo 'int foo = 13;' > $testfilestem-b.c
-echo 'int bar() { return 42; }' >> $testfilestem-b.c
-build_so $testfilestem-b
+echo 'int foo = 13;' > $TEST_FILESTEM-b.c
+echo 'int bar() { return 42; }' >> $TEST_FILESTEM-b.c
+build_so $TEST_FILESTEM-b
-echo 'int foo = 42;' > $testfilestem-b2.c
-echo 'int bar() { return 13; }' >> $testfilestem-b2.c
-build_so $testfilestem-b2
+echo 'int foo = 42;' > $TEST_FILESTEM-b2.c
+echo 'int bar() { return 13; }' >> $TEST_FILESTEM-b2.c
+build_so $TEST_FILESTEM-b2
-echo 'int late_foo = 43;' > $testfilestem-c.c
-echo 'int late_bar() { return 14; }' >> $testfilestem-c.c
-build_so $testfilestem-c
+echo 'int late_foo = 43;' > $TEST_FILESTEM-c.c
+echo 'int late_bar() { return 14; }' >> $TEST_FILESTEM-c.c
+build_so $TEST_FILESTEM-c
## Foreign definitions & load
-cat > $testfilestem.base.lisp <<EOF
+cat > $TEST_FILESTEM.base.lisp <<EOF
(define-alien-variable environ (* c-string))
(defvar *environ* environ)
(eval-when (:compile-toplevel :load-toplevel :execute)
(handler-case
(progn
- (load-shared-object "$testfilestem.so")
- (load-shared-object "$testfilestem-b.so"))
+ (load-shared-object "$TEST_FILESTEM.so")
+ (load-shared-object "$TEST_FILESTEM-b.so"))
(sb-int:unsupported-operator ()
;; At least as of sbcl-0.7.0.5, LOAD-SHARED-OBJECT isn't
;; supported on every OS. In that case, there's nothing to test,
;; automagic restarts
(setf *invoke-debugger-hook*
(lambda (condition hook)
+ (declare (ignore hook))
(princ condition)
(let ((cont (find-restart 'continue condition)))
(when cont
(invoke-debugger condition)))
EOF
-echo "(declaim (optimize speed))" > $testfilestem.fast.lisp
-cat $testfilestem.base.lisp >> $testfilestem.fast.lisp
+echo "(declaim (optimize speed))" > $TEST_FILESTEM.fast.lisp
+cat $TEST_FILESTEM.base.lisp >> $TEST_FILESTEM.fast.lisp
-echo "(declaim (optimize space))" > $testfilestem.small.lisp
-cat $testfilestem.base.lisp >> $testfilestem.small.lisp
+echo "(declaim (optimize space))" > $TEST_FILESTEM.small.lisp
+cat $TEST_FILESTEM.base.lisp >> $TEST_FILESTEM.small.lisp
# Test code
-cat > $testfilestem.test.lisp <<EOF
+cat > $TEST_FILESTEM.test.lisp <<EOF
;; FIXME: currently the start/small case fails on x86/Darwin. Moving
;; this NOTE definition to the base.lisp file fixes that, but obviously
;; it is better fo figure out what is going on instead of doing that...
(assert (= 13 foo))
(assert (= 42 (bar)))
(note "/original definitions ok")
- (rename-file "$testfilestem-b.so" "$testfilestem-b.bak")
- (rename-file "$testfilestem-b2.so" "$testfilestem-b.so")
- (load-shared-object "$testfilestem-b.so")
+ (rename-file "$TEST_FILESTEM-b.so" "$TEST_FILESTEM-b.bak")
+ (rename-file "$TEST_FILESTEM-b2.so" "$TEST_FILESTEM-b.so")
+ (load-shared-object "$TEST_FILESTEM-b.so")
(note "/reloading ok")
(assert (= 42 foo))
(assert (= 13 (bar)))
(note "/redefined versions ok")
- (rename-file "$testfilestem-b.so" "$testfilestem-b2.so")
- (rename-file "$testfilestem-b.bak" "$testfilestem-b.so")
+ (rename-file "$TEST_FILESTEM-b.so" "$TEST_FILESTEM-b2.so")
+ (rename-file "$TEST_FILESTEM-b.bak" "$TEST_FILESTEM-b.so")
(note "/renamed back to originals")
;; test late resolution
(multiple-value-bind (val err) (ignore-errors (late-bar))
(assert (not val))
(assert (typep err 'undefined-alien-error)))
- (load-shared-object "$testfilestem-c.so")
+ (load-shared-object "$TEST_FILESTEM-c.so")
(assert (= 43 late-foo))
(assert (= 14 (late-bar)))
(note "/linkage table ok"))
- (sb-ext:quit :unix-status 52) ; success convention for Lisp program
+ (sb-ext:quit :unix-status $EXIT_LISP_WIN) ; success convention for Lisp program
EOF
+# Files are now set up; toggle errexit off, since we use a custom exit
+# convention.
+set +e
+
test_compile() {
- ${SBCL:-sbcl} --eval "(progn (load (compile-file #p\"$testfilestem.$1.lisp\")) (sb-ext:quit :unix-status 52))"
- if [ $? = 52 ]; then
- echo test compile $1 ok
- else
- # we can't compile the test file. something's wrong.
- # rm $testfilestem.*
- echo test compile $1 failed: $?
- exit 1
- fi
+ run_sbcl <<EOF
+(progn (load (compile-file "$TEST_FILESTEM.$1.lisp"))
+(sb-ext:quit :unix-status $EXIT_LISP_WIN))
+EOF
+ check_status_maybe_lose "compile $1" $?
}
test_compile fast
test_compile small
test_use() {
- ${SBCL:-sbcl} --load $testfilestem.$1.fasl --load $testfilestem.test.lisp
- RET=$?
- if [ $RET = 22 ]; then
- rm $testfilestem.*
- exit $PUNT # success -- load-shared-object not supported
- elif [ $RET != 52 ]; then
- rm $testfilestem.*
- echo test use $1 failed: $?
- exit 1
- else
- echo test use $1 ok
- fi
+ run_sbcl --load $TEST_FILESTEM.$1.fasl --load $TEST_FILESTEM.test.lisp
+ check_status_maybe_lose "use $1" $? 22 "(load-shared-object not supported)"
}
test_use small
test_save() {
echo testing save $1
- ${SBCL:-sbcl} --load $testfilestem.$1.fasl --eval "#+linkage-table (save-lisp-and-die \"$testfilestem.$1.core\") #-linkage-table nil" <<EOF
- (sb-ext:quit :unix-status 22) ; catch this
+ run_sbcl --load $TEST_FILESTEM.$1.fasl <<EOF
+#+linkage-table (save-lisp-and-die "$TEST_FILESTEM.$1.core")
+#-linkage-table nil
+(sb-ext:quit :unix-status 22) ; catch this
EOF
- if [ $? = 22 ]; then
- rm $testfilestem.*
- exit $PUNT # success -- linkage-table not available
- else
- echo save $1 ok
- fi
+ check_status_maybe_lose "save $1" $? \
+ 0 "(successful save)" 22 "(linkage table not available)"
}
test_save small
test_start() {
echo testing start $1
- ${SBCL_ALLOWING_CORE:-sbcl} --core $testfilestem.$1.core --sysinit /dev/null --userinit /dev/null --load $testfilestem.test.lisp
- if [ $? != 52 ]; then
- rm $testfilestem.*
- echo test failed: $?
- exit 1 # Failure
- else
- echo test start $1 ok
- fi
+ run_sbcl_with_core $TEST_FILESTEM.$1.core \
+ --no-sysinit --no-userinit --load $TEST_FILESTEM.test.lisp
+ check_status_maybe_lose "start $1" $?
}
test_start fast
test_start small
# missing object file
-rm $testfilestem-b.so $testfilestem-b2.so
-${SBCL_ALLOWING_CORE:-sbcl} --core $testfilestem.fast.core --sysinit /dev/null --userinit /dev/null <<EOF
+rm $TEST_FILESTEM-b.so $TEST_FILESTEM-b2.so
+run_sbcl_with_core $TEST_FILESTEM.fast.core --no-sysinit --no-userinit <<EOF
(assert (= 22 (summish 10 11)))
(multiple-value-bind (val err) (ignore-errors (eval 'foo))
(assert (not val))
(multiple-value-bind (val err) (ignore-errors (eval '(bar)))
(assert (not val))
(assert (typep err 'undefined-alien-error)))
- (quit :unix-status 52)
+ (quit :unix-status $EXIT_LISP_WIN)
EOF
-if [ $? != 52 ]; then
- rm $testfilestem.*
- echo test failed: $?
- exit 1 # Failure
-fi
-
-echo missing .so ok
-
-rm -r $testfiledir
+check_status_maybe_lose "missing-so" $?
# success convention for script
-exit 104
+exit $EXIT_TEST_WIN
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
-tmpcore="init-test-sh-$$.core"
-rm -f $tmpcore
+. ./subr.sh
-$SBCL <<EOF
+use_test_subdirectory
+
+tmpcore="init-test.core"
+
+run_sbcl <<EOF
(defun custom-userinit-pathname ()
"$SBCL_PWD/custom-userinit.lisp")
(defun custom-sysinit-pathname ()
echo "failure saving core"
exit 1
fi
-$SBCL_ALLOWING_CORE --core "$tmpcore" --disable-debugger <<EOF
+run_sbcl_with_core "$tmpcore" --disable-debugger <<EOF
(userinit-quit (sysinit-21))
EOF
-if [ $? = 21 ]; then
- echo "/Default userinit and sysinit loading worked, good"
-else
- echo "failure loading user/sysinit files: $?"
- exit 1
-fi
+check_status_maybe_lose "userinit and sysinit loading" $? 21 "(loading worked)"
-rm -f $tmpcore
-echo "/returning success from init.test.sh"
-exit 104
+exit $EXIT_TEST_WIN
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
-echo //entering room.test.sh
-
-${SBCL:-sbcl} --eval "(progn (dotimes (i 10) (dotimes (j 10) (room)) (gc)) (sb-ext:quit :unix-status 52))"
-if [ $? = 52 ]; then
- true # nop
-else
- exit 1
-fi
+. ./subr.sh
+run_sbcl <<EOF
+ (dotimes (i 10)
+ (dotimes (j 10)
+ (room))
+ #+nil (gc))
+ (sb-ext:quit :unix-status $EXIT_LISP_WIN)
+EOF
+check_status_maybe_lose "room test" $?
# success convention for script
-exit 104
+exit $EXIT_TEST_WIN
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
+. ./subr.sh
+
# Make sure that there's at least something in the environment (for
# one of the tests below).
SOMETHING_IN_THE_ENVIRONMENT='yes there is'
PATH=/some/path/that/does/not/exist:${PATH}
export PATH
-${SBCL:-sbcl} <<'EOF'
+# This should probably be broken up into separate pieces.
+run_sbcl --eval "(defvar *exit-ok* $EXIT_LISP_WIN)" <<'EOF'
;; test that $PATH is searched
(assert (zerop (sb-ext:process-exit-code
(sb-ext:run-program "true" () :search t :wait t))))
'error)
;; success convention for this Lisp program run as part of a larger script
- (sb-ext:quit :unix-status 52)))
+ (sb-ext:quit :unix-status *exit-ok*)))
EOF
-if [ $? != 52 ]; then
- echo test failed: $?
- exit 1
-fi
+check_status_maybe_lose "run program tests" $?
-# success convention
-exit 104
+exit $EXIT_TEST_WIN
(defun sh-test (file)
;; What? No SB-POSIX:EXECV?
`(let ((process (sb-ext:run-program "/bin/sh"
- (list (namestring ,file))
+ (list (native-namestring ,file))
:output *error-output*)))
(sb-ext:quit :unix-status (process-exit-code process))))
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
-# how we invoke SBCL in the tests
-#
-# Until sbcl-0.6.12.8, the shell variable SBCL was bound to a relative
-# pathname, but now we take care to bind it to an absolute pathname (still
-# generated relative to `pwd` in the tests/ directory) so that tests
-# can chdir before invoking SBCL and still work.
-. ../sbcl-pwd.sh
-sbcl_pwd
-
-SBCL_HOME=$SBCL_PWD/../contrib
-export SBCL_HOME
-sbclstem=$SBCL_PWD/../src/runtime/sbcl
+. ./subr.sh
-SBCL="$sbclstem --core $SBCL_PWD/../output/sbcl.core --noinform --sysinit /dev/null --userinit /dev/null --noprint --disable-debugger"
-export SBCL
-echo /running tests on SBCL=\'$SBCL\'
-# more or less like SBCL, but without enough grot removed that appending
-# a --core command line argument works
-#
-# (KLUDGE: and also without any magic to suppress --userinit and
-# --sysinit, so if you use it in a test, you need to add those
-# yourself if you want things to be clean. If many tests start using
-# this, we can redo it as a shell function or something so that the
-# magic can be done once and only once.). Not used in this file, but
-# exists for the benefit of the *.test.sh files that can be started by
-# run-tests.lisp
-SBCL_ALLOWING_CORE=$sbclstem
-export SBCL_ALLOWING_CORE
-echo /with SBCL_ALLOWING_CORE=\'$SBCL_ALLOWING_CORE\'
+echo /running tests on \'$SBCL_RUNTIME --core $SBCL_CORE $SBCL_ARGS\'
-LANG=C
-LC_ALL=C
-export LANG
-export LC_ALL
-
-# "Ten four" is the closest numerical slang I can find to "OK", so
-# it's the Unix status value that we expect from a successful test.
-# (Of course, zero is the usual success value, but we don't want to
-# use that because SBCL returns that by default, so we might think
-# we passed a test when in fact some error caused us to exit SBCL
-# in a weird unexpected way. In contrast, 104 is unlikely to be
-# returned unless we exit through the intended explicit "test
-# successful" path.
tenfour () {
- if [ $1 = 104 ]; then
+ if [ $1 = $EXIT_TEST_WIN ]; then
echo ok
else
- echo test $2 failed, expected 104 return code, got $1
+ echo test failed, expected $EXIT_TEST_WIN return code, got $1
exit 1
fi
}
-
-$SBCL --eval '(with-compilation-unit () (load "run-tests.lisp"))' \
- --eval '(run-tests::run-all)' $*
+set +u
+run_sbcl \
+ --eval '(with-compilation-unit () (load "run-tests.lisp"))' \
+ --eval '(run-tests::run-all)' $*
tenfour $?
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
-original_pwd=`pwd`
+. ./subr.sh
+
+use_test_subdirectory
+testdir="`pwd -P`" # resolve symbolic links in the directory.
# LOADing and COMPILEing files with logical pathnames
-testdir=`pwd`"/side-effectful-pathnames-test-$$"
testfilestem="load-test"
StudlyCapsStem="Load-Test"
-testfilename="$testdir/$testfilestem.lisp"
-mkdir $testdir
+testfilename="$testfilestem.lisp"
cat >$testfilename <<EOF
(in-package :cl-user)
(defparameter *loaded* :yes)
EOF
-$SBCL <<EOF
+run_sbcl <<EOF
(in-package :cl-user)
(setf (logical-pathname-translations "TEST")
(list (list "**;*.*.*" "$testdir/**/*.*")))
(format t "compiled-file-name=~S~%" compiled-file-name)
(format t "expected-file-name=~S~%" expected-file-name)
(assert (string= compiled-file-name expected-file-name)))
- (sb-ext:quit :unix-status 52)
+ (sb-ext:quit :unix-status $EXIT_LISP_WIN)
EOF
-if [ $? != 52 ]; then
- echo LOAD/COMPILE test failed, unexpected Lisp return code=$?
- exit 1
-fi
-# We don't need the test directory any more.
-rm -r $testdir
+check_status_maybe_lose "LOAD/COMPILE" $?
# In the flaky1 branch, Dan Barlow pointed out that
# ENSURE-DIRECTORIES-EXIST failed for these relative pathname
# was removed from UNIX-STAT. Let's make sure that it works now.
#
# Set up an empty directory to work with.
-testdir=${TMPDIR:-/tmp}/sbcl-mkdir-test-$$
-if ! rm -rf $testdir ; then
+testdir="${TMPDIR:-/tmp}/sbcl-mkdir-test-$$"
+if ! rm -rf "$testdir" ; then
echo "$testdir already exists and could not be deleted"
exit 1;
fi
-mkdir $testdir
-cd $testdir
+mkdir "$testdir"
+cd "$testdir"
#
# Provoke failure.
-$SBCL <<EOF
+run_sbcl <<EOF
(let ((rel-name #p"foo/bar/")
(abs-name (merge-pathnames #p"baz/quux/" (truename "."))))
(and
(equalp (ensure-directories-exist rel-name) rel-name)
(sb-ext:quit :unix-status 52)))
EOF
-if [ $? != 52 ]; then
- echo ENSURE-DIRECTORIES-EXIST test failed, unexpected SBCL return code=$?
- find $testdir -print
- exit 1
-fi
-if [ ! -d $testdir/foo/bar ] ; then
- echo test failed: $testdir/foo/bar is not a directory
- find $testdir -print
+check_status_maybe_lose "ENSURE-DIRECTORIES-EXIST" $?
+if [ ! -d "$testdir/foo/bar" ] ; then
+ echo test failed: "$testdir/foo/bar" is not a directory
+ find "$testdir" -print
exit 1
fi;
-if [ ! -d $testdir/baz/quux ] ; then
- echo test failed: $testdir/baz/quux is not a directory
- find $testdir -print
+if [ ! -d "$testdir/baz/quux" ] ; then
+ echo test failed: "$testdir/baz/quux" is not a directory
+ find "$testdir" -print
exit 1
fi;
#
# We succeeded, life is good. Now we don't need the test directory
# any more; and come back home.
-rm -r $testdir
-cd $original_pwd
+cd "$SBCL_PWD"
+rm -r "$testdir"
-# success convention for script
-exit 104
+exit $EXIT_TEST_WIN
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
+. ./subr.sh
+
sbcl <<EOF
(compile-file "./stress-gc.lisp")
(load *)
(time (stress-gc ${1:-100000} ${2:-3000}))
(format t "~&test completed successfully~%")
+ (quit :unix-status $EXIT_LISP_WIN)
EOF
+check_status_maybe_lose "stress-gc" $?
+exit $EXIT_TEST_WIN
\ No newline at end of file
--- /dev/null
+# To be sourced by shell scripts in the test suite.
+
+# This software is part of the SBCL system. See the README file for
+# more information.
+#
+# While most of SBCL is derived from the CMU CL system, the test
+# files (like this one) were written from scratch after the fork
+# from CMU CL.
+#
+# This software is in the public domain and is provided with
+# absolutely no warranty. See the COPYING and CREDITS files for
+# more information.
+
+# Before sbcl-1.0.13 or so, we set up some environment variables to
+# the absolute (POSIX) pathname naming the SBCL runtime, core, and
+# home; but this runs afoul of the Bourne shell's repeated
+# tokenization of its inputs, so now we use some shell functions.
+. ../sbcl-pwd.sh
+sbcl_pwd
+
+# Make the shell bomb out whenever an unset shell variable is used.
+# Note that scripts may toggle this if necessary.
+set -u
+
+# Initialize variables.
+set -a # export all variables at assignment-time.
+# Note: any script that uses the variables that name files should
+# quote them (with double quotes), to contend with whitespace.
+SBCL_HOME="$SBCL_PWD/../contrib"
+SBCL_CORE="$SBCL_PWD/../output/sbcl.core"
+SBCL_RUNTIME="$SBCL_PWD/../src/runtime/sbcl"
+SBCL_ARGS="--noinform --no-sysinit --no-userinit --noprint --disable-debugger"
+
+# Scripts that use these variables should quote them.
+TEST_BASENAME="$(basename $0)"
+TEST_FILESTEM="$(echo ${TEST_BASENAME%.sh} | sed 's/\./-/g')"
+TEST_DIRECTORY="$SBCL_PWD/$TEST_FILESTEM-$$"
+
+# "Ten four" is the closest numerical slang I can find to "OK", so
+# it's the Unix status value that we expect from a successful test.
+# (Of course, zero is the usual success value, but we don't want to
+# use that because SBCL returns that by default, so we might think
+# we passed a test when in fact some error caused us to exit SBCL
+# in a weird unexpected way. In contrast, 104 is unlikely to be
+# returned unless we exit through the intended explicit "test
+# successful" path.
+EXIT_TEST_WIN=104
+# Shell scripts in this test suite also return 104, so we need a
+# convention for distinguishing successful execution of SBCL in one of
+# our scripts.
+EXIT_LISP_WIN=52
+# Any test that exits with status 1 is an explicit failure.
+EXIT_LOSE=1
+
+LANG=C
+LC_ALL=C
+set +a
+
+run_sbcl () (
+ set -u
+ if [ $# -gt 0 ]; then
+ "$SBCL_RUNTIME" --core "$SBCL_CORE" $SBCL_ARGS "$@"
+ else
+ "$SBCL_RUNTIME" --core "$SBCL_CORE" $SBCL_ARGS
+ fi
+)
+
+run_sbcl_with_core () (
+ set -u
+ core="$1"
+ shift
+ if [ $# -gt 0 ]; then
+ "$SBCL_RUNTIME" --core "$core" "$@"
+ else
+ "$SBCL_RUNTIME" --core "$core" $SBCL_ARGS
+ fi
+)
+
+# Most tests that run an SBCL have to check whether the child's exit
+# status. Our convention is that SBCL exits with status
+# $EXIT_LISP_WIN to indicate a successful run; but some tests can't do
+# this (e.g., ones that end in S-L-A-D), or need to indicate some
+# other ways of succeeding. So this routine takes a test name, the
+# exit status of the child, and then an arbitrary number extra
+# arguments that will be treated as status-code/message pairs for
+# unusual successful ways for the inferior SBCL to exit. If the exit
+# code of the SBCL isn't found in the status-codes, the calling script
+# will exit with a failure code.
+check_status_maybe_lose () {
+ testname=$1
+ status=$2
+ lose=1
+ if [ $status = $EXIT_LISP_WIN ]; then
+ echo "test $testname ok"
+ lose=0
+ else
+ shift; shift;
+ while [ $# -gt 0 ]; do
+ if [ $status = $1 ]; then
+ shift;
+ echo "test $testname ok $1"
+ lose=0
+ break
+ fi
+ shift; shift
+ done
+ fi
+ if [ $lose = 1 ]; then
+ echo "test $testname failed: $status"
+ exit $EXIT_LOSE
+ fi
+ unset lose
+ unset status
+ unset testname
+}
+
+# Not every test needs to touch the file system, but enough do to have
+# them consistently do so in subdirectories. Note that such tests
+# should not change their exit action, or do so only very carefully.
+use_test_subdirectory () {
+ mkdir "$TEST_DIRECTORY"
+ cd "$TEST_DIRECTORY"
+ trap "cleanup_test_subdirectory" EXIT
+}
+
+cleanup_test_subdirectory () {
+ cd "$SBCL_PWD"
+ ( set -f; rm -r "$TEST_DIRECTORY" )
+}
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
+. ./subr.sh
+use_test_subdirectory
+
flag="condition-wait-sigcont.tmp"
touch $flag
-$SBCL --load condition-wait-sigcont.lisp &
+run_sbcl --load "$SBCL_PWD/condition-wait-sigcont.lisp" &
sb_pid=$!
while [ -f $flag ]; do sleep 1; done
# absolutely no warranty. See the COPYING and CREDITS files for
# more information.
-testfile=${TMPDIR:-/tmp}/sbcl-toplevel-test-$$.tmp
+. ./subr.sh
+
+use_test_subdirectory
# Until sbcl-0.pre8, all --eval arguments were parsed before any of
# them were executed, making it impossible for --eval forms to refer
# to packages created by --eval forms.
-${SBCL:-sbcl} --eval "(defpackage :foo)" --eval "(print 'foo::bar)" \
- < /dev/null > $testfile
-if [ "`grep -c FOO::BAR $testfile`" != 1 ] ; then
+run_sbcl --eval "(defpackage :foo)" --eval "(print 'foo::bar)" \
+ < /dev/null > $TEST_FILESTEM
+if [ "`grep -c FOO::BAR $TEST_FILESTEM`" != 1 ] ; then
echo failed DEFPACKAGE-then-PRINT from --eval form
- exit 1
+ exit $EXIT_LOSE
fi
+exit $EXIT_TEST_WIN
\ No newline at end of file
# This file run a regression test for a bug in loading
# forward-referenced layouts.
+. ./subr.sh
+
+use_test_subdirectory
+
FILES='"undefined-classoid-bug-1.lisp" "undefined-classoid-bug-2.lisp"'
FASLS='"undefined-classoid-bug-1.fasl" "undefined-classoid-bug-2.fasl"'
-${SBCL:-sbcl} <<EOF
+for f in $FILES; do
+ (cd "$SBCL_PWD"; cp `eval "echo $f"` "$TEST_DIRECTORY");
+done
+
+run_sbcl <<EOF
(let ((files (list $FILES)))
(mapc #'load files)
(mapc #'compile-file files))
(quit :unix-status 52)
EOF
-${SBCL:-sbcl} <<EOF
+run_sbcl <<EOF
(mapc #'load (list $FASLS))
-(quit :unix-status 52)
+(quit :unix-status $EXIT_LISP_WIN)
EOF
+check_status_maybe_lose undefined-classoid-bug $?
-if [ $? != 52 ]; then
- rm $FASLS
- echo undefined-classoid-bug test failed: $?
- exit 1 # Failure
-fi
-
-# success convention for script
-exit 104
+exit $EXIT_TEST_WIN
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.13"
+"1.0.13.1"
projects / sbcl.git / commitdiff