/[gcl]/gcl/ansi-tests/change-class.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/change-class.lsp

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

revision 1.10 by pfdietz, Fri Jun 13 12:01:28 2003 UTC revision 1.11 by pfdietz, Sat Jul 12 13:46:01 2003 UTC
# Line 376  Line 376 
376  (defclass change-class-class-05 ()  (defclass change-class-class-05 ()
377    (a b c))    (a b c))
378    
379  (ignore-errors  (report-and-ignore-errors
380    (defmethod change-class   (defmethod change-class
381      ((obj change-class-class-05)     ((obj change-class-class-05)
382       (new-class (eql (find-class 'change-class-class-05)))      (new-class (eql (find-class 'change-class-class-05)))
383       &rest initargs &key &allow-other-keys)      &rest initargs &key &allow-other-keys)
384      (declare (ignore initargs new-class))     (declare (ignore initargs new-class))
385      (setq *changed-class-on-class-05* t)     (setq *changed-class-on-class-05* t)
386      obj))     obj))
387    
388  (deftest change-class.5  (deftest change-class.5
389    (let ((*changed-class-on-class-05* nil)    (let ((*changed-class-on-class-05* nil)
# Line 398  Line 398 
398  (defclass change-class-class-06 ()  (defclass change-class-class-06 ()
399    ((a :initarg :a) (b :initarg :b) (c :initarg :c)))    ((a :initarg :a) (b :initarg :b) (c :initarg :c)))
400    
401  (ignore-errors  (report-and-ignore-errors
402    (defmethod change-class   (defmethod change-class
403      ((obj change-class-class-06)     ((obj change-class-class-06)
404       (new-class standard-class)      (new-class standard-class)
405       &rest initargs &key &allow-other-keys)      &rest initargs &key &allow-other-keys)
406      (declare (ignore initargs))     (declare (ignore initargs))
407      (setf (slot-value obj 'a) 123)     (setf (slot-value obj 'a) 123)
408      (call-next-method)))     (call-next-method)))
409    
410  (deftest change-class.6.1  (deftest change-class.6.1
411    (let* ((class (find-class 'change-class-class-06))    (let* ((class (find-class 'change-class-class-06))
# Line 446  Line 446 
446    ((a :initform 'aa :initarg :a)    ((a :initform 'aa :initarg :a)
447     (d :initform 'dd :initarg :d)))     (d :initform 'dd :initarg :d)))
448    
449  (ignore-errors  (report-and-ignore-errors
450    (defmethod change-class :before   (defmethod change-class :before
451      ((obj change-class-class-07)     ((obj change-class-class-07)
452       (new-class standard-class)      (new-class standard-class)
453       &rest initargs &key &allow-other-keys)      &rest initargs &key &allow-other-keys)
454      (declare (ignore initargs))     (declare (ignore initargs))
455      (setf (slot-value obj 'a) 'z)     (setf (slot-value obj 'a) 'z)
456      obj))     obj))
457        
458  (deftest change-class.7.1  (deftest change-class.7.1
459    (let* ((class (find-class 'change-class-class-07))    (let* ((class (find-class 'change-class-class-07))
# Line 531  Line 531 
531    
532  ;;; After method  ;;; After method
533    
534  (ignore-errors  (report-and-ignore-errors
535    (defclass change-class-class-08 () ((a :initarg :a) (b :initarg :b))))   (defclass change-class-class-08 ()
536       ((a :initarg :a) (b :initarg :b))))
537  (ignore-errors  
538    (defmethod change-class :after  (report-and-ignore-errors
539      ((obj change-class-class-08)   (defmethod change-class :after
540       (class (eql (find-class 'change-class-class-08)))     ((obj change-class-class-08)
541       &rest initargs &key &allow-other-keys)      (class (eql (find-class 'change-class-class-08)))
542      (declare (ignore initargs))      &rest initargs &key &allow-other-keys)
543      (setf (slot-value obj 'a) 'z)     (declare (ignore initargs))
544      obj))     (setf (slot-value obj 'a) 'z)
545       obj))
546    
547  (deftest change-class.8.1  (deftest change-class.8.1
548    (let* ((class (find-class 'change-class-class-08))    (let* ((class (find-class 'change-class-class-08))

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11

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