Skip to content
Snippets Groups Projects
Commit ec263a66 authored by pfdietz's avatar pfdietz
Browse files

Begin adding notes. Add declarations to method combination tests to avoid...

Begin adding notes.  Add declarations to method combination tests to avoid sbcl warnings.  More last/butlast/nbutlast tests.
parent 4e7ce9bb
No related branches found
No related tags found
No related merge requests found
Showing
with 151 additions and 2 deletions
......@@ -49,6 +49,14 @@
(butlast '(a b c d e) (1+ most-positive-fixnum))
nil)
(deftest butlast.7
(butlast '(a b c d e) most-positive-fixnum)
nil)
(deftest butlast.8
(butlast '(a b c d e) (1- most-positive-fixnum))
nil)
(deftest butlast.order.1
(let ((i 0) x y)
(values
......
......@@ -16,6 +16,7 @@
(:method and ((x rational)) (push 3 *x*) nil)
(:method and ((x number)) (push 2 *x*) t)
(:method and ((x t)) (push 1 *x*) 'a)))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -34,6 +35,7 @@
(:method and ((x rational)) (push 3 *x*) nil)
(:method and ((x number)) (push 2 *x*) t)
(:method and ((x t)) (push 1 *x*) 'a)))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -52,6 +54,7 @@
(:method and ((x rational)) (push 3 *x*) nil)
(:method and ((x number)) (push 2 *x*) 'a)
(:method and ((x t)) (push 1 *x*) t)))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -70,6 +73,7 @@
(:method and ((x number)) nil)
(:method and ((x symbol)) t)
(:method and ((x t)) 'a)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -88,6 +92,7 @@
(:method and ((x number)) 'a)
(:method and ((x symbol)) 'b)
(:method and ((x t)) 'c)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -108,6 +113,7 @@
(:method and ((x number)) nil)
(:method and ((x symbol)) 'c)
(:method and ((x t)) 'd)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -125,6 +131,7 @@
(:method and ((x dgmc-class-03)) 'b)
(:method and ((x dgmc-class-02)) nil)
(:method and ((x dgmc-class-01)) 'a)))))
(declare (type generic-function fn))
(values
(funcall fn (make-instance 'dgmc-class-01))
(funcall fn (make-instance 'dgmc-class-02))
......@@ -142,6 +149,7 @@
(:method :around ((x complex)) (call-next-method))
(:method :around ((x number)) (values 1 2 3 4 5 6))
(:method and ((x t)) 'b)))))
(declare (type generic-function fn))
(values
(multiple-value-list (funcall fn 'a))
(multiple-value-list (funcall fn 10))
......@@ -153,6 +161,7 @@
(handler-case
(let ((fn (eval '(defgeneric dg-mc.and.9 (x)
(:method-combination and)))))
(declare (type generic-function fn))
(funcall fn 'x))
(error () :error))
:error)
......@@ -178,6 +187,7 @@
(:method-combination and)
(:method :around ((x t)) t)
(:method and ((x integer)) x)))))
(declare (type generic-function fn))
(handler-case (funcall fn 'x)
(error () :error)))
:error)
......
......@@ -16,6 +16,7 @@
(:method append ((x rational)) (car (push '(c) *x*)))
(:method append ((x number)) (car (push '(b) *x*)))
(:method append ((x t)) (car (push '(a) *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -34,6 +35,7 @@
(:method append ((x rational)) (car (push '(c) *x*)))
(:method append ((x number)) (car (push '(b) *x*)))
(:method append ((x t)) (car (push '(a) *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -52,6 +54,7 @@
(:method append ((x rational)) (car (push '(c) *x*)))
(:method append ((x number)) (car (push '(b) *x*)))
(:method append ((x t)) (car (push '(a) *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -70,6 +73,7 @@
(:method append ((x number)) '(c d))
(:method append ((x symbol)) '(e f))
(:method append ((x t)) '(g h))))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -88,6 +92,7 @@
(:method append ((x number)) '(b))
(:method append ((x symbol)) '(c))
(:method append ((x t)) 'd)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -108,6 +113,7 @@
(:method append ((x number)) '(b))
(:method append ((x symbol)) '(c))
(:method append ((x t)) '(d))))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -125,6 +131,7 @@
(:method append ((x dgmc-class-03)) '(b))
(:method append ((x dgmc-class-02)) '(c))
(:method append ((x dgmc-class-01)) '(d))))))
(declare (type generic-function fn))
(values
(funcall fn (make-instance 'dgmc-class-01))
(funcall fn (make-instance 'dgmc-class-02))
......@@ -145,6 +152,7 @@
(:method :around ((x complex)) (call-next-method))
(:method :around ((x number)) (values 1 2 3 4 5 6))
(:method append ((x t)) '(b))))))
(declare (type generic-function fn))
(values
(multiple-value-list (funcall fn 'a))
(multiple-value-list (funcall fn 10))
......@@ -156,6 +164,7 @@
(handler-case
(let ((fn (eval '(defgeneric dg-mc.append.9 (x)
(:method-combination append)))))
(declare (type generic-function fn))
(funcall fn '(a)))
(error () :error))
:error)
......@@ -181,6 +190,7 @@
(:method-combination append)
(:method :around ((x t)) '(a))
(:method append ((x integer)) x)))))
(declare (type generic-function fn))
(handler-case (funcall fn '(b))
(error () :error)))
:error)
......@@ -16,6 +16,7 @@
(:method list ((x rational)) (car (push 'c *x*)))
(:method list ((x number)) (car (push 'b *x*)))
(:method list ((x t)) (car (push 'a *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -34,6 +35,7 @@
(:method list ((x rational)) (car (push 'c *x*)))
(:method list ((x number)) (car (push 'b *x*)))
(:method list ((x t)) (car (push 'a *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -52,6 +54,7 @@
(:method list ((x rational)) (car (push 'c *x*)))
(:method list ((x number)) (car (push 'b *x*)))
(:method list ((x t)) (car (push 'a *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -70,6 +73,7 @@
(:method list ((x number)) '(c d))
(:method list ((x symbol)) '(e f))
(:method list ((x t)) '(g h))))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -88,6 +92,7 @@
(:method list ((x number)) 'b)
(:method list ((x symbol)) 'c)
(:method list ((x t)) 'd)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -108,6 +113,7 @@
(:method list ((x number)) 'b)
(:method list ((x symbol)) 'c)
(:method list ((x t)) 'd)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -125,6 +131,7 @@
(:method list ((x dgmc-class-03)) 'b)
(:method list ((x dgmc-class-02)) 'c)
(:method list ((x dgmc-class-01)) 'd)))))
(declare (type generic-function fn))
(values
(funcall fn (make-instance 'dgmc-class-01))
(funcall fn (make-instance 'dgmc-class-02))
......@@ -145,6 +152,7 @@
(:method :around ((x complex)) (call-next-method))
(:method :around ((x number)) (values 1 2 3 4 5 6))
(:method list ((x t)) 'b)))))
(declare (type generic-function fn))
(values
(multiple-value-list (funcall fn 'a))
(multiple-value-list (funcall fn 10))
......@@ -156,6 +164,7 @@
(handler-case
(let ((fn (eval '(defgeneric dg-mc.list.9 (x)
(:method-combination list)))))
(declare (type generic-function fn))
(funcall fn (list 'a)))
(error () :error))
:error)
......@@ -181,6 +190,7 @@
(:method-combination list)
(:method :around ((x t)) (list 'a))
(:method list ((x integer)) x)))))
(declare (type generic-function fn))
(handler-case (funcall fn (list 'b))
(error () :error)))
:error)
......@@ -16,6 +16,7 @@
(:method max ((x rational)) (car (push 4 *x*)))
(:method max ((x number)) (car (push 2 *x*)))
(:method max ((x t)) (car (push 1 *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -31,6 +32,7 @@
(:method max ((x rational)) (car (push 4 *x*)))
(:method max ((x number)) (car (push 2 *x*)))
(:method max ((x t)) (car (push 1 *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -46,6 +48,7 @@
(:method max ((x rational)) (car (push 4 *x*)))
(:method max ((x number)) (car (push 2 *x*)))
(:method max ((x t)) (car (push 1 *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -61,6 +64,7 @@
(:method max ((x number)) 3)
(:method max ((x symbol)) 5)
(:method max ((x t)) 1)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -79,6 +83,7 @@
(:method max ((x number)) 5/2)
(:method max ((x symbol)) 4)
(:method max ((x t)) 1.0)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -99,6 +104,7 @@
(:method max ((x number)) 4)
(:method max ((x symbol)) 6)
(:method max ((x t)) 1)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -116,6 +122,7 @@
(:method max ((x dgmc-class-03)) 3)
(:method max ((x dgmc-class-02)) 5)
(:method max ((x dgmc-class-01)) 1)))))
(declare (type generic-function fn))
(values
(funcall fn (make-instance 'dgmc-class-01))
(funcall fn (make-instance 'dgmc-class-02))
......@@ -133,6 +140,7 @@
(:method :around ((x complex)) (call-next-method))
(:method :around ((x number)) (values 1 2 3 4 5 6))
(:method max ((x t)) 1)))))
(declare (type generic-function fn))
(values
(multiple-value-list (funcall fn 'a))
(multiple-value-list (funcall fn 10))
......@@ -144,6 +152,7 @@
(handler-case
(let ((fn (eval '(defgeneric dg-mc.max.9 (x)
(:method-combination max)))))
(declare (type generic-function fn))
(funcall fn (list 'a)))
(error () :error))
:error)
......@@ -169,6 +178,7 @@
(:method-combination max)
(:method :around ((x t)) 1)
(:method max ((x integer)) x)))))
(declare (type generic-function fn))
(handler-case (funcall fn 'a)
(error () :error)))
:error)
......@@ -16,6 +16,7 @@
(:method min ((x rational)) (car (push 2 *x*)))
(:method min ((x number)) (car (push 3 *x*)))
(:method min ((x t)) (car (push 4 *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -31,6 +32,7 @@
(:method min ((x rational)) (car (push 2 *x*)))
(:method min ((x number)) (car (push 3 *x*)))
(:method min ((x t)) (car (push 4 *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -46,6 +48,7 @@
(:method min ((x rational)) (car (push 2 *x*)))
(:method min ((x number)) (car (push 3 *x*)))
(:method min ((x t)) (car (push 4 *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -61,6 +64,7 @@
(:method min ((x number)) 2)
(:method min ((x symbol)) 3)
(:method min ((x t)) 4)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -79,6 +83,7 @@
(:method min ((x number)) 2)
(:method min ((x symbol)) 4)
(:method min ((x t)) 8)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -99,6 +104,7 @@
(:method min ((x number)) 2)
(:method min ((x symbol)) 4)
(:method min ((x t)) 8)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -116,6 +122,7 @@
(:method min ((x dgmc-class-03)) 2)
(:method min ((x dgmc-class-02)) 4)
(:method min ((x dgmc-class-01)) 8)))))
(declare (type generic-function fn))
(values
(funcall fn (make-instance 'dgmc-class-01))
(funcall fn (make-instance 'dgmc-class-02))
......@@ -133,6 +140,7 @@
(:method :around ((x complex)) (call-next-method))
(:method :around ((x number)) (values 1 2 3 4 5 6))
(:method min ((x t)) 1)))))
(declare (type generic-function fn))
(values
(multiple-value-list (funcall fn 'a))
(multiple-value-list (funcall fn 10))
......@@ -144,6 +152,7 @@
(handler-case
(let ((fn (eval '(defgeneric dg-mc.min.9 (x)
(:method-combination min)))))
(declare (type generic-function fn))
(funcall fn (list 'a)))
(error () :error))
:error)
......@@ -169,6 +178,7 @@
(:method-combination min)
(:method :around ((x t)) 1)
(:method min ((x integer)) x)))))
(declare (type generic-function fn))
(handler-case (funcall fn 'a)
(error () :error)))
:error)
......
......@@ -20,6 +20,7 @@
(copy-list (car (push '(b) *x*))))
(:method nconc ((x t))
(copy-list (car (push '(a) *x*))))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -42,6 +43,7 @@
(copy-list (car (push '(b) *x*))))
(:method nconc ((x t))
(copy-list (car (push '(a) *x*))))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -64,6 +66,7 @@
(copy-list (car (push '(b) *x*))))
(:method nconc ((x t))
(copy-list (car (push '(a) *x*))))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -82,6 +85,7 @@
(:method nconc ((x number)) (list 'c 'd))
(:method nconc ((x symbol)) (list 'e 'f))
(:method nconc ((x t)) (list 'g 'h))))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -100,6 +104,7 @@
(:method nconc ((x number)) (list 'b))
(:method nconc ((x symbol)) (list 'c))
(:method nconc ((x t)) (cons 'd 'e))))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -120,6 +125,7 @@
(:method nconc ((x number)) (list 'b))
(:method nconc ((x symbol)) (list 'c))
(:method nconc ((x t)) (list 'd))))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -137,6 +143,7 @@
(:method nconc ((x dgmc-class-03)) (list 'b))
(:method nconc ((x dgmc-class-02)) (list 'c))
(:method nconc ((x dgmc-class-01)) (list 'd))))))
(declare (type generic-function fn))
(values
(funcall fn (make-instance 'dgmc-class-01))
(funcall fn (make-instance 'dgmc-class-02))
......@@ -157,6 +164,7 @@
(:method :around ((x complex)) (call-next-method))
(:method :around ((x number)) (values 1 2 3 4 5 6))
(:method nconc ((x t)) (list 'b))))))
(declare (type generic-function fn))
(values
(multiple-value-list (funcall fn 'a))
(multiple-value-list (funcall fn 10))
......@@ -168,6 +176,7 @@
(handler-case
(let ((fn (eval '(defgeneric dg-mc.nconc.9 (x)
(:method-combination nconc)))))
(declare (type generic-function fn))
(funcall fn (list 'a)))
(error () :error))
:error)
......@@ -193,6 +202,7 @@
(:method-combination nconc)
(:method :around ((x t)) (list 'a))
(:method nconc ((x integer)) x)))))
(declare (type generic-function fn))
(handler-case (funcall fn (list 'b))
(error () :error)))
:error)
......@@ -16,6 +16,7 @@
(:method or ((x rational)) (push 3 *x*) nil)
(:method or ((x number)) (push 2 *x*) nil)
(:method or ((x t)) (push 1 *x*) 'a)))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -34,6 +35,7 @@
(:method or ((x rational)) (push 3 *x*) 'a)
(:method or ((x number)) (push 2 *x*) nil)
(:method or ((x t)) (push 1 *x*) 'b)))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -49,6 +51,7 @@
(:method or ((x rational)) (push 3 *x*) nil)
(:method or ((x number)) (push 2 *x*) nil)
(:method or ((x t)) (push 1 *x*) nil)))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -64,6 +67,7 @@
(:method or ((x number)) 'b)
(:method or ((x symbol)) nil)
(:method or ((x t)) 'a)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -82,6 +86,7 @@
(:method or ((x number)) nil)
(:method or ((x symbol)) 'b)
(:method or ((x t)) 'c)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -102,6 +107,7 @@
(:method or ((x number)) 'b)
(:method or ((x symbol)) 'c)
(:method or ((x t)) 'd)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -119,6 +125,7 @@
(:method or ((x dgmc-class-03)) nil)
(:method or ((x dgmc-class-02)) 'b)
(:method or ((x dgmc-class-01)) 'c)))))
(declare (type generic-function fn))
(values
(funcall fn (make-instance 'dgmc-class-01))
(funcall fn (make-instance 'dgmc-class-02))
......@@ -136,6 +143,7 @@
(:method :around ((x complex)) (call-next-method))
(:method :around ((x number)) (values 1 2 3 4 5 6))
(:method or ((x t)) 'b)))))
(declare (type generic-function fn))
(values
(multiple-value-list (funcall fn 'a))
(multiple-value-list (funcall fn 10))
......@@ -147,6 +155,7 @@
(handler-case
(let ((fn (eval '(defgeneric dg-mc.or.9 (x)
(:method-combination or)))))
(declare (type generic-function fn))
(funcall fn (list 'a)))
(error () :error))
:error)
......@@ -172,6 +181,7 @@
(:method-combination or)
(:method :around ((x t)) t)
(:method or ((x integer)) x)))))
(declare (type generic-function fn))
(handler-case (funcall fn 'a)
(error () :error)))
:error)
......@@ -16,6 +16,7 @@
(:method + ((x rational)) (car (push 4 *x*)))
(:method + ((x number)) (car (push 2 *x*)))
(:method + ((x t)) (car (push 1 *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -31,6 +32,7 @@
(:method + ((x rational)) (car (push 4 *x*)))
(:method + ((x number)) (car (push 2 *x*)))
(:method + ((x t)) (car (push 1 *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -46,6 +48,7 @@
(:method + ((x rational)) (car (push 4 *x*)))
(:method + ((x number)) (car (push 2 *x*)))
(:method + ((x t)) (car (push 1 *x*)))))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -61,6 +64,7 @@
(:method + ((x number)) 1)
(:method + ((x symbol)) 2)
(:method + ((x t)) 4)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -79,6 +83,7 @@
(:method + ((x number)) 2)
(:method + ((x symbol)) 4)
(:method + ((x t)) 8)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -99,6 +104,7 @@
(:method + ((x number)) 2)
(:method + ((x symbol)) 4)
(:method + ((x t)) 8)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -116,6 +122,7 @@
(:method + ((x dgmc-class-03)) 2)
(:method + ((x dgmc-class-02)) 4)
(:method + ((x dgmc-class-01)) 8)))))
(declare (type generic-function fn))
(values
(funcall fn (make-instance 'dgmc-class-01))
(funcall fn (make-instance 'dgmc-class-02))
......@@ -133,6 +140,7 @@
(:method :around ((x complex)) (call-next-method))
(:method :around ((x number)) (values 1 2 3 4 5 6))
(:method + ((x t)) 1)))))
(declare (type generic-function fn))
(values
(multiple-value-list (funcall fn 'a))
(multiple-value-list (funcall fn 10))
......@@ -144,6 +152,7 @@
(handler-case
(let ((fn (eval '(defgeneric dg-mc.+.9 (x)
(:method-combination +)))))
(declare (type generic-function fn))
(funcall fn (list 'a)))
(error () :error))
:error)
......@@ -169,6 +178,7 @@
(:method-combination +)
(:method :around ((x t)) 1)
(:method + ((x integer)) x)))))
(declare (type generic-function fn))
(handler-case (funcall fn 'a)
(error () :error)))
:error)
......
......@@ -16,6 +16,7 @@
(:method progn ((x rational)) (push 3 *x*) nil)
(:method progn ((x number)) (push 2 *x*) nil)
(:method progn ((x t)) (push 1 *x*) 'a)))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -34,6 +35,7 @@
(:method progn ((x rational)) (push 3 *x*) 'b)
(:method progn ((x number)) (push 2 *x*) 'c)
(:method progn ((x t)) (push 1 *x*) 'd)))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -52,6 +54,7 @@
(:method progn ((x rational)) (push 3 *x*) 'b)
(:method progn ((x number)) (push 2 *x*) 'c)
(:method progn ((x t)) (push 1 *x*) 'd)))))
(declare (type generic-function fn))
(flet ((%f (y)
(let ((*x* nil))
(list (funcall fn y) *x*))))
......@@ -70,6 +73,7 @@
(:method progn ((x number)) 'b)
(:method progn ((x symbol)) 'c)
(:method progn ((x t)) 'a)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -87,6 +91,7 @@
(:method progn ((x number)) 'b)
(:method progn ((x symbol)) 'c)
(:method progn ((x t)) 'a)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -105,6 +110,7 @@
(:method progn ((x number)) nil)
(:method progn ((x symbol)) 'b)
(:method progn ((x t)) 'c)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -123,6 +129,7 @@
(:method progn ((x number)) 'e)
(:method progn ((x symbol)) 'b)
(:method progn ((x t)) 'c)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -144,6 +151,7 @@
(:method progn ((x number)) 'b)
(:method progn ((x symbol)) 'c)
(:method progn ((x t)) 'd)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -165,6 +173,7 @@
(:method progn ((x number)) 'b)
(:method progn ((x symbol)) 'c)
(:method progn ((x t)) 'd)))))
(declare (type generic-function fn))
(values
(funcall fn 0)
(funcall fn 4/3)
......@@ -183,6 +192,7 @@
(:method progn ((x dgmc-class-03)) 'b)
(:method progn ((x dgmc-class-02)) 'c)
(:method progn ((x dgmc-class-01)) 'd)))))
(declare (type generic-function fn))
(values
(funcall fn (make-instance 'dgmc-class-01))
(funcall fn (make-instance 'dgmc-class-02))
......@@ -198,6 +208,7 @@
(:method progn ((x dgmc-class-03)) 'b)
(:method progn ((x dgmc-class-02)) 'c)
(:method progn ((x dgmc-class-01)) 'd)))))
(declare (type generic-function fn))
(values
(funcall fn (make-instance 'dgmc-class-01))
(funcall fn (make-instance 'dgmc-class-02))
......@@ -215,6 +226,7 @@
(:method :around ((x complex)) (call-next-method))
(:method :around ((x number)) (values 1 2 3 4 5 6))
(:method progn ((x t)) 'b)))))
(declare (type generic-function fn))
(values
(multiple-value-list (funcall fn 'a))
(multiple-value-list (funcall fn 10))
......@@ -226,6 +238,7 @@
(handler-case
(let ((fn (eval '(defgeneric dg-mc.progn.9 (x)
(:method-combination progn)))))
(declare (type generic-function fn))
(funcall fn (list 'a)))
(error () :error))
:error)
......@@ -251,6 +264,7 @@
(:method-combination progn)
(:method :around ((x t)) 'a)
(:method progn ((x integer)) x)))))
(declare (type generic-function fn))
(handler-case (funcall fn 'b)
(error () :error)))
:error)
......@@ -55,6 +55,16 @@
(eqt (last x (1+ most-positive-fixnum)) x))
t)
(deftest last.13
(let ((x '(a b c . d)))
(eqt (last x most-positive-fixnum) x))
t)
(deftest last.14
(let ((x '(a b c . d)))
(eqt (last x (1- most-positive-fixnum)) x))
t)
(deftest last.order.1
(let ((i 0) x y)
(values
......
......@@ -47,6 +47,14 @@
(nbutlast (list 'a 'b 'c 'd) (1+ most-positive-fixnum))
nil)
(deftest nbutlast.8
(nbutlast (list 'a 'b 'c 'd) most-positive-fixnum)
nil)
(deftest nbutlast.9
(nbutlast (list 'a 'b 'c 'd) (1- most-positive-fixnum))
nil)
(deftest nbutlast.order.1
(let ((i 0) x y)
(values
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Mon Jun 30 21:43:23 2003
;;;; Contains: Notes concerning various parts of the ANSI spec.
(in-package :cl-test)
(defnote :allow-nil-arrays
"Allow specialized arrays of type (array nil).")
(defnote :allow-nonzero-nil-arrays
"Allow specialized arrays of type (array nil <dims>) of nonzero size.")
......@@ -345,9 +345,26 @@
;;; Note handling functions and macros
(defmacro defnote (name contents)
(defmacro defnote (name contents &optional disabled)
`(eval-when #+gcl (load eval) #-gcl (:load-toplevel :execute)
(let ((note (make-note :name ,name :contents ,contents)))
(let ((note (make-note :name ',name
:contents ',contents
:disabled ',disabled)))
(setf (gethash *notes* (note-name note)) note)
note)))
(defun disable-note (n)
(let ((note (if (note-p n) n
(setf n (gethash n *notes*)))))
(unless note (error "~A is not a note or note name." n))
(setf (note-disabled note) t)
note))
(defun enable-note (n)
(let ((note (if (note-p n) n
(setf n (gethash n *notes*)))))
(unless note (error "~A is not a note or note name." n))
(setf (note-disabled note) nil)
note))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment