[Tcl-bugs] [ tktoolkit-Bugs-846141 ] winSend.test failures and tkWinSend.c bug

[SourceForge.net <no...@so...>]

Bugs item #846141, was opened at 2003-11-20 21:36
Message generated for change (Settings changed) made by vincentdarley
You can respond by visiting: 
https://sourceforge.net/tracker/?func=detail&atid=112997&aid=846141&group_id=12997

Category: 58. [send]
Group: None
Status: Open
Resolution: None
Priority: 5
Submitted By: Vince Darley (vincentdarley)
>Assigned to: Pat Thoyts (patthoyts)
Summary: winSend.test failures and tkWinSend.c bug

Initial Comment:
The listed tests fail on WinXP, Tk 8.5a0.  Also I note
that code like this:

	Tcl_SetStringObj(Tcl_GetObjResult(interp),
	    "option not implemented: \displayof\ is not
available "
	    "for this platform.", -1);

Is no good if the result object is shared -- it will
trigger a panic.

Vince.

----

winSend.test

==== winSend-2.1 Tk_SendObjCmd - # of args FAILED
==== Contents of test case:

    list [catch {send tktest} msg] $msg

---- Result was:
1 {bad option "tktest": must be -async, -displayof, or
--wrong # args: should be
 "send ?-async? ?-displayof? ?--? interpName arg ?arg
...?"}
---- Result should have been (exact matching):
1 {wrong # args: should be "send ?options? interpName
arg ?arg ...?"}
==== winSend-2.1 FAILED


==== winSend-2.1 Tk_SendObjCmd: arguments FAILED
==== Contents of test case:

    list [catch {send -bogus tktest} msg] $msg

---- Result was:
1 {no application named "-bogus"}
---- Result should have been (exact matching):
1 {bad option "-bogus": must be -async, -displayof, or --}
==== winSend-2.1 FAILED


==== winSend-2.1 Tk_SendObjCmd: arguments FAILED
==== Contents of test case:

    list [catch {send -async bogus foo} msg] $msg

---- Result was:
1 {no application named "bogus"}
---- Result should have been (exact matching):
1 {no registered server named "bogus"}
==== winSend-2.1 FAILED


==== winSend-2.1 Tk_SendObjCmd: arguments FAILED
==== Contents of test case:

    list [catch {send -displayof . bogus foo} msg] $msg

---- Result was:
1 {option not implemented: "displayof" is not available
for this platform.}
---- Result should have been (exact matching):
1 {no registered server named "bogus"}
==== winSend-2.1 FAILED


==== winSend-2.1 Tk_SendObjCmd: arguments FAILED
==== Contents of test case:

    list [catch {send -- -bogus foo} msg] $msg

---- Result was:
1 {no application named "-bogus"}
---- Result should have been (exact matching):
1 {no registered server named "-bogus"}
==== winSend-2.1 FAILED


==== winSend-2.4 Tk_SendObjCmd - sending to ourselves
in a different interp with
 errors FAILED
==== Contents of test case:

    newApp testApp
    list [catch {send testApp {expr 2 / 0}} msg] $msg
$errorCode $errorInfo [int
erp delete testApp]

---- Result was:
1 {divide by zero} ARITH {divide by zeroDIVZERO
    invoked from within
"send testApp {expr 2 / 0}"} {}
---- Result should have been (exact matching):
1 {divide by zero} {ARITH DIVZERO {divide by zero}}
{divide by zero
    while executing
"expr 2 / 0"
    invoked from within
"send testApp {expr 2 / 0}"} {}
==== winSend-2.4 FAILED


==== winSend-2.7 Tk_SendObjCmd - sending to another app
- error FAILED
==== Contents of test case:

    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    list [catch {send $interp {expr 2 / 0}} msg] $msg
$errorCode $errorInfo

---- Result was:
1 {divide by zero} ARITH {divide by zeroDIVZERO
    invoked from within
"send $interp {expr 2 / 0}"}
---- Result should have been (exact matching):
1 {divide by zero} {ARITH DIVZERO {divide by zero}}
{divide by zero
    while executing
"expr 2 / 0"
    invoked from within
"send $interp {expr 2 / 0}"}
==== winSend-2.7 FAILED


==== winSend-3.1 TkGetInterpNames FAILED
==== Contents of test case:

    set origLength [llength $currentInterps]
    set newLength [llength [winfo interps]]
    expr {($newLength - 2) == $origLength}

---- Result was:
0
---- Result should have been (exact matching):
1
==== winSend-3.1 FAILED


==== winSend-6.1 SendDDEServer - XTYP_CONNECT FAILED
==== Contents of test case:

    set foo "Hello, World"
    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    set command "dde request Tk [tk appname] foo"
    list [catch "send \{$interp\} \{$command\}" msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
0 {Hello, World}
==== winSend-6.1 FAILED


==== winSend-6.2 SendDDEServer - XTYP_CONNECT_CONFIRM
FAILED
==== Contents of test case:

    set foo "Hello, World"
    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    set command "dde request Tk [tk appname] foo"
    list [catch "send \{$interp\} \{$command\}" msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
0 {Hello, World}
==== winSend-6.2 FAILED


==== winSend-6.3 SendDDEServer - XTYP_DISCONNECT FAILED
==== Contents of test case:

    set foo "Hello, World"
    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    set command "dde request Tk [tk appname] foo"
    list [catch "send \{$interp\} \{$command\}" msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
0 {Hello, World}
==== winSend-6.3 FAILED


==== winSend-6.4 SendDDEServer - XTYP_REQUEST variable
FAILED
==== Contents of test case:

    set foo "Hello, World"
    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    set command "dde request Tk [tk appname] foo"
    list [catch "send \{$interp\} \{$command\}" msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
0 {Hello, World}
==== winSend-6.4 FAILED


==== winSend-6.5 SendDDEServer - XTYP_REQUEST array FAILED
==== Contents of test case:

    catch {unset foo}
    set foo(test) "Hello, World"
    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    set command "dde request Tk [tk appname] foo(test)"
    list [catch "send \{$interp\} \{$command\}" msg]
$msg [catch {unset foo}]

---- Result was:
1 {invalid command name "dde"} 0
---- Result should have been (exact matching):
0 {Hello, World} 0
==== winSend-6.5 FAILED


==== winSend-6.6 SendDDEServer - XTYP_REQUEST return
results FAILED
==== Contents of test case:

    set foo 3
    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    set command "send [tk appname] {expr $foo + 1}"
    list [catch "send \{$interp\} \{$command\}" msg] $msg

---- Result was:
1 {no application named "tktest"}
---- Result should have been (exact matching):
0 4
==== winSend-6.6 FAILED


==== winSend-6.7 SendDDEServer - XTYP_EXECUTE FAILED
==== Contents of test case:

    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    set command "send [tk appname] {expr 4 / 2}"
    list [catch "send \{$interp\} \{$command\}" msg] $msg

---- Result was:
1 {no application named "tktest"}
---- Result should have been (exact matching):
0 2
==== winSend-6.7 FAILED


==== winSend-6.8 SendDDEServer - XTYP_WILDCONNECT FAILED
==== Contents of test case:

    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    set command "dde services Tk {}"
    list [catch "send \{$interp\} \{$command\}"]

---- Result was:
1
---- Result should have been (exact matching):
0
==== winSend-6.8 FAILED


==== winSend-9.1 SetDDEError FAILED
==== Contents of test case:

    list [catch {dde execute Tk foo {set foo hello}}
msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
1 {dde command failed}
==== winSend-9.1 FAILED


==== winSend-10.1 Tk_DDEObjCmd - wrong num args FAILED
==== Contents of test case:

    list [catch {dde} msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
1 {wrong # args: should be "dde ?-async? serviceName
topicName value"}
==== winSend-10.1 FAILED


==== winSend-10.2 Tk_DDEObjCmd - unknown subcommand FAILED
==== Contents of test case:

    list [catch {dde foo} msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
1 {bad command "foo": must be execute, request, or
services}
==== winSend-10.2 FAILED


==== winSend-10.3 Tk_DDEObjCmd - execute - wrong num
args FAILED
==== Contents of test case:

    list [catch {dde execute} msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
1 {wrong # args: should be "dde execute ?-async?
serviceName topicName value"}
==== winSend-10.3 FAILED


==== winSend-10.4 Tk_DDEObjCmd - execute - wrong num
args FAILED
==== Contents of test case:

    list [catch {dde execute 3 4 5 6 7} msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
1 {wrong # args: should be "dde execute ?-async?
serviceName topicName value"}
==== winSend-10.4 FAILED


==== winSend-10.5 Tk_DDEObjCmd - execute async - wrong
num args FAILED
==== Contents of test case:

    list [catch {dde execute -async} msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
1 {wrong # args: should be "dde execute ?-async?
serviceName topicName value"}
==== winSend-10.5 FAILED


==== winSend-10.6 Tk_DDEObjCmd - request - wrong num
args FAILED
==== Contents of test case:

    list [catch {dde request} msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
1 {wrong # args: should be "dde request serviceName
topicName value"}
==== winSend-10.6 FAILED


==== winSend-10.7 Tk_DDEObjCmd - services wrong num
args FAILED
==== Contents of test case:

    list [catch {dde services} msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
1 {wrong # args: should be "dde services serviceName
topicName"}
==== winSend-10.7 FAILED


==== winSend-10.8 Tk_DDEObjCmd - null service name FAILED
==== Contents of test case:

    list [catch {dde services {} {tktest #2}}]

---- Result was:
1
---- Result should have been (exact matching):
0
==== winSend-10.8 FAILED


==== winSend-10.9 Tk_DDEObjCmd - null topic name FAILED
==== Contents of test case:

    list [catch {dde services {Tk} {}}]

---- Result was:
1
---- Result should have been (exact matching):
0
==== winSend-10.9 FAILED


==== winSend-10.10 Tk_DDEObjCmd - execute - nothing to
execute FAILED
==== Contents of test case:

    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    list [catch {dde execute Tk $interp {}} msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
1 {cannot execute null data}
==== winSend-10.10 FAILED


==== winSend-10.11 Tk_DDEObjCmd - execute - no such
conversation FAILED
==== Contents of test case:

    list [catch {dde execute Tk foo {set foo hello}}
msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
1 {dde command failed}
==== winSend-10.11 FAILED


==== winSend-10.12 Tk_DDEObjCmd - execute - async FAILED
==== Contents of test case:

    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    list [catch {dde execute -async Tk $interp {set foo
hello}} msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
0 {}
==== winSend-10.12 FAILED


==== winSend-10.13 Tk_DDEObjCmd - execute FAILED
==== Contents of test case:

    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    list [catch {dde execute Tk $interp {set foo
goodbye}} msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
0 {}
==== winSend-10.13 FAILED


==== winSend-10.14 Tk_DDEObjCmd - request - nothing to
request FAILED
==== Contents of test case:

    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    list [catch {dde request Tk $interp {}} msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
1 {cannot request value of null data}
==== winSend-10.14 FAILED


==== winSend-10.15 Tk_DDEObjCmd - request - invalid
interp FAILED
==== Contents of test case:

    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    list [catch {dde request Tk foo foo} msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
1 {dde command failed}
==== winSend-10.15 FAILED


==== winSend-10.16 Tk_DDEObjCmd - invalid variable FAILED
==== Contents of test case:

    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    send $interp {unset foo}
    list [catch {dde request Tk $interp foo} msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
1 {remote server cannot handle this command}
==== winSend-10.16 FAILED


==== winSend-10.17 Tk_DDEObjCmd - valid variable FAILED
==== Contents of test case:

    set newInterps [winfo interps]
    foreach interp $newInterps {
        if {[lsearch $currentInterps $interp] < 0} {
            break
        }
    }
    send $interp {set foo winSend-10.17}
    list [catch {dde request Tk $interp foo} msg] $msg

---- Result was:
1 {invalid command name "dde"}
---- Result should have been (exact matching):
0 winSend-10.17
==== winSend-10.17 FAILED


==== winSend-10.18 Tk_DDEObjCmd - services FAILED
==== Contents of test case:

    set currentService [list Tk [tk appname]]
    list [catch {dde services Tk {}} msg] [expr
[lsearch $msg $currentService] >
= 0]

---- Result was:
1 0
---- Result should have been (exact matching):
0 1
==== winSend-10.18 FAILED



----------------------------------------------------------------------

You can respond by visiting: 
https://sourceforge.net/tracker/?func=detail&atid=112997&aid=846141&group_id=12997