Tcl Source Code

	assemble {
	    push NaN; uplus
	}
    }
    -returnCodes error
    -result {can't use non-numeric floating-point value as operand of "+"}
}
test assemble-7.43.1 {tryCvtToNumeric} {
    -body {
	assemble {
	    push NaN; tryCvtToNumeric
	}
    }
    -returnCodes error
    -result {domain error: argument not in valid range}

}
test assemble-15.6 {listIndexImm} {
    -body {
	assemble {push {a b c}; listIndexImm end-1}
    }
    -result b
}
test assemble-15.7 {listIndexImm} {
    -body {
	assemble {push {a b c}; listIndexImm end}
    }
    -result c
}

# assemble-16 - invokeStk

    chan close [lreplace [list a] 0 end]
} -returnCodes error -match glob -result *

# ### ### ### ######### ######### #########

# cleanup
foreach file [list fooBar longfile script output test1 pipe my_script \
	test2 test3 cat kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
    removeFile $file
}
cleanupTests
}
namespace delete ::tcl::test::io

	coroutine D eval {yield X$x;yield Y$x}
    }
} -body {
    set ::x 15
    set ::x [f 12]
    D
} -cleanup {
    D
    unset ::x
    rename f {}
} -result YX15

test coroutine-5.1 {right numLevels on coro return} -constraints {testnrelevels} \
-setup {
    proc nestedYield {{val {}}} {

test iortrans.tf-11.0 {origin thread of moved transform gone} -setup {
    #puts <<$tcltest::mainThread>>main
    set tida [testthread create];	#puts <<$tida>>
    set tidb [testthread create];	#puts <<$tidb>>
} -constraints {testchannel testthread} -match glob -body {
    # Set up channel in thread
    testthread send $tida $helperscript
    testthread send $tidb $helperscript
    set chan [testthread send $tida {
	proc foo {args} {
	    handle.initialize clear drain flush limit? read write
	    handle.finalize
	    lappend ::res $args
	    return
	}

    lappend res [catch {testthread send $tidb [list tell $chan]} msg] $msg
    lappend res [catch {testthread send $tidb [list seek $chan 1]} msg] $msg
    lappend res [catch {testthread send $tidb [list gets $chan]} msg] $msg
    lappend res [catch {testthread send $tidb [list close $chan]} msg] $msg
    # The 'tell' is ok, as it passed through the transform to the base
    # channel without invoking the transform handler.
} -cleanup {
    testthread send $tidb tempdone
    tcltest::threadReap

} -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
test iortrans.tf-11.1 {origin thread of moved transform destroyed during access} -setup {
    #puts <<$tcltest::mainThread>>main
    set tida [testthread create];	#puts <<$tida>>
    set tidb [testthread create];	#puts <<$tidb>>
} -constraints {testchannel testthread} -match glob -body {
    # Set up channel in thread
    testthread send $tida $helperscript
    testthread send $tidb $helperscript
    set chan [testthread send $tida {
	proc foo {args} {
	    handle.initialize clear drain flush limit? read write
	    handle.finalize
	    lappend ::res $args
	    # destroy thread during channel access
	    testthread exit

	catch { puts $chan shoo } res
	catch { close $chan }
	testthread send -async $mid [list set ::res $res]
    }
    vwait ::res
    return $res
} -cleanup {
    testthread send $tidb tempdone
    tcltest::threadReap

} -result {Owner lost}

# ### ### ### ######### ######### #########

cleanupTests
return

} -returnCodes error -result {wrong # args: should be "info class call className methodName"}
test oo-call-2.10 {class call introspection - errors} -body {
    info class call a b c
} -returnCodes error -result {wrong # args: should be "info class call className methodName"}
test oo-call-2.11 {class call introspection - errors} -body {
    info class call notaclass x
} -returnCodes error -result {notaclass does not refer to an object}
test oo-call-2.12 {class call introspection - errors} -setup {
    oo::class create root
} -body {
    root create notaclass
    info class call notaclass x
} -returnCodes error -cleanup {
    root destroy
} -result {"notaclass" is not a class}

    } $vs
    test package-10.$n {package vcompare} {
	package vcompare $r $p
    } $vc
    incr n
}

test package-11.0.0 {package vcompare at 32bit boundary} {
    package vcompare [expr {1<<31}] [expr {(1<<31)-1}]
} 1

# Note: It is correct that the result of the very first test, i.e. "5.0 5.0a0"
# is 1, i.e. that version 5.0a0 satisfies a 5.0 requirement.

# The requirement "5.0" internally translates first to "5.0-6", and then to