/[gcl]/gcl/ansi-tests/defgeneric.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/defgeneric.lsp

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

revision 1.8 by pfdietz, Sat May 24 11:37:12 2003 UTC revision 1.9 by pfdietz, Sat May 24 14:31:28 2003 UTC
# Line 368  Line 368 
368        (funcall fn 1)        (funcall fn 1)
369        (funcall fn 'a)        (funcall fn 'a)
370        (funcall fn 1 :foo 2)        (funcall fn 1 :foo 2)
371        (funcall fn 1 :foo 2 :bar 3)        ;; (funcall fn 1 :foo 2 :bar 3)
372        (funcall fn 1 :bar 4)        ;; (funcall fn 1 :bar 4)
373        (funcall fn 'a :foo 'b)        ;; (funcall fn 'a :foo 'b)
374        (funcall fn 'a :bar 'b)        (funcall fn 'a :bar 'b)
375        (funcall fn 'a :foo 'c :bar 'b)))        ;; (funcall fn 'a :foo 'c :bar 'b)
376          ))
377     (1 nil)     (1 nil)
378     (a nil)     (a nil)
379     (1 2)     (1 2)
380     (1 2)     ;; (1 2)
381     (1 nil)     ;; (1 nil)
382     (a nil)     ;; (a nil)
383     (a b)     (a b)
384     (a b))     ;; (a b)
385       )
386    
387   (deftest defgeneric.14   (deftest defgeneric.14
388     (let ((fn (eval '(defgeneric defgeneric.fun.14 (x &key &allow-other-keys)     (let ((fn (eval '(defgeneric defgeneric.fun.14 (x &key &allow-other-keys)
# Line 424  Line 426 
426        (funcall fn 1 :foo 2)        (funcall fn 1 :foo 2)
427        (funcall fn 1 :foo 2 :bar 3)        (funcall fn 1 :foo 2 :bar 3)
428        (funcall fn 1 :bar 4)        (funcall fn 1 :bar 4)
429        (funcall fn 'a :foo 'b)        (funcall fn 'a :allow-other-keys t :foo 'b)
430        (funcall fn 'a :bar 'b)        (funcall fn 'a :bar 'b)
431        (funcall fn 'a :foo 'c :bar 'b)        (funcall fn 'a :foo 'c :bar 'b :allow-other-keys t)
432        (funcall fn 1 :baz 10)        (funcall fn 1 :baz 10)
433        (funcall fn 'a :baz 10)        ;; (funcall fn 'a :baz 10)
434        (funcall fn 1 :allow-other-keys nil :baz 'a)        (funcall fn 1 :allow-other-keys nil :baz 'a)
435        (funcall fn 'a :allow-other-keys nil :baz 'b)        ;; (funcall fn 'a :allow-other-keys nil :baz 'b)
436        ))        ))
437     (1 nil)     (1 nil)
438     (a nil)     (a nil)
# Line 441  Line 443 
443     (a b)     (a b)
444     (a b)     (a b)
445     (1 nil)     (1 nil)
446     (a nil)     ;; (a nil)
447     (1 nil)     (1 nil)
448     (a nil))     ;; (a nil)
449       )
450    
451   (deftest defgeneric.16   (deftest defgeneric.16
452     (let ((fn (eval '(defgeneric defgeneric.fun.16 (x &key)     (let ((fn (eval '(defgeneric defgeneric.fun.16 (x &key)
# Line 532  Line 535 
535     (1 5 t 6 nil)     (1 5 t 6 nil)
536     (1 5 t 9 t))     (1 5 t 9 t))
537    
538    (deftest defgeneric.21
539       (let ((fn (eval '(defgeneric defgeneric.fun.21 (x &key)
540                          (:method ((x number)
541                                    &key (y (1+ x) y-p)
542                                    (z (if y-p (1+ y) (+ x 10))
543                                       z-p))
544                                   (list x y (notnot y-p) z (notnot z-p)))))))
545         (values
546          (funcall fn 1)
547          (funcall fn 1 :y 5)
548          (funcall fn 1 :y 5 :z 9)
549          (funcall fn 1 :z 8)
550          (funcall fn 1 :z 8 :y 4)))
551       (1 2 nil 11 nil)
552       (1 5 t 6 nil)
553       (1 5 t 9 t)
554       (1 2 nil 8 t)
555       (1 4 t 8 t))
556    
557    (deftest defgeneric.22
558       (let ((fn (eval '(defgeneric defgeneric.fun.22 (x &key)
559                          (:method ((x number) &key ((:allow-other-keys y)))
560                                   (list x y))))))
561         (values
562          (funcall fn 1)
563          (funcall fn 1 :allow-other-keys nil)
564          (funcall fn 1 :allow-other-keys t)
565          (funcall fn 1 :foo 'x :allow-other-keys t :bar 'y)
566          (funcall fn 1 :allow-other-keys t :foo 'x)
567          (funcall fn 1 :allow-other-keys nil :allow-other-keys t)
568          (funcall fn 1 :foo 'x :allow-other-keys t :allow-other-keys nil)
569          (funcall fn 1 :allow-other-keys t 'foo 'y :allow-other-keys nil)
570          (funcall fn 1 :allow-other-keys t :allow-other-keys nil '#:foo 'z)))
571       (1 nil)
572       (1 nil)
573       (1 t)
574       (1 t)
575       (1 t)
576       (1 nil)
577       (1 t)
578       (1 t)
579       (1 t))
580    
581    (deftest defgeneric.23
582       (let ((fn (eval '(defgeneric defgeneric.fun.23 (x)
583                          (:method ((x number) &aux (y (1+ x))) (list x y))
584                          (:method ((x symbol) &aux (z (list x))) (list x z))))))
585         (values
586          (funcall fn 1)
587          (funcall fn 'a)))
588       (1 2) (a (a)))
589    
590    
591    (deftest defgeneric.24
592       (let ((fn (eval '(defgeneric defgeneric.fun.24 (x)
593                          (:method ((x number) &aux (y (1+ x)) (z (1+ y)))
594                                   (list x y z))
595                          (:method ((x symbol) &aux (y (list x)) (z (list x y)))
596                                   (list x y z))))))
597         (values
598          (funcall fn 1)
599          (funcall fn 'a)))
600       (1 2 3)
601       (a (a) (a (a))))
602    
603    (deftest defgeneric.25
604      (let ((fn (eval '(defgeneric defgeneric.fun.25 (x &optional y &key)
605                          (:method ((x symbol) &optional (y 'd y-p)
606                                    &key ((:foo bar) (list x y) bar-p)
607                                    &aux (z (list x y (notnot y-p)
608                                                  bar (notnot bar-p))))
609                                   z)))))
610        (values
611         (funcall fn 'a)
612         (funcall fn 'a 'b)
613         (funcall fn 'a 'b :foo 'c)))
614      (a d nil (a d) nil)
615      (a b t (a b) nil)
616      (a b t c t))
617    
618    (deftest defgeneric.26
619      (let ((fn (eval '(defgeneric defgeneric.fun.26 (x)
620                         (declare (optimize (safety 3)))
621                         (:method ((x symbol)) x)
622                         (declare (optimize (debug 3)))))))
623        (funcall fn 'a))
624      a)
625    
626    (defclass substandard-method (standard-method) ())
627    
628    (deftest defgeneric.27
629      (let ((fn (eval '(defgeneric defgeneric.fun.27 (x y)
630                         (:method-class substandard-method)
631                         (:method ((x number) (y number)) (+ x y))
632                         (:method ((x string) (y string))
633                                  (concatenate 'string x y))))))
634        (values
635         (funcall fn 1 2)
636         (funcall fn "1" "2")))
637      3 "12")

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

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