[Guile-commits] branch main updated: goops.test: Add tests for define-method*

[Mikael Djurfeldt]

This is an automated email from the git hooks/post-receive script.

mdj pushed a commit to branch main
in repository guile.

The following commit(s) were added to refs/heads/main by this push:
     new a9c079b13 goops.test: Add tests for define-method*
a9c079b13 is described below

commit a9c079b13b74e46ccdea6e2d4b5209b0f7a2005a
Author: Mikael Djurfeldt <mikael@djurfeldt.com>
AuthorDate: Wed Dec 11 22:43:17 2024 +0100

    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 <redefinable-meta>)))
       (pass-if-equal 123 (get-the-bar (make <foo>)))
       (pass-if-equal 123 (get-the-bar (make <redefinable-foo>))))))
+
+(with-test-prefix "keyword formals"
+
+  (define-class <A> ())
+  (define-class <B> (<A>))
+
+  (define a (make <A>))
+  (define b (make <B>))
+
+  (define-method* (test-opt (x <A>) #:optional y)
+    (list 'A x y))
+
+  (define-method* (test-opt (x <B>) #: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 <A>) #:key (y 3))
+    (list 'A x y))
+
+  (define-method* (test-key (rest <B>) #: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 <A>) #:optional class #:rest y) ;`class' -"-
+    (list 'A x class y))
+
+  (define-method* (test-rest (x <B>) . 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 <A>) #:optional y)
+    (list 'A y))
+
+  (define-method* (test-next (x <B>) #:optional y)
+    (append (list 'B y)
+            (next-method x 2)))
+
+  (pass-if-equal "next-method arg" `(B 1 A 2) (test-next b 1))
+  )