/[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.12 by pfdietz, Tue Jan 7 03:36:44 2003 UTC revision 1.13 by pfdietz, Fri Jan 10 08:21:40 2003 UTC
# Line 364  do the defstruct." Line 364  do the defstruct."
364             `((deftest ,(make-struct-test-name name 9)             `((deftest ,(make-struct-test-name name 9)
365                 ,(let* ((var 'XTEMP-9)                 ,(let* ((var 'XTEMP-9)
366                         (var2 'YTEMP-9)                         (var2 'YTEMP-9)
367                         (var3 'ZTEMP-9))                                         (var3 'ZTEMP-9))        
368                    `(let ((,var (,make-fn                    `(let ((,var (,make-fn
369                                  ,@(loop                                  ,@(loop
370                                     for (slot-name . initval)                                     for (slot-name . initval)
# Line 470  do the defstruct." Line 470  do the defstruct."
470               (let ((doc (documentation ',name 'type)))               (let ((doc (documentation ',name 'type)))
471                 (or (null doc) (equalt doc ',doc-string)))                 (or (null doc) (equalt doc ',doc-string)))
472               t))               t))
473    
474           ;; Test that COPY-STRUCTURE works, if this is a structure
475           ;; type
476           ,@(unless type-option
477               `((deftest ,(make-struct-test-name name 20)
478                   ,(let* ((var 'XTEMP-20)
479                           (var2 'YTEMP-20))
480                      `(let ((,var (,make-fn
481                                    ,@(loop
482                                       for (slot-name . initval)
483                                       in initial-value-alist
484                                       nconc (list (intern (string slot-name)
485                                                           "KEYWORD")
486                                                   `(quote ,initval))))))
487                         (let ((,var2 (copy-structure ,var)))
488                           (and
489                            (not (eqlt ,var ,var2))
490                            ,@(loop
491                               for (slot-name . nil) in initial-value-alist
492                               for fn in field-fns
493                               collect
494                               `(eqlt (,fn ,var) (,fn ,var2)))
495                            t))))
496                   t)))
497         nil         nil
498         )))         )))
499    

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

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