1.0.5.51: fixed mixed up commit 1.0.5.50
authorNikodemus Siivola <nikodemus@random-state.net>
Thu, 17 May 2007 20:00:31 +0000 (20:00 +0000)
committerNikodemus Siivola <nikodemus@random-state.net>
Thu, 17 May 2007 20:00:31 +0000 (20:00 +0000)
 * SIMPLE-VECTOR-COMPARE-AND-SWAP, not SAFE-SIMPLE-VECTOR-COMPARE-AND-SWAP.

 * Missing tests.

 * Whitespace.

 * foreign.test.sh jugglery

   This path breaks foreign.test.sh on x86/Darwin even without
   touching it, indicative of still lingering Darwin issues. Any
   number of changes can mask this breakage: adding SAFE- prefix to
   SIMPLE-VECTOR-COMPARE-AND-SWAP is enough to make foreign.test.sh
   pass again, but so is adding a sneaky --eval nil in there as well
   -- among other things.

   Pain. Hate. Pain. See commentary in foreign.test.sh

   This time the issue doesn't seem to be foreign stack alignment
   related, though: forcing the compiler to use the fast call-out path
   always doesn't make the "small" case pass.

src/code/array.lisp
src/runtime/x86-assem.S
tests/array.pure.lisp
tests/foreign.test.sh
version.lisp-expr

index 873a9b7..f41730b 100644 (file)
@@ -56,7 +56,7 @@
         (values vector index))
       (values array index)))
 
-(defun safe-simple-vector-compare-and-swap (vector index old new)
+(defun simple-vector-compare-and-swap (vector index old new)
   #!+(or x86 x86-64)
   (%simple-vector-compare-and-swap vector
                                    (%check-bound vector (length vector) index)
index db4ee94..9470533 100644 (file)
@@ -124,7 +124,7 @@ GNAME(call_into_c):
 
        cld                       # clear out DF: Darwin, Solaris and Win32 at
                                  # least need this, and it should not hurt others
-       
+
        call    *%eax             # normal callout using Lisp stack
        movl    %eax,%ecx         # remember integer return value
 
index f8ed9f5..fe9c4f0 100644 (file)
                   array)
               (type-error ()
                 :good))))
+
+;;; SIMPLE-VECTOR-COMPARE-AND-SWAP
+
+(let ((v (vector 1)))
+  ;; basics
+  (assert (eql 1 (sb-kernel:simple-vector-compare-and-swap v 0 1 2)))
+  (assert (eql 2 (sb-kernel:simple-vector-compare-and-swap v 0 1 3)))
+  (assert (eql 2 (svref v 0)))
+  ;; bounds
+  (multiple-value-bind (res err)
+      (ignore-errors (sb-kernel:simple-vector-compare-and-swap v -1 1 2))
+    (assert (not res))
+    (assert (typep err 'type-error)))
+  (multiple-value-bind (res err)
+      (ignore-errors (sb-kernel:simple-vector-compare-and-swap v 1 1 2))
+    (assert (not res))
+    (assert (typep err 'type-error))))
+
+;; type of the first argument
+(multiple-value-bind (res err)
+    (ignore-errors (sb-kernel:simple-vector-compare-and-swap "foo" 1 1 2))
+    (assert (not res))
+    (assert (typep err 'type-error)))
index 59e28cd..6d78488 100644 (file)
@@ -154,9 +154,9 @@ cat > $testfilestem.base.lisp <<EOF
   ;; that the location will be the same.
   (assert (= (sb-sys:sap-int (alien-sap *environ*))
              (sb-sys:sap-int (alien-sap environ))))
-  (enable-debugger)
+
   ;; automagic restarts
-  (setf *debugger-hook*
+  (setf *invoke-debugger-hook*
         (lambda (condition hook)
           (princ condition)
           (let ((cont (find-restart 'continue condition)))
@@ -174,6 +174,19 @@ cat $testfilestem.base.lisp >> $testfilestem.small.lisp
 
 # Test code
 cat > $testfilestem.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...
+  ;;
+  ;; Other trivialish changes that mask the error include:
+  ;; * loading the .lisp file instead of the .fasl at the save test
+  ;; * --eval 'nil' before loading the .fasl at the save test
+  ;;
+  ;; HATE.
+  (defun note (x)
+     (write-line x *standard-output*)
+     (force-output *standard-output*))
+  (note "/initial assertions")
   (assert (= 31 (summish 10 20)))
   (assert (= 42 numberish))
   (setf numberish 13)
@@ -192,24 +205,27 @@ cat > $testfilestem.test.lisp <<EOF
   (assert (= 1 (long-test2 1 2 3 4 5 6 7 8 9 (+ 1 (ash 1 37)) 15)))
   (assert (= (ash 1 33) (return-long-long)))
 
-  (print :stage-1)
+  (note "/initial assertions ok")
 
   ;; test reloading object file with new definitions
   (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")
+  (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")
-
-  (print :stage-2)
+  (note "/renamed back to originals")
 
   ;; test late resolution
   #+linkage-table
   (progn
+    (note "/starting linkage table tests")
     (define-alien-variable late-foo int)
     (define-alien-routine late-bar int)
     (multiple-value-bind (val err) (ignore-errors late-foo)
@@ -220,9 +236,8 @@ cat > $testfilestem.test.lisp <<EOF
       (assert (typep err 'undefined-alien-error)))
     (load-shared-object "$testfilestem-c.so")
     (assert (= 43 late-foo))
-    (assert (= 14 (late-bar))))
-
-  (print :stage-3)
+    (assert (= 14 (late-bar)))
+    (note "/linkage table ok"))
 
   (sb-ext:quit :unix-status 52) ; success convention for Lisp program
 EOF
@@ -261,7 +276,8 @@ test_use small
 test_use fast
 
 test_save() {
-    ${SBCL:-sbcl} --load $testfilestem.$1.fasl --eval "(when (member :linkage-table *features*) (save-lisp-and-die \"$testfilestem.$1.core\"))" <<EOF
+    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
 EOF
     if [ $? = 22 ]; then
@@ -276,6 +292,7 @@ test_save small
 test_save fast
 
 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.*
index c389fa3..3acc445 100644 (file)
@@ -17,4 +17,4 @@
 ;;; 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.5.50"
+"1.0.5.51"