diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/fileName.test | 9 | ||||
| -rw-r--r-- | tests/stringObj.test | 13 | ||||
| -rw-r--r-- | tests/trace.test | 159 |
3 files changed, 175 insertions, 6 deletions
diff --git a/tests/fileName.test b/tests/fileName.test index d9dd9d4..580ec90 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: fileName.test,v 1.26 2002/07/10 13:08:20 dkf Exp $ +# RCS: @(#) $Id: fileName.test,v 1.27 2002/11/13 22:11:41 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1816,6 +1816,13 @@ test filename-16.16 {windows specific globbing} {pcOnly} { file tail [lindex [glob "[lindex [glob -types d -dir C:/ *] 0]/.."] 0] } {..} +test filename-17.1 {windows specific special files} {testsetplatform} { + testsetplatform win + list [file pathtype com1] [file pathtype con] [file pathtype lpt3] \ + [file pathtype prn] [file pathtype nul] [file pathtype aux] \ + [file pathtype foo] +} {absolute absolute absolute absolute absolute absolute relative} + # cleanup catch {file delete -force C:/globTest} file delete -force globTest diff --git a/tests/stringObj.test b/tests/stringObj.test index 115ba2c..c2db812 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: stringObj.test,v 1.11 2000/06/28 18:11:21 ericm Exp $ +# RCS: @(#) $Id: stringObj.test,v 1.12 2002/11/13 22:11:41 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -415,6 +415,17 @@ test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} { list [string length $a] [string length $a] } {10 10} +test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} {knownBug} { + teststringobj set 1 foo + teststringobj getunicode 1 + teststringobj append 1 bar -1 + teststringobj getunicode 1 + teststringobj append 1 bar -1 + teststringobj setlength 1 0 + teststringobj append 1 bar -1 + teststringobj get 1 +} {bar} + testobj freeallvars # cleanup diff --git a/tests/trace.test b/tests/trace.test index f72b0bd..2e8b61b 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: trace.test,v 1.23 2002/10/15 16:13:47 vincentdarley Exp $ +# RCS: @(#) $Id: trace.test,v 1.24 2002/11/13 22:11:41 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1850,24 +1850,175 @@ test trace-28.1 {enterstep and leavestep traces with update idletasks (615043)} trace add execution foo {enter enterstep leavestep leave} \ [list traceExecute foo] update - after idle {puts idle} + after idle {set a "idle"} foo trace remove execution foo {enter enterstep leavestep leave} \ [list traceExecute foo] rename foo {} + catch {unset a} join $info "\n" } {foo foo enter foo {set a 1} enterstep foo {set a 1} 0 1 leavestep foo {update idletasks} enterstep -foo {puts idle} enterstep -foo {puts idle} 0 {} leavestep +foo {set a idle} enterstep +foo {set a idle} 0 idle leavestep foo {update idletasks} 0 {} leavestep foo {set b 1} enterstep foo {set b 1} 0 1 leavestep foo foo 0 1 leave} +test trace-28.2 {exec traces with 'error'} { + set info {} + set res {} + + proc foo {} { + if {[catch {bar}]} { + return "error" + } else { + return "ok" + } + } + + proc bar {} { error "msg" } + + lappend res [foo] + + trace add execution foo {enter enterstep leave leavestep} \ + [list traceExecute foo] + + # With the trace active + + lappend res [foo] + + trace remove execution foo {enter enterstep leave leavestep} \ + [list traceExecute foo] + + list $res [join $info \n] +} {{error error} {foo foo enter +foo {if {[catch {bar}]} { + return "error" + } else { + return "ok" + }} enterstep +foo {catch bar} enterstep +foo bar enterstep +foo {error msg} enterstep +foo {error msg} 1 msg leavestep +foo bar 1 msg leavestep +foo {catch bar} 0 1 leavestep +foo {return error} enterstep +foo {return error} 2 error leavestep +foo {if {[catch {bar}]} { + return "error" + } else { + return "ok" + }} 2 error leavestep +foo foo 0 error leave}} + +test trace-28.3 {exec traces with 'return -code error'} { + set info {} + set res {} + + proc foo {} { + if {[catch {bar}]} { + return "error" + } else { + return "ok" + } + } + + proc bar {} { return -code error "msg" } + + lappend res [foo] + + trace add execution foo {enter enterstep leave leavestep} \ + [list traceExecute foo] + + # With the trace active + + lappend res [foo] + + trace remove execution foo {enter enterstep leave leavestep} \ + [list traceExecute foo] + + list $res [join $info \n] +} {{error error} {foo foo enter +foo {if {[catch {bar}]} { + return "error" + } else { + return "ok" + }} enterstep +foo {catch bar} enterstep +foo bar enterstep +foo {return -code error msg} enterstep +foo {return -code error msg} 2 msg leavestep +foo bar 1 msg leavestep +foo {catch bar} 0 1 leavestep +foo {return error} enterstep +foo {return error} 2 error leavestep +foo {if {[catch {bar}]} { + return "error" + } else { + return "ok" + }} 2 error leavestep +foo foo 0 error leave}} + +test trace-28.4 {exec traces in slave with 'return -code error'} {knownBug} { + interp create slave + interp alias slave traceExecute {} traceExecute + set res [interp eval slave { + set info {} + set res {} + + proc foo {} { + if {[catch {bar}]} { + return "error" + } else { + return "ok" + } + } + + proc bar {} { return -code error "msg" } + + lappend res [foo] + + trace add execution foo {enter enterstep leave leavestep} \ + [list traceExecute foo] + + # With the trace active + + lappend res [foo] + + trace remove execution foo {enter enterstep leave leavestep} \ + [list traceExecute foo] + + list $res [join $info \n] + }] + interp delete slave + set res +} {{error error} {foo foo enter +foo {if {[catch {bar}]} { + return "error" + } else { + return "ok" + }} enterstep +foo {catch bar} enterstep +foo bar enterstep +foo {return -code error msg} enterstep +foo {return -code error msg} 2 msg leavestep +foo bar 1 msg leavestep +foo {catch bar} 0 1 leavestep +foo {return error} enterstep +foo {return error} 2 error leavestep +foo {if {[catch {bar}]} { + return "error" + } else { + return "ok" + }} 2 error leavestep +foo foo 0 error leave}} + # Delete procedures when done, so we don't clash with other tests # (e.g. foobar will clash with 'unknown' tests). catch {rename foobar {}} |