From 12386a2694932857981a076536c6297f8eaa661f Mon Sep 17 00:00:00 2001
Message-Id: <12386a2694932857981a076536c6297f8eaa661f.1716255118.git.mdw@distorted.org.uk>
From: Mark Wooding <mdw@chiark.greenend.org.uk>
Date: Sun, 26 Mar 2017 15:16:18 +0100
Subject: [PATCH] src/method-proto.lisp (invoke-delegation-chain): Pass keyword
 args correctly.
Organization: Straylight/Edgeware

From: Mark Wooding <mdw@distorted.org.uk>

It's not correct to commit to `&sod__kw' or `sod__kw' for the entire
chain.  Typically, the first method gets called with `&sod__kw', but the
rest want plain `sod__kw'.
---
 src/method-proto.lisp | 16 +++++++++-------
 test/test.sod         | 16 +++++++++++-----
 2 files changed, 20 insertions(+), 12 deletions(-)

diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index d019997..637c29e 100644
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -500,11 +500,9 @@ (defun invoke-delegation-chain (codegen target basic-tail chain kernel)
    nil."
 
   (let* ((message (codegen-message codegen))
-	 (argument-tail (cond ((varargs-message-p message)
-			       (cons *sod-tmp-ap* basic-tail))
-			      ((keyword-message-p message)
-			       (cons (keyword-struct-pointer) basic-tail))
-			      (t basic-tail))))
+	 (argument-tail (if (varargs-message-p message)
+			    (cons *sod-tmp-ap* basic-tail)
+			    basic-tail)))
     (labels ((next-trampoline (method chain)
 	       (if (or kernel chain)
 		   (make-trampoline codegen (sod-method-class method)
@@ -515,9 +513,13 @@ (defun invoke-delegation-chain (codegen target basic-tail chain kernel)
 	       (if (null chain)
 		   (funcall kernel target)
 		   (let ((trampoline (next-trampoline (car chain)
-						      (cdr chain))))
+						      (cdr chain)))
+			 (tail (if (keyword-message-p message)
+				   (cons (keyword-struct-pointer)
+					 argument-tail)
+				   argument-tail)))
 		     (invoke-method codegen target
-				    (cons trampoline argument-tail)
+				    (cons trampoline tail)
 				    (car chain))))))
       (invoke chain target))))
 
diff --git a/test/test.sod b/test/test.sod
index 6bc775b..776228b 100644
--- a/test/test.sod
+++ b/test/test.sod
@@ -233,8 +233,14 @@ class T3Base : SodObject {
   void m1(?) { }
 }
 
-[link = T3Base, nick = sub]
-class T3Sub : T3Base {
+[link = T3Base, nick = mid]
+class T3Mid : T3Base {
+  void base.m0(?int y) { STEP(y); CALL_NEXT_METHOD; }
+  void base.m1(?) { STEP(4); CALL_NEXT_METHOD; }
+}
+
+[link = T3Mid, nick = sub]
+class T3Sub : T3Mid {
   void base.m0(?int z) { STEP(z); CALL_NEXT_METHOD; }
   void base.m1(?int z) { STEP(z); CALL_NEXT_METHOD; }
 }
@@ -242,9 +248,9 @@ class T3Sub : T3Base {
 code c : tests {
   prepare("kwargs");
   { SOD_DECL(T3Sub, t, NO_KWARGS);
-    T3Base_m0(t, KWARGS(K(z, 0) K(x, 1)));
-    T3Base_m1(t, KWARGS(K(z, 2)));
-    DONE(3);
+    T3Base_m0(t, KWARGS(K(z, 0) K(y, 1) K(x, 2)));
+    T3Base_m1(t, KWARGS(K(z, 3)));
+    DONE(5);
   }
 }
 
-- 
[mdw]