1 ;;;; Tests related to extended sequences.
3 ;;;; This file is impure because we want to be able to define methods
4 ;;;; implementing the extended sequence protocol.
6 ;;;; This software is part of the SBCL system. See the README file for
9 ;;;; While most of SBCL is derived from the CMU CL system, the test
10 ;;;; files (like this one) were written from scratch after the fork
13 ;;;; This software is in the public domain and is provided with
14 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
15 ;;;; more information.
17 (load "test-util.lisp")
18 (load "assertoid.lisp")
20 ;;; For the following situation:
21 ;;; - result type is a type specifier designating a DEFTYPEd type
22 ;;; - the type expands to a the name of a user-defined sequence class
23 ;;; - not all mandatory sequence protocol methods are define for the
24 ;;; user-define sequence class
25 ;;; MAKE-SEQUENCE used to signal a SIMPLE-TYPE-ERROR referring to the
26 ;;; unexpanded type specifier, instead of signaling a
27 ;;; SEQUENCE:PROTOCOL-UNIMPLEMENTED error.
28 (defclass bug-1315846-simple-sequence
(sequence) ())
30 (deftype bug-1315846-sequence
()
31 'bug-1315846-simple-sequence
)
33 (with-test (:name
(make-sequence deftype
:bug-1315846
))
34 (assert-error (make-sequence 'bug-1315846-sequence
10)
35 sequence
::protocol-unimplemented
))
37 (defclass extended-sequence
(sequence standard-object
) ())
39 (defmethod sequence:length
((sequence extended-sequence
))
42 (defmethod sequence:make-sequence-like
((sequence extended-sequence
) (length t
)
43 &key
&allow-other-keys
)
44 (make-instance 'extended-sequence
))
46 (defmethod (setf sequence
:elt
) ((new-value t
) (sequence extended-sequence
) (index t
))
49 (with-test (:name
(make-sequence :type-specifier class
))
50 (make-sequence (find-class 'extended-sequence
) 3))
52 (with-test (:name
(map make-sequence
:result-creation
))
53 (assert (typep (map 'extended-sequence
#'1+ '(1 2 3)) 'extended-sequence
)))