From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 9 Sep 2012 16:23:04 +0000 (+0000)
Subject: counter connection tests
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FTenDotTcl.git;a=commitdiff_plain;h=e63453e3095c682598081c24430cf087a850a30e

counter connection tests
---

diff --git a/t/connection.t b/t/connection.t
index e0425c9..ab4397b 100644
--- a/t/connection.t
+++ b/t/connection.t
@@ -3,6 +3,12 @@ BEGIN { exec(tclsh => 't/tcl/harness.tcl' => $0) }
 package require ten
 package require json::write
 
+if {[array names ::env PERL5LIB]==""} {
+  array set ::env [list PERL5LIB t/lib]
+} else {
+  array set ::env [list PERL5LIB "t/lib:$::env(PERL5LIB)"]
+}
+
 set connector [ten::connector::perl %AUTO%]
 
 set conn [$connector connect]
@@ -29,4 +35,20 @@ is [$f1 await_get] $my_host "hostname returned ok via get"
 
 is $ready_args $my_host "hostname returned ok via on_ready"
 
+set ortestdata [[$conn send call {*}[jws class_call_handler 0 call ORTestClass new]] await_get]
+
+set ortestoid [lindex $ortestdata 0 1]
+
+proc ortest {args} {
+  return [[$::conn send call {*}[jws $::ortestoid 0 {*}$args]] await_get]
+}
+
+cmp_ok != [pid] [ortest pid] "pid is different on the other side"
+
+is [ortest counter] 0 "Counter at 0"
+
+is [ortest increment] 1 "Incrememt to 1"
+
+is [ortest counter] 1 "Counter at 1"
+
 done_testing
diff --git a/t/lib/ORTestClass.pm b/t/lib/ORTestClass.pm
new file mode 100644
index 0000000..0751492
--- /dev/null
+++ b/t/lib/ORTestClass.pm
@@ -0,0 +1,17 @@
+package ORTestClass;
+
+use Moo;
+
+has counter => (is => 'rwp', default => sub { 0 });
+
+sub increment { $_[0]->_set_counter($_[0]->counter + 1); }
+
+sub pid { $$ }
+
+sub call_callback {
+  my ($self, $value, $cb) = @_;
+  $cb->();
+  return $value;
+}
+
+1;
diff --git a/ten/ten.tcl b/ten/ten.tcl
index a093a97..3abe931 100644
--- a/ten/ten.tcl
+++ b/ten/ten.tcl
@@ -241,7 +241,7 @@ snit::type ten::read_channel {
       }
     } else {
       if [llength $options(-on_line_call)] {
-        while {[llength [set line [gets $chan]]] > 0} {
+        while {[string length [set line [gets $chan]]] > 0} {
           eval [concat $options(-on_line_call) [ list $line ]]
         }
       }