X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler-1.impure-cload.lisp;h=eea3feb90121093a89c0529e1c14b65fc9520587;hb=f294da03824843f07d781e655d5a5e70c2c4851e;hp=4d5b1047dc6493cda50238a59dd070e3213e314c;hpb=caf8bb05a82659e688c125b418783bc8a3bd2be8;p=sbcl.git diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp index 4d5b104..eea3feb 100644 --- a/tests/compiler-1.impure-cload.lisp +++ b/tests/compiler-1.impure-cload.lisp @@ -177,19 +177,52 @@ (safe-format t "~&baz ~S (~A) ~S" condition condition result))))))) ;;; bug 231: SETQ did not check the type of the variable being set -(defun bug231-1 (x) +(defun bug231a-1 (x) (declare (optimize safety) (type (integer 0 8) x)) (incf x)) -(assert (raises-error? (bug231-1 8) type-error)) +(assert (raises-error? (bug231a-1 8) type-error)) -(defun bug231-2 (x) +(defun bug231a-2 (x) (declare (optimize safety) (type (integer 0 8) x)) (list (lambda (y) (setq x y)) (lambda () x))) -(destructuring-bind (set get) (bug231-2 0) +(destructuring-bind (set get) (bug231a-2 0) (funcall set 8) (assert (eql (funcall get) 8)) (assert (raises-error? (funcall set 9) type-error)) (assert (eql (funcall get) 8))) +(defun bug231b (x z) + (declare (optimize safety) (type integer x)) + (locally + (declare (type (real 1) x)) + (setq x z)) + (list x z)) +(assert (raises-error? (bug231b nil 1) type-error)) +(assert (raises-error? (bug231b 0 1.5) type-error)) +(assert (raises-error? (bug231b 0 0) type-error)) + +;;; A bug appeared in flaky7_branch. Python got lost in unconverting +;;; embedded tail calls during let-convertion. +(defun bug239 (bit-array-2 &optional result-bit-array) + (declare (type (array bit) bit-array-2) + (type (or (array bit) (member t nil)) result-bit-array)) + (unless (simple-bit-vector-p bit-array-2) + (multiple-value-call + (lambda (data1 start1) + (multiple-value-call + (lambda (data2 start2) + (multiple-value-call + (lambda (data3 start3) + (declare (ignore start3)) + (print (list data1 data2))) + (values 0 0))) + (values bit-array-2 0))) + (values 444 0)))) +(assert (equal (bug239 (make-array 4 :element-type 'bit + :adjustable t + :initial-element 0) + nil) + '(444 #*0000))) + (sb-ext:quit :unix-status 104) ; success