Commit 992591db authored by pfdietz's avatar pfdietz
Browse files

Moved tests for + method combination to a better named file, and added tests...

Moved tests for + method combination to a better named file, and added tests for append, nconc, and list method combinations.
parent 6c94f69f
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat May 24 21:31:55 2003
;;;; Contains: Tests of DEFGENERIC with :method-combination APPEND
(in-package :cl-test)
(declaim (special *x*))
(deftest defgeneric-method-combination.append.1
(let ((*x* nil)
(fn
(eval '(defgeneric dg-mc.fun.append.1 (x)
(:method-combination append)
(:method append ((x integer)) (car (push '(d) *x*)))
(:method append ((x rational)) (car (push '(c) *x*)))
(:method append ((x number)) (car (push '(b) *x*)))
(:method append ((x t)) (car (push '(a) *x*)))))))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
(values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
((d c b a) ((a) (b) (c) (d)))
((c b a) ((a) (b) (c)))
((b a) ((a) (b)))
((a) ((a))))
(deftest defgeneric-method-combination.append.2
(let ((*x* nil)
(fn
(eval '(defgeneric dg-mc.fun.append.2 (x)
(:method-combination append :most-specific-first)
(:method append ((x integer)) (car (push '(d) *x*)))
(:method append ((x rational)) (car (push '(c) *x*)))
(:method append ((x number)) (car (push '(b) *x*)))
(:method append ((x t)) (car (push '(a) *x*)))))))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
(values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
((d c b a) ((a) (b) (c) (d)))
((c b a) ((a) (b) (c)))
((b a) ((a) (b)))
((a) ((a))))
(deftest defgeneric-method-combination.append.3
(let ((*x* nil)
(fn
(eval '(defgeneric dg-mc.fun.append.3 (x)
(:method-combination append :most-specific-last)
(:method append ((x integer)) (car (push '(d) *x*)))
(:method append ((x rational)) (car (push '(c) *x*)))
(:method append ((x number)) (car (push '(b) *x*)))
(:method append ((x t)) (car (push '(a) *x*)))))))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
(values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
((a b c d) ((d) (c) (b) (a)))
((a b c) ((c) (b) (a)))
((a b) ((b) (a)))
((a) ((a))))
(deftest defgeneric-method-combination.append.4
(let ((fn
(eval '(defgeneric dg-mc.fun.append.4 (x)
(:method-combination append)
(:method append ((x integer)) '(a b))
(:method :around ((x rational)) 'foo)
(:method append ((x number)) '(c d))
(:method append ((x symbol)) '(e f))
(:method append ((x t)) '(g h))))))
(values
(funcall fn 0)
(funcall fn 4/3)
(funcall fn 1.54)
(funcall fn 'x)
(funcall fn '(a b c))))
foo foo (c d g h) (e f g h) (g h))
(deftest defgeneric-method-combination.append.5
(let ((fn
(eval '(defgeneric dg-mc.fun.append.5 (x)
(:method-combination append)
(:method append ((x integer)) '(a))
(:method :around ((x rational))
(list 'foo (call-next-method)))
(:method append ((x number)) '(b))
(:method append ((x symbol)) '(c))
(:method append ((x t)) 'd)))))
(values
(funcall fn 0)
(funcall fn 4/3)
(funcall fn 1.54)
(funcall fn 'x)
(funcall fn '(a b c))))
(foo (a b . d)) (foo (b . d)) (b . d) (c . d) d)
(deftest defgeneric-method-combination.append.6
(let ((fn
(eval '(defgeneric dg-mc.fun.append.6 (x)
(:method-combination append)
(:method append ((x integer)) '(a))
(:method :around ((x rational))
(list 'foo (call-next-method)))
(:method :around ((x real))
(list 'bar (call-next-method)))
(:method append ((x number)) '(b))
(:method append ((x symbol)) '(c))
(:method append ((x t)) '(d))))))
(values
(funcall fn 0)
(funcall fn 4/3)
(funcall fn 1.54)
(funcall fn #c(1.0 2.0))
(funcall fn 'x)
(funcall fn '(a b c))))
(foo (bar (a b d))) (foo (bar (b d))) (bar (b d)) (b d) (c d) (d))
(deftest defgeneric-method-combination.append.7
(let ((fn
(eval '(defgeneric dg-mc.fun.append.7 (x)
(:method-combination append)
(:method append ((x dgmc-class-04)) '(a))
(:method append ((x dgmc-class-03)) '(b))
(:method append ((x dgmc-class-02)) '(c))
(:method append ((x dgmc-class-01)) '(d))))))
(values
(funcall fn (make-instance 'dgmc-class-01))
(funcall fn (make-instance 'dgmc-class-02))
(funcall fn (make-instance 'dgmc-class-03))
(funcall fn (make-instance 'dgmc-class-04))))
(d)
(c d)
(b d)
(a c b d))
(deftest defgeneric-method-combination.append.8
(let ((fn
(eval '(defgeneric dg-mc.append.8 (x)
(:method-combination append)
(:method append ((x (eql 1000))) '(a))
(:method :around ((x symbol)) (values))
(:method :around ((x integer)) (values 'a 'b 'c))
(:method :around ((x complex)) (call-next-method))
(:method :around ((x number)) (values 1 2 3 4 5 6))
(:method append ((x t)) '(b))))))
(values
(multiple-value-list (funcall fn 'a))
(multiple-value-list (funcall fn 10))
(multiple-value-list (funcall fn #c(9 8)))
(multiple-value-list (funcall fn '(a b c)))))
() (a b c) (1 2 3 4 5 6) ((b)))
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat May 24 21:31:55 2003
;;;; Contains: Tests of DEFGENERIC with :method-combination LIST
(in-package :cl-test)
(declaim (special *x*))
(deftest defgeneric-method-combination.list.1
(let ((*x* nil)
(fn
(eval '(defgeneric dg-mc.fun.list.1 (x)
(:method-combination list)
(:method list ((x integer)) (car (push 'd *x*)))
(:method list ((x rational)) (car (push 'c *x*)))
(:method list ((x number)) (car (push 'b *x*)))
(:method list ((x t)) (car (push 'a *x*)))))))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
(values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
((d c b a) (a b c d))
((c b a) (a b c))
((b a) (a b))
((a) (a)))
(deftest defgeneric-method-combination.list.2
(let ((*x* nil)
(fn
(eval '(defgeneric dg-mc.fun.list.2 (x)
(:method-combination list :most-specific-first)
(:method list ((x integer)) (car (push 'd *x*)))
(:method list ((x rational)) (car (push 'c *x*)))
(:method list ((x number)) (car (push 'b *x*)))
(:method list ((x t)) (car (push 'a *x*)))))))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
(values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
((d c b a) (a b c d))
((c b a) (a b c))
((b a) (a b))
((a) (a)))
(deftest defgeneric-method-combination.list.3
(let ((*x* nil)
(fn
(eval '(defgeneric dg-mc.fun.list.3 (x)
(:method-combination list :most-specific-last)
(:method list ((x integer)) (car (push 'd *x*)))
(:method list ((x rational)) (car (push 'c *x*)))
(:method list ((x number)) (car (push 'b *x*)))
(:method list ((x t)) (car (push 'a *x*)))))))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
(values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
((a b c d) (d c b a))
((a b c) (c b a))
((a b) (b a))
((a) (a)))
(deftest defgeneric-method-combination.list.4
(let ((fn
(eval '(defgeneric dg-mc.fun.list.4 (x)
(:method-combination list)
(:method list ((x integer)) '(a b))
(:method :around ((x rational)) 'foo)
(:method list ((x number)) '(c d))
(:method list ((x symbol)) '(e f))
(:method list ((x t)) '(g h))))))
(values
(funcall fn 0)
(funcall fn 4/3)
(funcall fn 1.54)
(funcall fn 'x)
(funcall fn '(a b c))))
foo foo ((c d) (g h)) ((e f) (g h)) ((g h)))
(deftest defgeneric-method-combination.list.5
(let ((fn
(eval '(defgeneric dg-mc.fun.list.5 (x)
(:method-combination list)
(:method list ((x integer)) 'a)
(:method :around ((x rational))
(list 'foo (call-next-method)))
(:method list ((x number)) 'b)
(:method list ((x symbol)) 'c)
(:method list ((x t)) 'd)))))
(values
(funcall fn 0)
(funcall fn 4/3)
(funcall fn 1.54)
(funcall fn 'x)
(funcall fn '(a b c))))
(foo (a b d)) (foo (b d)) (b d) (c d) (d))
(deftest defgeneric-method-combination.list.6
(let ((fn
(eval '(defgeneric dg-mc.fun.list.6 (x)
(:method-combination list)
(:method list ((x integer)) 'a)
(:method :around ((x rational))
(list 'foo (call-next-method)))
(:method :around ((x real))
(list 'bar (call-next-method)))
(:method list ((x number)) 'b)
(:method list ((x symbol)) 'c)
(:method list ((x t)) 'd)))))
(values
(funcall fn 0)
(funcall fn 4/3)
(funcall fn 1.54)
(funcall fn #c(1.0 2.0))
(funcall fn 'x)
(funcall fn '(a b c))))
(foo (bar (a b d))) (foo (bar (b d))) (bar (b d)) (b d) (c d) (d))
(deftest defgeneric-method-combination.list.7
(let ((fn
(eval '(defgeneric dg-mc.fun.list.7 (x)
(:method-combination list)
(:method list ((x dgmc-class-04)) 'a)
(:method list ((x dgmc-class-03)) 'b)
(:method list ((x dgmc-class-02)) 'c)
(:method list ((x dgmc-class-01)) 'd)))))
(values
(funcall fn (make-instance 'dgmc-class-01))
(funcall fn (make-instance 'dgmc-class-02))
(funcall fn (make-instance 'dgmc-class-03))
(funcall fn (make-instance 'dgmc-class-04))))
(d)
(c d)
(b d)
(a c b d))
(deftest defgeneric-method-combination.list.8
(let ((fn
(eval '(defgeneric dg-mc.list.8 (x)
(:method-combination list)
(:method list ((x (eql 1000))) 'a)
(:method :around ((x symbol)) (values))
(:method :around ((x integer)) (values 'a 'b 'c))
(:method :around ((x complex)) (call-next-method))
(:method :around ((x number)) (values 1 2 3 4 5 6))
(:method list ((x t)) 'b)))))
(values
(multiple-value-list (funcall fn 'a))
(multiple-value-list (funcall fn 10))
(multiple-value-list (funcall fn #c(9 8)))
(multiple-value-list (funcall fn '(a b c)))))
() (a b c) (1 2 3 4 5 6) ((b)))
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat May 24 21:31:55 2003
;;;; Contains: Tests of DEFGENERIC with :method-combination NCONC
(in-package :cl-test)
(declaim (special *x*))
(deftest defgeneric-method-combination.nconc.1
(let ((*x* nil)
(fn
(eval '(defgeneric dg-mc.fun.nconc.1 (x)
(:method-combination nconc)
(:method nconc ((x integer))
(copy-list (car (push '(d) *x*))))
(:method nconc ((x rational))
(copy-list (car (push '(c) *x*))))
(:method nconc ((x number))
(copy-list (car (push '(b) *x*))))
(:method nconc ((x t))
(copy-list (car (push '(a) *x*))))))))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
(values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
((d c b a) ((a) (b) (c) (d)))
((c b a) ((a) (b) (c)))
((b a) ((a) (b)))
((a) ((a))))
(deftest defgeneric-method-combination.nconc.2
(let ((*x* nil)
(fn
(eval '(defgeneric dg-mc.fun.nconc.2 (x)
(:method-combination nconc :most-specific-first)
(:method nconc ((x integer))
(copy-list (car (push '(d) *x*))))
(:method nconc ((x rational))
(copy-list (car (push '(c) *x*))))
(:method nconc ((x number))
(copy-list (car (push '(b) *x*))))
(:method nconc ((x t))
(copy-list (car (push '(a) *x*))))))))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
(values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
((d c b a) ((a) (b) (c) (d)))
((c b a) ((a) (b) (c)))
((b a) ((a) (b)))
((a) ((a))))
(deftest defgeneric-method-combination.nconc.3
(let ((*x* nil)
(fn
(eval '(defgeneric dg-mc.fun.nconc.3 (x)
(:method-combination nconc :most-specific-last)
(:method nconc ((x integer))
(copy-list (car (push '(d) *x*))))
(:method nconc ((x rational))
(copy-list (car (push '(c) *x*))))
(:method nconc ((x number))
(copy-list (car (push '(b) *x*))))
(:method nconc ((x t))
(copy-list (car (push '(a) *x*))))))))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
(values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
((a b c d) ((d) (c) (b) (a)))
((a b c) ((c) (b) (a)))
((a b) ((b) (a)))
((a) ((a))))
(deftest defgeneric-method-combination.nconc.4
(let ((fn
(eval '(defgeneric dg-mc.fun.nconc.4 (x)
(:method-combination nconc)
(:method nconc ((x integer)) (list 'a 'b))
(:method :around ((x rational)) 'foo)
(:method nconc ((x number)) (list 'c 'd))
(:method nconc ((x symbol)) (list 'e 'f))
(:method nconc ((x t)) (list 'g 'h))))))
(values
(funcall fn 0)
(funcall fn 4/3)
(funcall fn 1.54)
(funcall fn 'x)
(funcall fn '(a b c))))
foo foo (c d g h) (e f g h) (g h))
(deftest defgeneric-method-combination.nconc.5
(let ((fn
(eval '(defgeneric dg-mc.fun.nconc.5 (x)
(:method-combination nconc)
(:method nconc ((x integer)) (list 'a))
(:method :around ((x rational))
(list 'foo (call-next-method)))
(:method nconc ((x number)) (list 'b))
(:method nconc ((x symbol)) (list 'c))
(:method nconc ((x t)) (cons 'd 'e))))))
(values
(funcall fn 0)
(funcall fn 4/3)
(funcall fn 1.54)
(funcall fn 'x)
(funcall fn '(a b c))))
(foo (a b d . e)) (foo (b d . e)) (b d . e) (c d . e) (d . e))
(deftest defgeneric-method-combination.nconc.6
(let ((fn
(eval '(defgeneric dg-mc.fun.nconc.6 (x)
(:method-combination nconc)
(:method nconc ((x integer)) (list 'a))
(:method :around ((x rational))
(list 'foo (call-next-method)))
(:method :around ((x real))
(list 'bar (call-next-method)))
(:method nconc ((x number)) (list 'b))
(:method nconc ((x symbol)) (list 'c))
(:method nconc ((x t)) (list 'd))))))
(values
(funcall fn 0)
(funcall fn 4/3)
(funcall fn 1.54)
(funcall fn #c(1.0 2.0))
(funcall fn 'x)
(funcall fn '(a b c))))
(foo (bar (a b d))) (foo (bar (b d))) (bar (b d)) (b d) (c d) (d))
(deftest defgeneric-method-combination.nconc.7
(let ((fn
(eval '(defgeneric dg-mc.fun.nconc.7 (x)
(:method-combination nconc)
(:method nconc ((x dgmc-class-04)) (list 'a))
(:method nconc ((x dgmc-class-03)) (list 'b))
(:method nconc ((x dgmc-class-02)) (list 'c))
(:method nconc ((x dgmc-class-01)) (list 'd))))))
(values
(funcall fn (make-instance 'dgmc-class-01))
(funcall fn (make-instance 'dgmc-class-02))
(funcall fn (make-instance 'dgmc-class-03))
(funcall fn (make-instance 'dgmc-class-04))))
(d)
(c d)
(b d)
(a c b d))
(deftest defgeneric-method-combination.nconc.8
(let ((fn
(eval '(defgeneric dg-mc.nconc.8 (x)
(:method-combination nconc)
(:method nconc ((x (eql 1000))) (list 'a))
(:method :around ((x symbol)) (values))
(:method :around ((x integer)) (values 'a 'b 'c))
(:method :around ((x complex)) (call-next-method))
(:method :around ((x number)) (values 1 2 3 4 5 6))
(:method nconc ((x t)) (list 'b))))))
(values
(multiple-value-list (funcall fn 'a))
(multiple-value-list (funcall fn 10))
(multiple-value-list (funcall fn #c(9 8)))
(multiple-value-list (funcall fn '(a b c)))))
() (a b c) (1 2 3 4 5 6) ((b)))
...@@ -15,7 +15,7 @@ ...@@ -15,7 +15,7 @@
(defclass dgmc-class-06 (dgmc-class-04) ()) (defclass dgmc-class-06 (dgmc-class-04) ())
(defclass dgmc-class-07 (dgmc-class-05 dgmc-class-06) ()) (defclass dgmc-class-07 (dgmc-class-05 dgmc-class-06) ())
(deftest defgeneric-method-combination.1 (deftest defgeneric-method-combination.+.1
(let ((*x* nil) (let ((*x* nil)
(fn (fn
(eval '(defgeneric dg-mc.fun.1 (x) (eval '(defgeneric dg-mc.fun.1 (x)
...@@ -30,7 +30,7 @@ ...@@ -30,7 +30,7 @@
(values (%f 1) (%f 2/3) (%f 1.54) (%f 'a)))) (values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
(15 (1 2 4 8)) (7 (1 2 4)) (3 (1 2)) (1 (1))) (15 (1 2 4 8)) (7 (1 2 4)) (3 (1 2)) (1 (1)))
(deftest defgeneric-method-combination.2 (deftest defgeneric-method-combination.+.2
(let ((*x* nil) (let ((*x* nil)
(fn (fn
(eval '(defgeneric dg-mc.fun.2 (x) (eval '(defgeneric dg-mc.fun.2 (x)
...@@ -45,7 +45,7 @@ ...@@ -45,7 +45,7 @@
(values (%f 1) (%f 2/3) (%f 1.54) (%f 'a)))) (values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
(15 (1 2 4 8)) (7 (1 2 4)) (3 (1 2)) (1 (1))) (15 (1 2 4 8)) (7 (1 2 4)) (3 (1 2)) (1 (1)))
(deftest defgeneric-method-combination.3 (deftest defgeneric-method-combination.+.3
(let ((*x* nil) (let ((*x* nil)
(fn (fn
(eval '(defgeneric dg-mc.fun.3 (x) (eval '(defgeneric dg-mc.fun.3 (x)
...@@ -60,7 +60,7 @@ ...@@ -60,7 +60,7 @@
(values (%f 1) (%f 2/3) (%f 1.54) (%f 'a)))) (values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
(15 (8 4 2 1)) (7 (4 2 1)) (3 (2 1)) (1 (1))) (15 (8 4 2 1)) (7 (4 2 1)) (3 (2 1)) (1 (1)))
(deftest defgeneric-method-combination.4 (deftest defgeneric-method-combination.+.4
(let ((fn (let ((fn
(eval '(defgeneric dg-mc.4 (x) (eval '(defgeneric dg-mc.4 (x)
(:method-combination +) (:method-combination +)
...@@ -77,7 +77,7 @@ ...@@ -77,7 +77,7 @@
(funcall fn '(a b c)))) (funcall fn '(a b c))))
foo foo 5 6 4) foo foo 5 6 4)
(deftest defgeneric-method-combination.5 (deftest defgeneric-method-combination.+.5
(let ((fn (let ((fn
(eval '(defgeneric dg-mc.5 (x) (eval '(defgeneric dg-mc.5 (x)
(:method-combination +) (:method-combination +)
...@@ -95,7 +95,7 @@ ...@@ -95,7 +95,7 @@
(funcall fn '(a b c)))) (funcall fn '(a b c))))
(foo 11) (foo 10) 10 12 8) (foo 11) (foo 10) 10 12 8)
(deftest defgeneric-method-combination.6 (deftest defgeneric-method-combination.+.6
(let ((fn (let ((fn
(eval '(defgeneric dg-mc.6 (x) (eval '(defgeneric dg-mc.6 (x)
(:method-combination +) (:method-combination +)
...@@ -116,7 +116,7 @@ ...@@ -116,7 +116,7 @@
(funcall fn '(a b c)))) (funcall fn '(a b c))))
(foo (bar 11)) (foo (bar 10)) (bar 10) 10 12 8) (foo (bar 11)) (foo (bar 10)) (bar 10) 10 12 8)
(deftest defgeneric-method-combination.7 (deftest defgeneric-method-combination.+.7
(let ((fn (let ((fn
(eval '(defgeneric dg-mc.7 (x) (eval '(defgeneric dg-mc.7 (x)
(:method-combination +) (:method-combination +)
...@@ -131,7 +131,7 @@ ...@@ -131,7 +131,7 @@
(funcall fn (make-instance 'dgmc-class-04)))) (funcall fn (make-instance 'dgmc-class-04))))
8 12 10 15) 8 12 10 15)
(deftest defgeneric-method-combination.8 (deftest defgeneric-method-combination.+.8
(let ((fn (let ((fn
(eval '(defgeneric dg-mc.8 (x) (eval '(defgeneric dg-mc.8 (x)
(:method-combination +) (:method-combination +)
...@@ -147,9 +147,3 @@ ...@@ -147,9 +147,3 @@
(multiple-value-list (funcall fn #c(9 8))) (multiple-value-list (funcall fn #c(9 8)))
(multiple-value-list (funcall fn '(a b c))))) (multiple-value-list (funcall fn '(a b c)))))
() (a b c) (1 2 3 4 5 6) (1)) () (a b c) (1 2 3 4 5 6) (1))
\ No newline at end of file
...@@ -31,5 +31,7 @@ ...@@ -31,5 +31,7 @@
(load "with-accessors.lsp") (load "with-accessors.lsp")
(load "with-slots.lsp") (load "with-slots.lsp")
(load "defgeneric.lsp") (load "defgeneric.lsp")
(load "defgeneric-method-combination.lsp") (load "defgeneric-method-combination-plus.lsp")
(load "defgeneric-method-combination-append.lsp")
(load "defgeneric-method-combination-nconc.lsp")
(load "defgeneric-method-combination-list.lsp")
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment