From 32d2377df1f0799354e0d21bcae371e5d41d239b Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 25 Apr 2009 20:18:45 -0500
Subject: [PATCH] test method dispatch on roles

---
 extra/roles/roles-tests.factor | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/extra/roles/roles-tests.factor b/extra/roles/roles-tests.factor
index aaa197f5ed..fcbc20db16 100644
--- a/extra/roles/roles-tests.factor
+++ b/extra/roles/roles-tests.factor
@@ -53,3 +53,15 @@ SYMBOL: knife
 
 [ knife { utensil tool } { } define-tuple-class-with-roles ]
 [ multiple-inheritance-attempted? ] must-fail-with 
+
+! make sure method dispatch works
+GENERIC: poke ( pokee poker -- result )
+GENERIC: scoop ( scoopee scooper -- result )
+GENERIC: tune ( tunee tuner -- result )
+
+M: fork poke drop " got poked" append ;
+M: spoon scoop drop " got scooped" append ;
+M: instrument tune drop " got tuned" append ;
+
+[ "potato got poked" "potato got scooped" "potato got tuned" ]
+[ "potato" tuning-spork new [ poke ] [ scoop ] [ tune ] 2tri ] unit-test