Clear mailbox of unmatched processes

3 files changed, 14 insertions, 0 deletions

diff --git a/lib/peer.tcl b/lib/peer.tcl
index 42297e4a..e8e18be8 100644
--- a/lib/peer.tcl
+++ b/lib/peer.tcl
@@ -34,6 +34,10 @@ proc ::peer {process {dieOnDisconnect false}} {
             variable process
             Mailbox::receive $process $::thisProcess
         }
+	proc clear {} {
+            variable process
+            Mailbox::clear $process $::thisProcess
+	}
 
         proc share {shareStatements} {
             variable process
diff --git a/lib/process.tcl b/lib/process.tcl
index faaa5e84..c9adec0a 100644
--- a/lib/process.tcl
+++ b/lib/process.tcl
@@ -115,6 +115,8 @@ proc Start-process {name body} {
             }
         }
         On unmatch {
+	    # Clear the mailbox
+            ::Peers::${name}::clear
             # Remember to suppress/kill the process if it shows up
             # later after we're gone.
             dict set ::peersBlacklist $name true
diff --git a/main.tcl b/main.tcl
index 62d0e7d7..500534fc 100644
--- a/main.tcl
+++ b/main.tcl
@@ -556,6 +556,14 @@ namespace eval ::Mailbox {
         } pthread_mutex_unlock(&mailbox->mutex);
         return ret;
     }
+    $cc proc clear {char* from char* to} void {
+        mailbox_t* mailbox = find(from, to);
+        pthread_mutex_lock(&mailbox->mutex); {
+            mailbox->active = 0;
+            mailbox->mail[0] = '\0';
+            mailbox->mailLen = 0;
+        } pthread_mutex_unlock(&mailbox->mutex);
+    }
     $cc compile
     init
 }