Commit | Line | Data |
0e93bc12 |
1 | BEGIN { exec(tclsh => 't/tcl/harness.tcl' => $0) } |
2 | |
3 | package require ten |
4 | package require json::write |
5 | |
e63453e3 |
6 | if {[array names ::env PERL5LIB]==""} { |
7 | array set ::env [list PERL5LIB t/lib] |
8 | } else { |
9 | array set ::env [list PERL5LIB "t/lib:$::env(PERL5LIB)"] |
10 | } |
11 | |
0e93bc12 |
12 | set connector [ten::connector::perl %AUTO%] |
13 | |
14 | set conn [$connector connect] |
15 | |
61761da2 |
16 | proc jws {args} { |
17 | set ret {} |
18 | foreach str $args { |
19 | lappend ret [ json::write string $str ] |
20 | } |
21 | return $ret |
22 | } |
23 | |
0e93bc12 |
24 | set f1 [ |
61761da2 |
25 | $conn send call {*}[jws class_call_handler 0 call Sys::Hostname hostname] |
0e93bc12 |
26 | ] |
27 | |
28 | set ready_args "" |
29 | |
30 | $f1 on_ready [list apply {{name future} {set $name [$future get]}} "[namespace current]::ready_args" ] |
31 | |
9540dca1 |
32 | set my_host [exec hostname] |
33 | |
47f04c56 |
34 | is [$f1 await_get] $my_host "hostname returned ok via get" |
9540dca1 |
35 | |
36 | is $ready_args $my_host "hostname returned ok via on_ready" |
61761da2 |
37 | |
e63453e3 |
38 | set ortestdata [[$conn send call {*}[jws class_call_handler 0 call ORTestClass new]] await_get] |
39 | |
40 | set ortestoid [lindex $ortestdata 0 1] |
41 | |
451af734 |
42 | set ortest [$conn remote_object $ortestoid] |
e63453e3 |
43 | |
451af734 |
44 | cmp_ok != [pid] [$ortest call pid] "pid is different on the other side" |
e63453e3 |
45 | |
451af734 |
46 | is [$ortest call counter] 0 "Counter at 0" |
e63453e3 |
47 | |
451af734 |
48 | is [$ortest call increment] 1 "Incrememt to 1" |
e63453e3 |
49 | |
451af734 |
50 | is [$ortest call counter] 1 "Counter at 1" |
51 | |
52 | $ortest destroy |
e63453e3 |
53 | |
61761da2 |
54 | done_testing |