Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4244/tests
Modified Files:
bit-vector.impure-cload.lisp float.pure.lisp foreign.test.sh
print.impure.lisp smoke.impure.lisp
Log Message:
message
Index: bit-vector.impure-cload.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/bit-vector.impure-cload.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- bit-vector.impure-cload.lisp 6 Jan 2005 12:48:05 -0000 1.3
+++ bit-vector.impure-cload.lisp 13 Feb 2005 14:27:11 -0000 1.4
@@ -16,7 +16,7 @@
(declaim (optimize (speed 3) (safety 1) (space 0) (compilation-speed 0)))
-(defun bit-vector-test ()
+(defun test-small-bit-vectors ()
;; deal with the potential length 0 special case
(let ((a (make-array 0 :element-type 'bit))
(b (make-array 0 :element-type 'bit)))
@@ -31,36 +31,59 @@
(setf (aref b 1) 1) ; b = #*010..0
(assert (equal (bit-xor a b) #*001111111111111111111111111111111))
(assert (equal (bit-and a b) #*010000000000000000000000000000000)))
+ ;; a special COUNT transform on bitvectors; triggers on (>= SPEED SPACE)
+ (locally
+ (declare (optimize (speed 3) (space 1)))
+ (let ((bv1 (make-array 5 :element-type 'bit))
+ (bv2 (make-array 0 :element-type 'bit))
+ (bv3 (make-array 68 :element-type 'bit)))
+ (declare (type simple-bit-vector bv1 bv2 bv3))
+ (setf (sbit bv3 42) 1)
+ ;; bitvector smaller than the word size
+ (assert (= 0 (count 1 bv1)))
+ (assert (= 5 (count 0 bv1)))
+ ;; special case of 0-length bitvectors
+ (assert (= 0 (count 1 bv2)))
+ (assert (= 0 (count 0 bv2)))
+ ;; bitvector larger than the word size
+ (assert (= 1 (count 1 bv3)))
+ (assert (= 67 (count 0 bv3))))))
+
+(defun inform (msg)
+ (print msg)
+ (force-output))
+
+(defun test-big-bit-vectors ()
;; now test the biggy, mostly that it works...
- #-x86-64 ; except on machines where addressable space is likely to be
- ; much bigger than physical memory
- (let ((a (make-array (1- array-dimension-limit) :element-type 'bit :initial-element 0))
- (b (make-array (1- array-dimension-limit) :element-type 'bit :initial-element 0)))
+ (let ((a (progn
+ (inform :make-array-1)
+ (make-array (1- array-dimension-limit)
+ :element-type 'bit :initial-element 0)))
+ (b (progn
+ (inform :make-array-2)
+ (make-array (1- array-dimension-limit)
+ :element-type 'bit :initial-element 0))))
+ (inform :bit-not)
(bit-not a a)
+ (inform :aref-1)
(assert (= (aref a 0) 1))
+ (inform :aref-2)
(assert (= (aref a (- array-dimension-limit 2)) 1))
- (bit-and a b a)
- (assert (= (aref a 0) 0))
- (assert (= (aref a (- array-dimension-limit 2)) 0)))
- ;; a special COUNT transform on bitvectors; triggers on (>= SPEED SPACE)
- (locally
- (declare (optimize (speed 3) (space 1)))
- (let ((bv1 (make-array 5 :element-type 'bit))
- (bv2 (make-array 0 :element-type 'bit))
- (bv3 (make-array 68 :element-type 'bit)))
- (declare (type simple-bit-vector bv1 bv2 bv3))
- (setf (sbit bv3 42) 1)
- ;; bitvector smaller than the word size
- (assert (= 0 (count 1 bv1)))
- (assert (= 5 (count 0 bv1)))
- ;; special case of 0-length bitvectors
- (assert (= 0 (count 1 bv2)))
- (assert (= 0 (count 0 bv2)))
- ;; bitvector larger than the word size
- (assert (= 1 (count 1 bv3)))
- (assert (= 67 (count 0 bv3))))))
+ #-darwin
+ (progn
+ (inform :bit-and)
+ (bit-and a b a)
+ (inform :aref-3)
+ (assert (= (aref a 0) 0))
+ (inform :aref-4)
+ (assert (= (aref a (- array-dimension-limit 2)) 0)))))
-(bit-vector-test)
+(test-small-bit-vectors)
+
+#-x86-64
+;; except on machines where addressable space is likely to be
+;; much bigger than physical memory
+(test-big-bit-vectors)
;;; success
(sb-ext:quit :unix-status 104)
Index: float.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/float.pure.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- float.pure.lisp 14 Jul 2004 06:21:11 -0000 1.13
+++ float.pure.lisp 13 Feb 2005 14:27:11 -0000 1.14
@@ -91,7 +91,9 @@
least-positive-double-float))
(assert (= 0.0 (scale-float 1.0 most-negative-fixnum)))
(assert (= 0.0d0 (scale-float 1.0d0 (1- most-negative-fixnum))))
-(assert (raises-error? (scale-float 1.0 most-positive-fixnum)
- floating-point-overflow))
-(assert (raises-error? (scale-float 1.0d0 (1+ most-positive-fixnum))
- floating-point-overflow))
+#-darwin ;; bug 372
+(progn
+ (assert (raises-error? (scale-float 1.0 most-positive-fixnum)
+ floating-point-overflow))
+ (assert (raises-error? (scale-float 1.0d0 (1+ most-positive-fixnum))
+ floating-point-overflow)))
Index: foreign.test.sh
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/foreign.test.sh,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- foreign.test.sh 1 Feb 2005 03:00:04 -0000 1.19
+++ foreign.test.sh 13 Feb 2005 14:27:11 -0000 1.20
@@ -30,8 +30,13 @@
if [ $(uname -p) = x86_64 ]; then
CFLAGS="$CFLAGS -fPIC"
fi
+ if [ $(uname) = Darwin ]; then
+ SO_FLAGS="-bundle"
+ else
+ SO_FLAGS="-shared"
+ fi
cc -c $1.c -o $1.o $CFLAGS
- ld -shared -o $1.so $1.o
+ ld $SO_FLAGS -o $1.so $1.o
}
echo 'int summish(int x, int y) { return 1 + x + y; }' > $testfilestem.c
@@ -93,7 +98,7 @@
(lambda (condition hook)
(print (list :debugger-hook condition))
(let ((cont (find-restart 'continue condition)))
- (when cont
+ (when cont
(invoke-restart cont)))
(print :fell-through)
(invoke-debugger condition)))
Index: print.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/print.impure.lisp,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -d -r1.30 -r1.31
--- print.impure.lisp 28 Jan 2005 16:49:00 -0000 1.30
+++ print.impure.lisp 13 Feb 2005 14:27:11 -0000 1.31
@@ -274,6 +274,13 @@
(timeout ()
(print 'timeout!)))
+;;; bug 371: bignum print/read inconsistency
+(defvar *bug-371* -7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601)
+(let ((*print-base* 5)
+ (*read-base* 5)
+ (*print-radix* nil))
+ (assert (= *bug-371* (read-from-string (prin1-to-string *bug-371*)))))
+
;;; a spot of random-testing for rational printing
(defvar *seed-state* (make-random-state))
(print *seed-state*) ; so that we can reproduce errors
Index: smoke.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/smoke.impure.lisp,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- smoke.impure.lisp 24 May 2004 13:38:52 -0000 1.9
+++ smoke.impure.lisp 13 Feb 2005 14:27:11 -0000 1.10
@@ -31,13 +31,15 @@
(assert (typep (in-package :cl-user) 'package))
;;; PROFILE should run without obvious breakage
-(defun profiled-fun ()
- (random 1d0))
-(profile profiled-fun)
-(loop repeat 100000 do (profiled-fun))
-(report)
+#-darwin
+(progn
+ (defun profiled-fun ()
+ (random 1d0))
+ (profile profiled-fun)
+ (loop repeat 100000 do (profiled-fun))
+ (report))
-;;; DEFCONSTANT should behave as the documentation specifies,
+;;; Defconstant should behave as the documentation specifies,
;;; including documented condition type.
(defun oidentity (x) x)
(defconstant +const+ 1)
|