bug#50719: Cannot add a no-applicable-method implementation for a generic with no method

Vivien Kraus via "Bug reports for GUILE, GNU's Ubiquitous Extension Language" <[email protected]>
Newsgroups gmane.lisp.guile.bugs
Message-ID <[email protected]>
Dear guile,

The following program should just return 'foo, but it enters an
infinite loop:

(use-modules (oop goops))

(define-class <my-generic> (<generic>))

(define-method (no-method (generic <my-generic>) args)
  'foo)

(define-method (no-applicable-method (generic <my-generic>) args)
  'foo)

(define hello
  (make <my-generic>
    #:name 'hello))

(hello)

I don’t know GOOPS enough to understand what happens, but when I
slightly change the last line:

(use-modules (oop goops))

(define-class <my-generic> (<generic>))

(define-method (no-method (generic <my-generic>) args)
  'foo)

(define-method (no-applicable-method (generic <my-generic>) args)
  'foo)

(define hello
  (make <my-generic>
    #:name 'hello))

(apply-generic hello '())

Now it returns 'foo, as expected. So my guess is that the infinite
loops happens during the memoization phase. More specifically, the no-
applicable-method is called over and over again.

Please find a failing test case attached.

Best regards,

Vivien
0001-goops-cannot-override-no-applicable-method-for-a-gen.patch (text/x-patch, 1.5 KB)
From 435d4d7569a25dda05489c3eda3086e0dbf531af Mon Sep 17 00:00:00 2001
From: Vivien Kraus <[email protected]>
Date: Tue, 21 Sep 2021 11:40:43 +0200
Subject: [PATCH] goops: cannot override no-applicable-method for a generic
 that has no methods

---
 test-suite/tests/goops.test | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
index b06ba98b2..626eeaacd 100644
--- a/test-suite/tests/goops.test
+++ b/test-suite/tests/goops.test
@@ -761,3 +761,22 @@
               #: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 "Can override no-applicable-method in a generic without methods"
+  (let ((patience-no-method 10)
+        (patience-no-applicable-method 10))
+    (define-class <my-generic> (<generic>))
+    (define-method (no-method (generic <my-generic>) args)
+      (when (= patience-no-method 0)
+        (error "Infinite loop detected in no-method"))
+      (set! patience-no-method (- patience-no-method 1))
+      'foo)
+    (define-method (no-applicable-method (generic <my-generic>) args)
+      (when (= patience-no-applicable-method 0)
+        (error "Infinite loop detected in no-applicable-method"))
+      (set! patience-no-applicable-method (- patience-no-applicable-method 1))
+      'foo)
+    (define hello
+      (make <my-generic>
+        #:name 'hello))
+    (pass-if-equal (hello) 'foo)))
-- 
2.33.0
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.