/[gcl]/gcl/ansi-tests/structure-00.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/structure-00.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by pfdietz, Thu Sep 26 16:53:38 2002 UTC revision 1.2 by pfdietz, Thu Oct 17 13:16:56 2002 UTC
# Line 49  Line 49 
49    "Return an instance of a type.  Signal an error if    "Return an instance of a type.  Signal an error if
50    it can't figure out a value for the type."    it can't figure out a value for the type."
51    (cond    (cond
52     ((eq type t)  ;; anything     ((eqt type t)  ;; anything
53      'a)      'a)
54     ((eq type 'symbol)     ((eqt type 'symbol)
55      'b)      'b)
56     ((eq type 'null) nil)     ((eqt type 'null) nil)
57     ((eq type 'boolean) t)     ((eqt type 'boolean) t)
58     ((eq type 'keyword) :foo)     ((eqt type 'keyword) :foo)
59     ((eq type nil) (error "Cannot obtain element of type ~S~%" type))     ((eqt type nil) (error "Cannot obtain element of type ~S~%" type))
60     ((eq type 'cons) (cons 'a 'b))     ((eqt type 'cons) (cons 'a 'b))
61     ((eq type 'list) (list 1 2 3))     ((eqt type 'list) (list 1 2 3))
62     ((eq type 'fixnum) 17)     ((eqt type 'fixnum) 17)
63     ((eq type 'bignum)     ((eqt type 'bignum)
64      (let ((x 1))      (let ((x 1))
65        (loop until (typep x 'bignum)        (loop until (typep x 'bignum)
66            do (setq x (* 2 x)))            do (setq x (* 2 x)))
# Line 71  Line 71 
71             (intern (concatenate 'string "MAKE-" (symbol-name type))             (intern (concatenate 'string "MAKE-" (symbol-name type))
72                     (symbol-package type))))                     (symbol-package type))))
73        (eval (list make-fn))))        (eval (list make-fn))))
74     ((eq type 'character) #\w)     ((eqt type 'character) #\w)
75     ((eq type 'base-char) #\z)     ((eqt type 'base-char) #\z)
76     ((member type '(integer unsigned-byte signed-byte)) 35)     ((member type '(integer unsigned-byte signed-byte)) 35)
77     ((eq type 'bit) 1)     ((eqt type 'bit) 1)
78     ((and (consp type)     ((and (consp type)
79           (consp (cdr type))           (consp (cdr type))
80           (consp (cddr type))           (consp (cddr type))
81           (null (cdddr type))           (null (cdddr type))
82           (eq (car type) 'integer)           (eqt (car type) 'integer)
83           (integerp (second type)))           (integerp (second type)))
84      (second type))      (second type))
85     ((member type '(float single-float long-float double-float short-float))     ((member type '(float single-float long-float double-float short-float))
86      0.0)      0.0)
87     ((and (consp type)     ((and (consp type)
88           (eq (car type) 'member)           (eqt (car type) 'member)
89           (consp (cdr type)))           (consp (cdr type)))
90      (second type))      (second type))
91     ((and (consp type)     ((and (consp type)
92           (eq (car type) 'or)           (eqt (car type) 'or)
93           (consp (second type)))           (consp (second type)))
94      (create-instance-of-type (second type)))      (create-instance-of-type (second type)))
95     (t (error "Cannot generate element for type ~S~%" type))))     (t (error "Cannot generate element for type ~S~%" type))))
# Line 191  do the defstruct." Line 191  do the defstruct."
191           ;; Check that two invocations return different structures           ;; Check that two invocations return different structures
192           (deftest ,(make-struct-test-name name 6)           (deftest ,(make-struct-test-name name 6)
193               ,(let ((make-fn (make-struct-make-fn name)))               ,(let ((make-fn (make-struct-make-fn name)))
194                  `(eq (,make-fn) (,make-fn)))                  `(eqt (,make-fn) (,make-fn)))
195             nil)             nil)
196                    
197           ;; Check that we can setf the fields           ;; Check that we can setf the fields

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26