From 6b701f3421031ae0a912d10428fb99f9043acc92 Mon Sep 17 00:00:00 2001
From: Holger Hans Peter Freyther <zecke@selfish.org>
Date: Sat, 28 Jul 2012 20:45:21 +0200
Subject: [PATCH] ipa: Make the IPADispatcher work on BlockClosures and add new
 API

Make the IPADispatcher work with BlockClosure. Add a new API to
register a block for a stream id. This will remove the requirement
of adding a dedicated selector.
---
 IPADispatcher.st | 11 +++++++----
 Tests.st         | 25 +++++++++++++++++++++++++
 2 files changed, 32 insertions(+), 4 deletions(-)

diff --git a/IPADispatcher.st b/IPADispatcher.st
index a521c62..e78c32d 100644
--- a/IPADispatcher.st
+++ b/IPADispatcher.st
@@ -35,10 +35,13 @@ Object subclass: IPADispatcher [
     ]
 
     addHandler: aStream on: anObject with: aSelector [
-        | handler |
         <category: 'handler'>
-        handler := Array with: anObject with: aSelector.
-        handlers at: aStream put: handler.
+        handlers at: aStream put: [:msg | anObject perform: aSelector with: msg].
+    ]
+
+    addHandler: aStream on: aBlock [
+        <category: 'handler'>
+        handlers at: aStream put: aBlock.
     ]
 
     dispatch: aStream with: aData [
@@ -49,6 +52,6 @@ Object subclass: IPADispatcher [
             ^ false
         ].
 
-        (handler first) perform: (handler second) with: aData.
+        handler value: aData.
     ]
 ]
diff --git a/Tests.st b/Tests.st
index 2186b8a..f1cd3f3 100644
--- a/Tests.st
+++ b/Tests.st
@@ -201,6 +201,8 @@ TestCase subclass: SCCPTests [
 ]
 
 TestCase subclass: IPATests [
+    | called |
+
     IPATests class >> packageNamesUnderTest [
         <category: 'accessing'>
         ^ #('OsmoNetwork')
@@ -225,6 +227,29 @@ TestCase subclass: IPATests [
         data do: [:each |
             self assert: each first = each second.]
     ]
+
+    testDispatch [
+        | dispatch |
+        <category: 'dispatch-test'>
+
+        called := false.
+        dispatch := IPADispatcher new
+                      addHandler: 16r23 on: self with: #dispatchcallback:;
+                      yourself.
+        dispatch dispatch: 16r23 with: 'data'.
+        self assert: called.
+
+        called := false.
+        dispatch
+            addHandler: 16r42 on: [:msg | called := msg = 'data' ];
+            dispatch: 16r42 with: 'data'.
+        self assert: called.
+    ]
+
+    dispatchcallback: aData [
+        <category: 'dispatch-test'>
+        called := aData = 'data'.
+    ]
 ]
 
 TestCase subclass: MessageBufferTest [