diff --git a/ansi-tests/butlast.lsp b/ansi-tests/butlast.lsp index f5690a146274d08b842d72cf93d5116425f26932..03805dd668bcd34b1f7ad6fe8c52ec0d4db5b9ca 100644 --- a/ansi-tests/butlast.lsp +++ b/ansi-tests/butlast.lsp @@ -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 diff --git a/ansi-tests/defgeneric-method-combination-and.lsp b/ansi-tests/defgeneric-method-combination-and.lsp index 29e04ffd4cef80ca9564ef7ea45200399d7f542b..613d9b71d964ffa05dcab4728470c636f4e00566 100644 --- a/ansi-tests/defgeneric-method-combination-and.lsp +++ b/ansi-tests/defgeneric-method-combination-and.lsp @@ -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) diff --git a/ansi-tests/defgeneric-method-combination-append.lsp b/ansi-tests/defgeneric-method-combination-append.lsp index f7fd3a5edf92e79a5adefcc4f2ecbc93323bd763..fe331f6a46bd64978676da913f864daae5a30073 100644 --- a/ansi-tests/defgeneric-method-combination-append.lsp +++ b/ansi-tests/defgeneric-method-combination-append.lsp @@ -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) diff --git a/ansi-tests/defgeneric-method-combination-list.lsp b/ansi-tests/defgeneric-method-combination-list.lsp index 9e7a99d1f21bfd0303bc2cfe478115d1a1530582..514bae3be93bb9b1118f35e137940bbfe5cfedaa 100644 --- a/ansi-tests/defgeneric-method-combination-list.lsp +++ b/ansi-tests/defgeneric-method-combination-list.lsp @@ -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) diff --git a/ansi-tests/defgeneric-method-combination-max.lsp b/ansi-tests/defgeneric-method-combination-max.lsp index bd6331b2677457e18d836831add059960802a3c4..81c2be4bfb1ecc539938a570e7633c3a3abd0483 100644 --- a/ansi-tests/defgeneric-method-combination-max.lsp +++ b/ansi-tests/defgeneric-method-combination-max.lsp @@ -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) diff --git a/ansi-tests/defgeneric-method-combination-min.lsp b/ansi-tests/defgeneric-method-combination-min.lsp index 6ddf10e25a554dd034c28c43704e2211e845074b..9024188afb7d5ad662c638b2ac616ba4cd0d18b3 100644 --- a/ansi-tests/defgeneric-method-combination-min.lsp +++ b/ansi-tests/defgeneric-method-combination-min.lsp @@ -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) diff --git a/ansi-tests/defgeneric-method-combination-nconc.lsp b/ansi-tests/defgeneric-method-combination-nconc.lsp index 6a7b70710efa7c0d189eb81d7e2c44963afe41e8..40eaffc6271c0fa4c3032f8b616dba02b7c8dbd0 100644 --- a/ansi-tests/defgeneric-method-combination-nconc.lsp +++ b/ansi-tests/defgeneric-method-combination-nconc.lsp @@ -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) diff --git a/ansi-tests/defgeneric-method-combination-or.lsp b/ansi-tests/defgeneric-method-combination-or.lsp index aa1f6889ecbbc5487a8ea2d453c742bb57cb1d6e..d4284583ae70a41f2af064ed0809c25fe0a7f5dd 100644 --- a/ansi-tests/defgeneric-method-combination-or.lsp +++ b/ansi-tests/defgeneric-method-combination-or.lsp @@ -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) diff --git a/ansi-tests/defgeneric-method-combination-plus.lsp b/ansi-tests/defgeneric-method-combination-plus.lsp index bedaa0e276b22740261ede64cc4dedc89f6fd200..21785142e25e673e605dc65c7b86677a932a7d68 100644 --- a/ansi-tests/defgeneric-method-combination-plus.lsp +++ b/ansi-tests/defgeneric-method-combination-plus.lsp @@ -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) diff --git a/ansi-tests/defgeneric-method-combination-progn.lsp b/ansi-tests/defgeneric-method-combination-progn.lsp index f3be132600cbe83973a39227b84f9cdb1df57332..f96ad7aeb20959a3b919897a3d4b7ea9ad527740 100644 --- a/ansi-tests/defgeneric-method-combination-progn.lsp +++ b/ansi-tests/defgeneric-method-combination-progn.lsp @@ -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) diff --git a/ansi-tests/last.lsp b/ansi-tests/last.lsp index 3b9952cfa6f695f01253ac0a1f2d0e9a020da891..ce6e97a68dc0d093d52172d98c131bae00e1d5cd 100644 --- a/ansi-tests/last.lsp +++ b/ansi-tests/last.lsp @@ -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 diff --git a/ansi-tests/nbutlast.lsp b/ansi-tests/nbutlast.lsp index cd2c0dff257b6e2c83949b36b63328daab1594e2..9c6defc70c27ffea4caac32aa248fdc0f9057c01 100644 --- a/ansi-tests/nbutlast.lsp +++ b/ansi-tests/nbutlast.lsp @@ -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 diff --git a/ansi-tests/notes.lsp b/ansi-tests/notes.lsp new file mode 100644 index 0000000000000000000000000000000000000000..376c6a6a56fa60af9a8d7c412d525b4cc7fbad3b --- /dev/null +++ b/ansi-tests/notes.lsp @@ -0,0 +1,12 @@ +;-*- 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.") diff --git a/ansi-tests/rt.lsp b/ansi-tests/rt.lsp index 6525c3cb4d63629ea0a01a5a473ec6c96bfe90f2..760c42cf3afaffa93b5414d1265bfa2f303ec2ed 100644 --- a/ansi-tests/rt.lsp +++ b/ansi-tests/rt.lsp @@ -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)) + +