/[gcl]/gcl/ansi-tests/shared-initialize.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/shared-initialize.lsp

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

revision 1.6 by pfdietz, Sat May 3 15:51:22 2003 UTC revision 1.7 by pfdietz, Sat May 3 16:20:43 2003 UTC
# Line 401  Line 401 
401    (t t)    (t t)
402    (117 foo)    (117 foo)
403    (117 foo))    (117 foo))
404    
405    (deftest shared-initialize.5.4
406      (let* ((class (find-class 'shared-init-class-05))
407             (obj (allocate-instance class))
408             (obj2 (allocate-instance class)))
409        (slot-makunbound obj 'a)
410        (values
411         (setf (slot-value obj 'b) 'bar)
412         (eqt obj (shared-initialize obj t :a 117))
413         (map-slot-boundp* obj '(a b))
414         (map-slot-value obj '(a b))
415         (map-slot-value obj2 '(a b))))
416      bar
417      t
418      (t t)
419      (117 bar)
420      (117 bar))
421    
422    ;;; Shared initargs
423    
424    (defclass shared-init-class-06 ()
425      ((a :initarg :i1 :initarg :i2 :initform 'x)
426       (b :initarg :i2 :initarg :i3 :initform 'y)))
427    
428    (deftest shared-initialize.6.1
429      (let* ((class (find-class 'shared-init-class-06))
430             (obj (allocate-instance class)))
431        (values
432         (map-slot-boundp* obj '(a b))
433         (eqt obj (shared-initialize obj nil))
434         (map-slot-boundp* obj '(a b))))
435      (nil nil)
436      t
437      (nil nil))
438    
439    (deftest shared-initialize.6.2
440      (let* ((class (find-class 'shared-init-class-06))
441             (obj (allocate-instance class)))
442        (values
443         (map-slot-boundp* obj '(a b))
444         (eqt obj (shared-initialize obj t))
445         (map-slot-boundp* obj '(a b))
446         (slot-value obj 'a)
447         (slot-value obj 'b)))
448      (nil nil)
449      t
450      (t t)
451      x y)
452    
453    (deftest shared-initialize.6.3
454      (let* ((class (find-class 'shared-init-class-06))
455             (obj (allocate-instance class)))
456        (values
457         (map-slot-boundp* obj '(a b))
458         (eqt obj (shared-initialize obj nil :i1 'z))
459         (map-slot-boundp* obj '(a b))
460         (slot-value obj 'a)))
461      (nil nil)
462      t
463      (t nil)
464      z)
465    
466    (deftest shared-initialize.6.4
467      (let* ((class (find-class 'shared-init-class-06))
468             (obj (allocate-instance class)))
469        (values
470         (map-slot-boundp* obj '(a b))
471         (eqt obj (shared-initialize obj nil :i2 'z))
472         (map-slot-boundp* obj '(a b))
473         (slot-value obj 'a)
474         (slot-value obj 'b)))
475      (nil nil)
476      t
477      (t t)
478      z z)
479    
480    (deftest shared-initialize.6.5
481      (let* ((class (find-class 'shared-init-class-06))
482             (obj (allocate-instance class)))
483        (values
484         (map-slot-boundp* obj '(a b))
485         (eqt obj (shared-initialize obj nil :i1 'w :i2 'z))
486         (map-slot-boundp* obj '(a b))
487         (slot-value obj 'a)
488         (slot-value obj 'b)))
489      (nil nil)
490      t
491      (t t)
492      w z)
493    
494    (deftest shared-initialize.6.6
495      (let* ((class (find-class 'shared-init-class-06))
496             (obj (allocate-instance class)))
497        (values
498         (map-slot-boundp* obj '(a b))
499         (eqt obj (shared-initialize obj nil :i2 'z :i1 'w))
500         (map-slot-boundp* obj '(a b))
501         (slot-value obj 'a)
502         (slot-value obj 'b)))
503      (nil nil)
504      t
505      (t t)
506      z z)
507    
508    (deftest shared-initialize.6.7
509      (let* ((class (find-class 'shared-init-class-06))
510             (obj (allocate-instance class)))
511        (values
512         (map-slot-boundp* obj '(a b))
513         (eqt obj (shared-initialize obj nil :i2 'z :i2 'w))
514         (map-slot-boundp* obj '(a b))
515         (slot-value obj 'a)
516         (slot-value obj 'b)))
517      (nil nil)
518      t
519      (t t)
520      z z)
521    
522    
523    (deftest shared-initialize.6.8
524      (let* ((class (find-class 'shared-init-class-06))
525             (obj (allocate-instance class)))
526        (values
527         (map-slot-boundp* obj '(a b))
528         (eqt obj (shared-initialize obj nil :i2 'z :i2 'w :foo t))
529         (map-slot-boundp* obj '(a b))
530         (slot-value obj 'a)
531         (slot-value obj 'b)))
532      (nil nil)
533      t
534      (t t)
535      z z)
536    
537    
538    (deftest shared-initialize.6.9
539      (let* ((class (find-class 'shared-init-class-06))
540             (obj (allocate-instance class)))
541        (values
542         (map-slot-boundp* obj '(a b))
543         (eqt obj (shared-initialize obj nil :allow-other-keys nil
544                                     :i2 'z :i2 'w :foo t))
545         (map-slot-boundp* obj '(a b))
546         (slot-value obj 'a)
547         (slot-value obj 'b)))
548      (nil nil)
549      t
550      (t t)
551      z z)
552    
553    ;;; Error tests
554    
555    (deftest shared-initialize.error.1
556      (classify-error (shared-initialize))
557      program-error)
558    
559    (deftest shared-initialize.error.2
560      (classify-error (let ((obj (allocate-instance
561                                  (find-class 'shared-init-class-01))))
562                        (shared-initialize obj)))
563      program-error)
564    
565    (deftest shared-initialize.error.3
566      (classify-error (let ((obj (allocate-instance
567                                  (find-class 'shared-init-class-01))))
568                        (shared-initialize obj nil :a)))
569      program-error)
570    
571    (deftest shared-initialize.error.4
572      (classify-error (let ((obj (allocate-instance
573                                  (find-class 'shared-init-class-01))))
574                        (shared-initialize obj nil '(a b c) nil)))
575      program-error)
576    
577    
578    
579    
580    

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