[PATCH] Fix GOOPS method compilation bug when no next-method exists

[Mark H Weaver <mhw@netris.org>]

[-- Attachment #1: Type: text/plain, Size: 1418 bytes --]

I was playing with GOOPS and noticed this bug:

> scheme@(guile-user)> (use-modules (oop goops))
> scheme@(guile-user)> (define-method (+ (x <list>) (y <list>)) (next-method))
> scheme@(guile-user)> (+ '() '())
> oop/goops/compile.scm:48:35: In procedure car:
> oop/goops/compile.scm:48:35: Wrong type argument in position 1 (expecting pair): ()
> 
> Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
> scheme@(guile-user) [1]> ,bt
> 
> In standard input:
>       8:0  4 (#<procedure a879a0 at standard input:8:0 ()>)
> In oop/goops/dispatch.scm:
>     231:9  3 (cache-miss #<<generic> + (1)> (() ()))
>     246:4  2 (memoize-effective-method! #<<generic> + (1)> (() ()) (#))
> In oop/goops/compile.scm:
>     54:13  1 (compute-cmethod (#<<method> (<list> <list>) afc640>) (…))
>     48:34  0 (compute-cmethod () (#<<class> <null> befd20> #<<clas…>))

With the attached patch applied, here's what happens instead:

> scheme@(guile-user)> (define-method (+ (x <list>) (y <list>)) (next-method))
> scheme@(guile-user)> (+ '() '())
> ERROR: In procedure scm-error:
> ERROR: No next method when calling #<<generic> + (1)>
> with arguments (() ())
> 
> Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
> scheme@(guile-user) [1]> ,q

I confess I don't know much about GOOPS, but I think the fix is pretty
obvious.

    Best,
     Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Fix GOOPS method compilation bug when no next-method exists --]
[-- Type: text/x-diff, Size: 1062 bytes --]

From 2b838f70704ae0bebc3c00c0114505c80967f51f Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Sat, 29 Jan 2011 22:07:49 -0500
Subject: [PATCH] Fix GOOPS method compilation bug when no next-method exists

* module/oop/goops/compile.scm (compute-cmethod): Fix a bug
  that caused the method compiler to barf while compiling a
  method that calls (next-method), if there is no applicable
  next method.
---
 module/oop/goops/compile.scm |    2 +-
 1 files changed, 1 insertions(+), 1 deletions(-)

diff --git a/module/oop/goops/compile.scm b/module/oop/goops/compile.scm
index db1a160..ace89b4 100644
--- a/module/oop/goops/compile.scm
+++ b/module/oop/goops/compile.scm
@@ -48,7 +48,7 @@
   (let ((make-procedure (slot-ref (car methods) 'make-procedure)))
     (if make-procedure
         (make-procedure
-         (if (null? methods)
+         (if (null? (cdr methods))
              (lambda args
                (no-next-method (method-generic-function (car methods)) args))
              (compute-cmethod (cdr methods) types)))
-- 
1.5.6.5