trace.test

来自「tcl是工具命令语言」· TEST 代码 · 共 2,078 行 · 第 1/5 页

test trace-19.11 {trace add command qualifies when renamed in namespace} {
    set info {}
    namespace eval tc {rename tcfoo tcbar}
    set info
} {::tc::tcfoo ::tc::tcbar rename}

# Make sure it exists again
proc foo {} {}

test trace-20.1 {trace add command (delete option)} {
    trace add command foo delete traceCommand
    rename foo ""
    set info
} {::foo {} delete}
test trace-20.2 {trace add command delete doesn't trace recreated commands} {
    set info {}
    proc foo {} {}
    rename foo ""
    set info
} {}
test trace-20.2.1 {trace add command delete trace info} {
    proc foo {} {}
    trace add command foo delete traceCommand
    trace info command foo
} {{delete traceCommand}}
test trace-20.3 {trace add command implicit delete} {
    proc foo {} {}
    trace add command foo delete traceCommand
    proc foo {} {}
    set info
} {::foo {} delete}
test trace-20.3.1 {trace add command delete trace info} {
    proc foo {} {}
    trace info command foo
} {}
test trace-20.4 {trace add command rename followed by delete} {
    set infotemp {}
    proc foo {} {}
    trace add command foo {rename delete} traceCommand
    rename foo bar
    lappend infotemp $info
    rename bar {}
    lappend infotemp $info
    set info $infotemp
    unset infotemp
    set info
} {{::foo ::bar rename} {::bar {} delete}}
catch {rename foo {}}
catch {rename bar {}}

test trace-20.5 {trace add command rename and delete} {
    set infotemp {}
    set info {}
    proc foo {} {}
    trace add command foo {rename delete} traceCommand
    rename foo bar
    lappend infotemp $info
    rename bar {}
    lappend infotemp $info
    set info $infotemp
    unset infotemp
    set info
} {{::foo ::bar rename} {::bar {} delete}}

test trace-20.6 {trace add command rename and delete in subinterp} {
    set tc [interp create]
    foreach p {traceCommand} {
	$tc eval [list proc $p [info args $p] [info body $p]]
    }
    $tc eval [list set infotemp {}]
    $tc eval [list set info {}]
    $tc eval [list proc foo {} {}]
    $tc eval [list trace add command foo {rename delete} traceCommand]
    $tc eval [list rename foo bar]
    $tc eval {lappend infotemp $info}
    $tc eval [list rename bar {}]
    $tc eval {lappend infotemp $info}
    $tc eval {set info $infotemp}
    $tc eval [list unset infotemp]
    set info [$tc eval [list set info]]
    interp delete $tc
    set info
} {{::foo ::bar rename} {::bar {} delete}}

# I'd like it if this test could give 'foo {} d' as a result,
# but interp deletion means there is no interp to evaluate
# the trace in.
test trace-20.7 {trace add command delete in subinterp while being deleted} {
    set info {}
    set tc [interp create]
    interp alias $tc traceCommand {} traceCommand
    $tc eval [list proc foo {} {}]
    $tc eval [list trace add command foo {rename delete} traceCommand]
    interp delete $tc
    set info
} {}

proc traceDelete {cmd old new op} {
    eval trace remove command $cmd [lindex [trace info command $cmd] 0]
    global info
    set info [list $old $new $op]
}
proc traceCmdrename {cmd old new op} {
    rename $old someothername
}
proc traceCmddelete {cmd old new op} {
    rename $old ""
}
test trace-20.8 {trace delete while trace is active} {
    set info {}
    proc foo {} {}
    catch {rename bar {}}
    trace add command foo {rename delete} [list traceDelete foo]
    rename foo bar
    list [set info] [trace info command bar]
} {{::foo ::bar rename} {}}

test trace-20.9 {rename trace deletes command} {
    set info {}
    proc foo {} {}
    catch {rename bar {}}
    catch {rename someothername {}}
    trace add command foo rename [list traceCmddelete foo]
    rename foo bar
    list [info commands foo] [info commands bar] [info commands someothername]
} {{} {} {}}

test trace-20.10 {rename trace renames command} {
    set info {}
    proc foo {} {}
    catch {rename bar {}}
    catch {rename someothername {}}
    trace add command foo rename [list traceCmdrename foo]
    rename foo bar
    set info [list [info commands foo] [info commands bar] [info commands someothername]]
    rename someothername {}
    set info
} {{} {} someothername}

test trace-20.11 {delete trace deletes command} {
    set info {}
    proc foo {} {}
    catch {rename bar {}}
    catch {rename someothername {}}
    trace add command foo delete [list traceCmddelete foo]
    rename foo {}
    list [info commands foo] [info commands bar] [info commands someothername]
} {{} {} {}}

test trace-20.12 {delete trace renames command} {
    set info {}
    proc foo {} {}
    catch {rename bar {}}
    catch {rename someothername {}}
    trace add command foo delete [list traceCmdrename foo]
    rename foo bar
    rename bar {}
    # None of these should exist.
    list [info commands foo] [info commands bar] [info commands someothername]
} {{} {} {}}

proc foo {b} { set a $b }


# Delete arrays when done, so they can be re-used as scalars
# elsewhere.

catch {unset x}
catch {unset y}

# Delete procedures when done, so we don't clash with other tests
# (e.g. foobar will clash with 'unknown' tests).
catch {rename foobar {}}
catch {rename foo {}}
catch {rename bar {}}

proc foo {a} {
    set b $a
}

proc traceExecute {args} {
    global info
    lappend info $args
}

test trace-21.1 {trace execution: enter} {
    set info {}
    trace add execution foo enter [list traceExecute foo]
    foo 1
    trace remove execution foo enter [list traceExecute foo]
    set info
} {{foo {foo 1} enter}}

test trace-21.2 {trace exeuction: leave} {
    set info {}
    trace add execution foo leave [list traceExecute foo]
    foo 2
    trace remove execution foo leave [list traceExecute foo]
    set info
} {{foo {foo 2} 0 2 leave}}

test trace-21.3 {trace exeuction: enter, leave} {
    set info {}
    trace add execution foo {enter leave} [list traceExecute foo]
    foo 3
    trace remove execution foo {enter leave} [list traceExecute foo]
    set info
} {{foo {foo 3} enter} {foo {foo 3} 0 3 leave}}

test trace-21.4 {trace execution: enter, leave, enterstep} {
    set info {}
    trace add execution foo {enter leave enterstep} [list traceExecute foo]
    foo 3
    trace remove execution foo {enter leave enterstep} [list traceExecute foo]
    set info
} {{foo {foo 3} enter} {foo {set b 3} enterstep} {foo {foo 3} 0 3 leave}}

test trace-21.5 {trace execution: enter, leave, enterstep, leavestep} {
    set info {}
    trace add execution foo {enter leave enterstep leavestep} [list traceExecute foo]
    foo 3
    trace remove execution foo {enter leave enterstep leavestep} [list traceExecute foo]
    set info
} {{foo {foo 3} enter} {foo {set b 3} enterstep} {foo {set b 3} 0 3 leavestep} {foo {foo 3} 0 3 leave}}

test trace-21.6 {trace execution: enterstep, leavestep} {
    set info {}
    trace add execution foo {enterstep leavestep} [list traceExecute foo]
    foo 3
    trace remove execution foo {enterstep leavestep} [list traceExecute foo]
    set info
} {{foo {set b 3} enterstep} {foo {set b 3} 0 3 leavestep}}

test trace-21.7 {trace execution: enterstep} {
    set info {}
    trace add execution foo {enterstep} [list traceExecute foo]
    foo 3
    trace remove execution foo {enterstep} [list traceExecute foo]
    set info
} {{foo {set b 3} enterstep}}

test trace-21.8 {trace execution: leavestep} {
    set info {}
    trace add execution foo {leavestep} [list traceExecute foo]
    foo 3
    trace remove execution foo {leavestep} [list traceExecute foo]
    set info
} {{foo {set b 3} 0 3 leavestep}}

proc factorial {n} {
    if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }
    return 1
}

test trace-22.1 {recursive(1) trace execution: enter} {
    set info {}
    trace add execution factorial {enter} [list traceExecute factorial]
    factorial 1
    trace remove execution factorial {enter} [list traceExecute factorial]
    set info
} {{factorial {factorial 1} enter}}

test trace-22.2 {recursive(2) trace execution: enter} {
    set info {}
    trace add execution factorial {enter} [list traceExecute factorial]
    factorial 2
    trace remove execution factorial {enter} [list traceExecute factorial]
    set info
} {{factorial {factorial 2} enter} {factorial {factorial 1} enter}}

test trace-22.3 {recursive(3) trace execution: enter} {
    set info {}
    trace add execution factorial {enter} [list traceExecute factorial]
    factorial 3
    trace remove execution factorial {enter} [list traceExecute factorial]
    set info
} {{factorial {factorial 3} enter} {factorial {factorial 2} enter} {factorial {factorial 1} enter}}

test trace-23.1 {recursive(1) trace execution: enter, leave, enterstep, leavestep} {
    set info {}
    trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
    factorial 1
    trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
    join $info "\n"
} {{factorial 1} enter
{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
{return 1} enterstep
{return 1} 2 1 leavestep
{factorial 1} 0 1 leave}

test trace-23.2 {recursive(2) trace execution: enter, leave, enterstep, leavestep} {
    set info {}
    trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
    factorial 2
    trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
    join $info "\n"
} {{factorial 2} enter
{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
{expr {$n -1 }} enterstep
{expr {$n -1 }} 0 1 leavestep
{factorial 1} enterstep
{factorial 1} enter
{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
{return 1} enterstep
{return 1} 2 1 leavestep
{factorial 1} 0 1 leave
{factorial 1} 0 1 leavestep
{expr {$n * [factorial [expr {$n -1 }]]}} 0 2 leavestep
{return 2} enterstep
{return 2} 2 2 leavestep
{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 2 leavestep
{factorial 2} 0 2 leave}

test trace-23.3 {recursive(3) trace execution: enter, leave, enterstep, leavestep} {
    set info {}
    trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
    factorial 3
    trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
    join $info "\n"
} {{factorial 3} enter
{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
{expr {$n -1 }} enterstep
{expr {$n -1 }} 0 2 leavestep
{factorial 2} enterstep
{factorial 2} enter
{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
{expr {$n -1 }} enterstep
{expr {$n -1 }} 0 1 leavestep
{factorial 1} enterstep
{factorial 1} enter
{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
{return 1} enterstep
{return 1} 2 1 leavestep
{factorial 1} 0 1 leave
{factorial 1} 0 1 leavestep
{expr {$n * [factorial [expr {$n -1 }]]}} 0 2 leavestep
{return 2} enterstep
{return 2} 2 2 leavestep
{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 2 leavestep
{factorial 2} 0 2 leave
{factorial 2} 0 2 leavestep
{expr {$n * [factorial [expr {$n -1 }]]}} 0 6 leavestep
{return 6} enterstep
{return 6} 2 6 leavestep
{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 6 leavestep
{factorial 3} 0 6 leave}

proc traceDelete {cmd args} {
    eval trace remove execution $cmd [lindex [trace info execution $cmd] 0]
    global info
    set info $args
}

test trace-24.1 {delete trace during enter trace} {
    set info {}
    trace add execution foo enter [list traceDelete foo]
    foo 1
    list $info [catch {trace info execution foo} res] $res
} {{{foo 1} enter} 0 {}}

test trace-24.2 {delete trace during leave trace} {
    set info {}
    trace add execution foo leave [list traceDelete foo]
    foo 1
    list $info [catch {trace info execution foo} res] $res
} {{{foo 1} 0 1 leave} 0 {}}

test trace-24.3 {delete trace during enter-leave trace} {
    set info {}
    trace add execution foo {enter leave} [list traceDelete foo]
    foo 1
    list $info [catch {trace info execution foo} res] $res
} {{{foo 1} enter} 0 {}}

test trace-24.4 {delete trace during all exec traces} {
    set info {}
    trace add execution foo {enter leave enterstep leavestep} [list traceDelete foo]
    foo 1
    list $info [catch {trace info execution foo} res] $res
} {{{foo 1} enter} 0 {}}

test trace-24.5 {delete trace during all exec traces except enter} {
    set info {}
    trace add execution foo {leave enterstep leavestep} [list traceDelete foo]
    foo 1
    list $info [catch {trace info execution foo} res] $res
} {{{set b 1} enterstep} 0 {}}

proc traceDelete {cmd args} {
    rename $cmd {}
    global info
    set info $args
}

proc foo {a} {
    set b $a
}

test trace-25.1 {delete command during enter trace} {
    set info {}
    trace add execution foo enter [list traceDelete foo]
    catch {foo 1} err
    list $err $info [catch {trace info execution foo} res] $res
} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}}

proc foo {a} {
    set b $a
}

test trace-25.2 {delete command during leave trace} {