From a9c079b13b74e46ccdea6e2d4b5209b0f7a2005a Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Wed, 11 Dec 2024 22:43:17 +0100 Subject: [PATCH] goops.test: Add tests for define-method* --- test-suite/tests/goops.test | 47 +++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test index b06ba98b2..6f5957cc3 100644 --- a/test-suite/tests/goops.test +++ b/test-suite/tests/goops.test @@ -761,3 +761,50 @@ #:metaclass ))) (pass-if-equal 123 (get-the-bar (make ))) (pass-if-equal 123 (get-the-bar (make )))))) + +(with-test-prefix "keyword formals" + + (define-class ()) + (define-class ()) + + (define a (make )) + (define b (make )) + + (define-method* (test-opt (x ) #:optional y) + (list 'A x y)) + + (define-method* (test-opt (x ) #:optional y) + (append (list 'B x y) + (next-method))) + + (pass-if-equal "optional without arg" `(B ,b #f A ,b #f) (test-opt b)) + (pass-if-equal "optional with arg" `(B ,b 17 A ,b 17) (test-opt b 17)) + + (define-method* (test-key (x ) #:key (y 3)) + (list 'A x y)) + + (define-method* (test-key (rest ) #:key y) ;`rest' checks impl hygiene + (append (list 'B rest y) + (next-method))) + + (pass-if-equal "keyword without arg" `(B ,b #f A ,b 3) (test-key b)) + (pass-if-equal "keyword with arg" `(B ,b 17 A ,b 17) (test-key b #:y 17)) + + (define-method* (test-rest (x ) #:optional class #:rest y) ;`class' -"- + (list 'A x class y)) + + (define-method* (test-rest (x ) . y) + (append (list 'B x y) + (next-method))) + + (pass-if-equal "rest arg" `(B ,b (1 2 3) A ,b 1 (2 3)) (test-rest b 1 2 3)) + + (define-method* (test-next (x ) #:optional y) + (list 'A y)) + + (define-method* (test-next (x ) #:optional y) + (append (list 'B y) + (next-method x 2))) + + (pass-if-equal "next-method arg" `(B 1 A 2) (test-next b 1)) + )