Documentation of the Test-Client-Server tool used for example.test
.
The Naming-Test-Tool tool is used to test the name-resolution-feature of tclmqmsgque.
To perform the test 2 tools are used, the testclient and the testserver.
testclient | This tool creates multiple parent and child client-context, all using a |
testserver | This tool listen on the service GTCX and return the unique identification pattern of the server-context in duty. |
All context created, 8x client and 8x server, are connected using the tclmqmsgque protocoll and build together a flat structure.
The GOAL for this setup is:
#!/usr/bin/env tclsh #+ #: @file NHI1/example/tcl/testclient.tcl #: @brief testclient.tcl - 26 Jun 2024 - aotto1968 #: @copyright (C) NHI - #1 - Project - Group #: This software has NO permission to copy, #: please contact AUTHOR for additional information #: @version 08a242faddae5101924d8fe811888e78892a82d9 #: @date Wed Jun 26 14:26:21 2024 +0200 #: @author aotto1968 <aotto1968@t-online.de> #: package require tclmqmsgque set server [file join [file dirname [info script]] testserver.tcl] proc Get {ctx} { $ctx SendSTART $ctx SendEND_AND_WAIT "GTCX" append RET [$ctx ConfigGetName] append RET "+" append RET [$ctx ReadSTR] append RET [$ctx ReadSTR] append RET [$ctx ReadSTR] append RET [$ctx ReadSTR] append RET [$ctx ReadSTR] append RET [$ctx ReadSTR] return $RET } # create object set LIST [list c0 c00 c01 c000 c1 c10 c100 c101] foreach F $LIST { set FH($F) [tclmqmsgque::MqContextC Create] } ## create link $FH(c0) LinkCreate "--postfix" "0" "--prefix" "c" "--debug" $env(TS_DEBUG) "@" \ $env(TCLSH) $server "--prefix" "s" $FH(c00) LinkCreateChild $FH(c0) "--postfix" "00" $FH(c01) LinkCreateChild $FH(c0) "--postfix" "01" $FH(c000) LinkCreateChild $FH(c00) "--postfix" "000" $FH(c1) LinkCreate "--postfix" "1" "--prefix" "c" {*}$argv $FH(c10) LinkCreateChild $FH(c1) "--postfix" "10" $FH(c100) LinkCreateChild $FH(c10) "--postfix" "100" $FH(c101) LinkCreateChild $FH(c10) "--postfix" "101" ## do the tests foreach F $LIST { puts [Get $FH($F)] } ## cleanup foreach n [lreverse $LIST] { $FH($n) Delete }
#!/usr/bin/env tclsh #+ #: @file NHI1/example/tcl/testserver.tcl #: @brief testserver.tcl - 26 Jun 2024 - aotto1968 #: @copyright (C) NHI - #1 - Project - Group #: This software has NO permission to copy, #: please contact AUTHOR for additional information #: @version 08a242faddae5101924d8fe811888e78892a82d9 #: @date Wed Jun 26 14:26:21 2024 +0200 #: @author aotto1968 <aotto1968@t-online.de> #: package require tclmqmsgque proc GTCX {ctx} { $ctx SendSTART $ctx SendI32 [$ctx LinkGetCtxId] $ctx SendSTR "+" if {[$ctx LinkIsParent]} { $ctx SendI32 -1 } else { $ctx SendI32 [[$ctx LinkGetParent] LinkGetCtxId] } $ctx SendSTR "+" $ctx SendSTR [$ctx ConfigGetName] $ctx SendSTR ":" $ctx SendRETURN } proc ServerSetup {ctx} { $ctx ServiceCreate "GTCX" GTCX } tclmqmsgque::Main { tclmqmsgque::MqContextC create srv srv ConfigSetServerSetup ServerSetup try { srv LinkCreate {*}$argv srv ProcessEvent MQ_WAIT_FOREVER } on error {} { srv ErrorCatch } finally { srv Exit } }