Tcl Source Code

Artifact 0eb00c9f488b54ec9ea5ea619e7dfb3755b85d8d:

Attachment "testInterpLimits2.tcl" to ticket [3048170fff] added by johannes-kuhn 2010-08-19 05:32:45.

---

proc bghandler {interp error opt} {
	puts stderr "BGError in $interp: {$error} $opt"
}

proc newSecondsLimit {iName} {
    set elapsed [expr {([clock milliseconds] - $::t0)/1000.0}]
    puts "NewSecondsLimit $iName $elapsed"
    after 200 set ::ok 1
    vwait ::ok
    puts "waited for $iName"
    
    set newLimit [expr {[clock seconds] + $::secsMore}]
    interp limit $iName time -seconds $newLimit -command [list newSecondsLimit $iName]
    return
}

set ::t0 [clock milliseconds]
set ::secsMore 2

set int1 [interp create]
interp alias $int1 bghandler {} bghandler
interp bgerror {} {bghandler {}}
interp bgerror $int1 [list bghandler $int1]

newSecondsLimit $int1

interp eval $int1 {
    for {set nloop 0} {$nloop < 10000000} {incr nloop} {
        if {sin($nloop) eq {}} {
		# We should never reach this... But we do
		puts "Break now, errorInfo: $::errorInfo"
		break
	}
    }
}