/[gcl]/gcl/ansi-tests/defclass-aux.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/defclass-aux.lsp

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

revision 1.6 by pfdietz, Tue Apr 15 12:13:50 2003 UTC revision 1.7 by pfdietz, Mon Apr 21 12:20:33 2003 UTC
# Line 112  Line 112 
112           (initforms           (initforms
113            (loop for slot-option in slot-options            (loop for slot-option in slot-options
114                  collect (collect-properties slot-option :initform)))                  collect (collect-properties slot-option :initform)))
115             (class-var-name
116              (intern (concatenate 'string "*CLASS-" (symbol-name class-name)
117                                   "-RETURNED-BY-DEFCLASS*")
118                      (find-package :cl-test)))
119           )           )
120    
121      (declare (ignorable readers writers accessors allocations      (declare (ignorable readers writers accessors allocations
# Line 161  Line 165 
165        (setf (gethash class-name *my-classes*) my-class-obj))        (setf (gethash class-name *my-classes*) my-class-obj))
166    
167      `(progn      `(progn
168           (declaim (special ,class-var-name))
169          
170         (eval-when (load eval compile)         (eval-when (load eval compile)
171           (ignore-errors (defclass ,@(cdr args))))           (ignore-errors (setq ,class-var-name (defclass ,@(cdr args)))))
172    
173           (deftest ,(make-defclass-test-name class-name "-DEFCLASS-RETURNS-CLASS")
174             (eqt (find-class ',class-name) ,class-var-name)
175             t)
176    
177         (deftest ,(make-defclass-test-name class-name         (deftest ,(make-defclass-test-name class-name
178                                            "-IS-IN-ITS-METACLASS")                                            "-IS-IN-ITS-METACLASS")

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

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