From: Teemu S. <de...@us...> - 2004-05-14 22:57:48
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24475/tests Modified Files: defstruct.impure.lisp Log Message: 0.8.10.23: Fixed bug 322: ... DEFSTRUCT :TYPE LIST type predicates now work on improper lists. ... Trivially reorganized code to make said predicates traverse the list only once. ... MORE TESTS, of course. Index: defstruct.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/defstruct.impure.lisp,v retrieving revision 1.19 retrieving revision 1.20 diff -u -d -r1.19 -r1.20 --- defstruct.impure.lisp 4 Apr 2004 14:07:25 -0000 1.19 +++ defstruct.impure.lisp 14 May 2004 22:57:30 -0000 1.20 @@ -521,6 +521,27 @@ (eval (copy-tree form)) (eval (copy-tree form))) +;;; 322: "DEFSTRUCT :TYPE LIST predicate and improper lists" +;;; reported by Bruno Haible sbcl-devel "various SBCL bugs" from CLISP +;;; test suite. +(defstruct (bug-332a (:type list) (:initial-offset 5) :named)) +(defstruct (bug-332b (:type list) (:initial-offset 2) :named (:include bug-332a))) +(assert (not (bug-332b-p (list* nil nil nil nil nil 'foo73 nil 'tail)))) +(assert (not (bug-332b-p 873257))) +(assert (not (bug-332b-p '(1 2 3 4 5 x 1 2 bug-332a)))) +(assert (bug-332b-p '(1 2 3 4 5 x 1 2 bug-332b))) + +;;; Similar test for vectors, just for good measure. +(defstruct (bug-332a-aux (:type vector) + (:initial-offset 5) :named)) +(defstruct (bug-332b-aux (:type vector) + (:initial-offset 2) :named + (:include bug-332a-aux))) +(assert (not (bug-332b-aux-p #(1 2 3 4 5 x 1 premature-end)))) +(assert (not (bug-332b-aux-p 873257))) +(assert (not (bug-332b-aux-p #(1 2 3 4 5 x 1 2 bug-332a-aux)))) +(assert (bug-332b-aux-p #(1 2 3 4 5 x 1 2 bug-332b-aux))) + ;;; success (format t "~&/returning success~%") (quit :unix-status 104) |