make-instances-obsolete.lsp 1.58 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat May 17 08:12:35 2003
;;;; Contains: Tests of MAKE-INSTANCES-OBSOLETE

6

7 8 9 10 11 12 13 14

(defclass make-instances-obsolete-class-01 ()
  ((a :initarg :a)
   (b :initarg :b :allocation :class)
   (c :initarg :c :initform 'abc)
   (d :initarg :d :type fixnum :initform 0)))

(deftest make-instances-obsolete.1
15
  (let* ((class-designator 'make-instances-obsolete-class-01)
sds's avatar
sds committed
16 17
         (class (find-class class-designator))
         (obj (make-instance class :a 'x :b 'y :c 'z :d 17)))
18 19 20
    (values
     (eqt (class-of obj) class)
     (map-slot-value obj '(a b c d))
21 22
     (let ((val (make-instances-obsolete class)))
       (or (eqt val class-designator)
sds's avatar
sds committed
23
           (eqt val class)))
24 25 26 27
     (map-slot-value obj '(a b c d))))
  t (x y z 17) t (x y z 17))

(deftest make-instances-obsolete.2
28
  (let* ((class-designator 'make-instances-obsolete-class-01)
sds's avatar
sds committed
29 30
         (class (find-class class-designator))
         (obj (make-instance class :a 'x :b 'y :c 'z :d 17)))
31 32 33
    (values
     (eqt (class-of obj) class)
     (map-slot-value obj '(a b c d))
34 35
     (let ((val (make-instances-obsolete class-designator)))
       (or (eqt val class-designator)
sds's avatar
sds committed
36
           (eqt val class)))
37 38 39 40 41 42
     (map-slot-value obj '(a b c d))))
  t (x y z 17) t (x y z 17))

;;; Error cases

(deftest make-instances-obsolete.error.1
43 44
  (signals-error (make-instances-obsolete) program-error)
  t)
45 46

(deftest make-instances-obsolete.error.2
47
  (signals-error (make-instances-obsolete
sds's avatar
sds committed
48 49 50
                   (find-class 'make-instances-obsolete-class-01)
                   nil)
                 program-error)
51
  t)