interp.test

linux系统下的音频通信

# This file tests the multiple interpreter facility of Tcl
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) interp.test 1.64 97/09/04 16:02:23

if {[string compare test [info procs test]] == 1} then {source defs}

# The set of hidden commands is platform dependent:

if {"$tcl_platform(platform)" == "macintosh"} {
    set hidden_cmds {beep cd echo exit fconfigure file glob load ls open pwd socket source}
} else {
    set hidden_cmds {cd exec exit fconfigure file glob load open pwd socket source}
}

foreach i [interp slaves] {
  interp delete $i
}

proc equiv {x} {return $x}

# Part 0: Check out options for interp command
test interp-1.1 {options for interp command} {
    list [catch {interp} msg] $msg
} {1 {wrong # args: should be "interp cmd ?arg ...?"}}
test interp-1.2 {options for interp command} {
    list [catch {interp frobox} msg] $msg
} {1 {bad option "frobox": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}}
test interp-1.3 {options for interp command} {
    interp delete
} ""
test interp-1.4 {options for interp command} {
    list [catch {interp delete foo bar} msg] $msg
} {1 {interpreter named "foo" not found}}
test interp-1.5 {options for interp command} {
    list [catch {interp exists foo bar} msg] $msg
} {1 {wrong # args: should be "interp exists ?path?"}}
#
# test interp-0.6 was removed
#
test interp-1.6 {options for interp command} {
    list [catch {interp slaves foo bar zop} msg] $msg
} {1 {wrong # args: should be "interp slaves ?path?"}}
test interp-1.7 {options for interp command} {
    list [catch {interp hello} msg] $msg
} {1 {bad option "hello": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}}
test interp-1.8 {options for interp command} {
    list [catch {interp -froboz} msg] $msg
} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}}
test interp-1.9 {options for interp command} {
    list [catch {interp -froboz -safe} msg] $msg
} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}} 
test interp-1.10 {options for interp command} {
    list [catch {interp target} msg] $msg
} {1 {wrong # args: should be "interp target path alias"}}

# Part 1: Basic interpreter creation tests:
test interp-2.1 {basic interpreter creation} {
    interp create a
} a
test interp-2.2 {basic interpreter creation} {
    catch {interp create}
} 0
test interp-2.3 {basic interpreter creation} {
    catch {interp create -safe}
} 0 
test interp-2.4 {basic interpreter creation} {
    list [catch {interp create a} msg] $msg
} {1 {interpreter named "a" already exists, cannot create}}
test interp-2.5 {basic interpreter creation} {
    interp create b -safe
} b
test interp-2.6 {basic interpreter creation} {
    interp create d -safe
} d
test interp-2.7 {basic interpreter creation} {
    list [catch {interp create -froboz} msg] $msg
} {1 {bad option "-froboz": should be -safe}}
test interp-2.8 {basic interpreter creation} {
    interp create -- -froboz
} -froboz
test interp-2.9 {basic interpreter creation} {
    interp create -safe -- -froboz1
} -froboz1
test interp-2.10 {basic interpreter creation} {
    interp create {a x1}
    interp create {a x2}
    interp create {a x3} -safe
} {a x3}
test interp-2.11 {anonymous interps vs existing procs} {
    set x [interp create]
    regexp "interp(\[0-9]+)" $x dummy thenum
    interp delete $x
    incr thenum
    proc interp$thenum {} {}
    set x [interp create]
    regexp "interp(\[0-9]+)" $x dummy anothernum
    expr $anothernum - $thenum
} 1    
test interp-2.12 {anonymous interps vs existing procs} {
    set x [interp create -safe]
    regexp "interp(\[0-9]+)" $x dummy thenum
    interp delete $x
    incr thenum
    proc interp$thenum {} {}
    set x [interp create -safe]
    regexp "interp(\[0-9]+)" $x dummy anothernum
    expr $anothernum - $thenum
} 1    
    
foreach i [interp slaves] {
    interp delete $i
}

# Part 2: Testing "interp slaves" and "interp exists"
test interp-3.1 {testing interp exists and interp slaves} {
    interp slaves
} ""
test interp-3.2 {testing interp exists and interp slaves} {
    interp create a
    interp exists a
} 1
test interp-3.3 {testing interp exists and interp slaves} {
    interp exists nonexistent
} 0
test interp-3.4 {testing interp exists and interp slaves} {
    list [catch {interp slaves a b c} msg] $msg
} {1 {wrong # args: should be "interp slaves ?path?"}}
test interp-3.5 {testing interp exists and interp slaves} {
    list [catch {interp exists a b c} msg] $msg
} {1 {wrong # args: should be "interp exists ?path?"}}
test interp-3.6 {testing interp exists and interp slaves} {
    interp exists
} 1
test interp-3.7 {testing interp exists and interp slaves} {
    interp slaves
} a
test interp-3.8 {testing interp exists and interp slaves} {
    list [catch {interp slaves a b c} msg] $msg
} {1 {wrong # args: should be "interp slaves ?path?"}}
test interp-3.9 {testing interp exists and interp slaves} {
    interp create {a a2} -safe
    expr {[lsearch [interp slaves a] a2] >= 0}
} 1
test interp-3.10 {testing interp exists and interp slaves} {
    interp exists {a a2}
} 1

# Part 3: Testing "interp delete"
test interp-3.11 {testing interp delete} {
    interp delete
} ""
test interp-4.1 {testing interp delete} {
    catch {interp create a}
    interp delete a
} ""
test interp-4.2 {testing interp delete} {
    list [catch {interp delete nonexistent} msg] $msg
} {1 {interpreter named "nonexistent" not found}}
test interp-4.3 {testing interp delete} {
    list [catch {interp delete x y z} msg] $msg
} {1 {interpreter named "x" not found}}
test interp-4.4 {testing interp delete} {
    interp delete
} ""
test interp-4.5 {testing interp delete} {
    interp create a
    interp create {a x1}
    interp delete {a x1}
    expr {[lsearch [interp slaves a] x1] >= 0}
} 0
test interp-4.6 {testing interp delete} {
    interp create c1
    interp create c2
    interp create c3
    interp delete c1 c2 c3
} ""
test interp-4.7 {testing interp delete} {
    interp create c1
    interp create c2
    list [catch {interp delete c1 c2 c3} msg] $msg
} {1 {interpreter named "c3" not found}}

foreach i [interp slaves] {
    interp delete $i
}

# Part 4: Consistency checking - all nondeleted interpreters should be
# there:
test interp-5.1 {testing consistency} {
    interp slaves
} ""
test interp-5.2 {testing consistency} {
    interp exists a
} 0
test interp-5.3 {testing consistency} {
    interp exists nonexistent
} 0

# Recreate interpreter "a"
interp create a

# Part 5: Testing eval in interpreter object command and with interp command
test interp-6.1 {testing eval} {
    a eval expr 3 + 5
} 8
test interp-6.2 {testing eval} {
    list [catch {a eval foo} msg] $msg
} {1 {invalid command name "foo"}}
test interp-6.3 {testing eval} {
    a eval {proc foo {} {expr 3 + 5}}
    a eval foo
} 8
test interp-6.4 {testing eval} {
    interp eval a foo
} 8

test interp-6.5 {testing eval} {
    interp create {a x2}
    interp eval {a x2} {proc frob {} {expr 4 * 9}}
    interp eval {a x2} frob
} 36
test interp-6.6 {testing eval} {
    list [catch {interp eval {a x2} foo} msg] $msg
} {1 {invalid command name "foo"}}

# UTILITY PROCEDURE RUNNING IN MASTER INTERPRETER:
proc in_master {args} {
     return [list seen in master: $args]
}

# Part 6: Testing basic alias creation
test interp-7.1 {testing basic alias creation} {
    a alias foo in_master
} foo
test interp-7.2 {testing basic alias creation} {
    a alias bar in_master a1 a2 a3
} bar
# Test 6.3 has been deleted.
test interp-7.3 {testing basic alias creation} {
    a alias foo
} in_master
test interp-7.4 {testing basic alias creation} {
    a alias bar
} {in_master a1 a2 a3}
test interp-7.5 {testing basic alias creation} {
    a aliases
} {foo bar}

# Part 7: testing basic alias invocation
test interp-8.1 {testing basic alias invocation} {
    catch {interp create a}
    a alias foo in_master
    a eval foo s1 s2 s3
} {seen in master: {s1 s2 s3}}
test interp-8.2 {testing basic alias invocation} {
    catch {interp create a}
    a alias bar in_master a1 a2 a3
    a eval bar s1 s2 s3
} {seen in master: {a1 a2 a3 s1 s2 s3}}

# Part 8: Testing aliases for non-existent targets
test interp-9.1 {testing aliases for non-existent targets} {
    catch {interp create a}
    a alias zop nonexistent-command-in-master
    list [catch {a eval zop} msg] $msg
} {1 {invalid command name "nonexistent-command-in-master"}}
test interp-9.2 {testing aliases for non-existent targets} {
    catch {interp create a}
    a alias zop nonexistent-command-in-master
    proc nonexistent-command-in-master {} {return i_exist!}
    a eval zop
} i_exist!

if {[info command nonexistent-command-in-master] != ""} {
    rename nonexistent-command-in-master {}
}

# Part 9: Aliasing between interpreters
test interp-10.1 {testing aliasing between interpreters} {
    catch {interp delete a}
    catch {interp delete b}
    interp create a
    interp create b
    interp alias a a_alias b b_alias 1 2 3
} a_alias
test interp-10.2 {testing aliasing between interpreters} {
    catch {interp delete a}
    catch {interp delete b}
    interp create a
    interp create b
    b eval {proc b_alias {args} {return [list got $args]}}
    interp alias a a_alias b b_alias 1 2 3
    a eval a_alias a b c
} {got {1 2 3 a b c}}
test interp-10.3 {testing aliasing between interpreters} {
    catch {interp delete a}
    catch {interp delete b}
    interp create a
    interp create b
    interp alias a a_alias b b_alias 1 2 3
    list [catch {a eval a_alias a b c} msg] $msg
} {1 {invalid command name "b_alias"}}
test interp-10.4 {testing aliasing between interpreters} {
    catch {interp delete a}
    interp create a
    a alias a_alias puts
    a aliases
} a_alias
test interp-10.5 {testing aliasing between interpreters} {
    catch {interp delete a}
    catch {interp delete b}
    interp create a
    interp create b
    a alias a_alias puts
    interp alias a a_del b b_del
    interp delete b
    a aliases
} a_alias
test interp-10.6 {testing aliasing between interpreters} {
    catch {interp delete a}
    catch {interp delete b}
    interp create a
    interp create b
    interp alias a a_command b b_command a1 a2 a3
    b alias b_command in_master b1 b2 b3
    a eval a_command m1 m2 m3
} {seen in master: {b1 b2 b3 a1 a2 a3 m1 m2 m3}}
test interp-10.7 {testing aliases between interpreters} {
    catch {interp delete a}
    interp create a
    interp alias "" foo a zoppo
    a eval {proc zoppo {x} {list $x $x $x}}
    set x [foo 33]
    a eval {rename zoppo {}}
    interp alias "" foo a {}
    equiv $x
} {33 33 33}

# Part 10: Testing "interp target"
test interp-11.1 {testing interp target} {
    list [catch {interp target} msg] $msg
} {1 {wrong # args: should be "interp target path alias"}}
test interp-11.2 {testing interp target} {
    list [catch {interp target nosuchinterpreter foo} msg] $msg
} {1 {could not find interpreter "nosuchinterpreter"}}
test interp-11.3 {testing interp target} {
    catch {interp delete a}
    interp create a
    a alias boo no_command
    interp target a boo
} ""
test interp-11.4 {testing interp target} {
    catch {interp delete x1}
    interp create x1
    x1 eval interp create x2
    x1 eval x2 eval interp create x3
    catch {interp delete y1}
    interp create y1
    y1 eval interp create y2
    y1 eval y2 eval interp create y3
    interp alias {x1 x2 x3} xcommand {y1 y2 y3} ycommand
    interp target {x1 x2 x3} xcommand
} {y1 y2 y3}
test interp-11.5 {testing interp target} {
    catch {interp delete x1}
    interp create x1
    interp create {x1 x2}
    interp create {x1 x2 x3}
    catch {interp delete y1}
    interp create y1
    interp create {y1 y2}
    interp create {y1 y2 y3}
    interp alias {x1 x2 x3} xcommand {y1 y2 y3} ycommand
    list [catch {x1 eval {interp target {x2 x3} xcommand}} msg] $msg
} {1 {target interpreter for alias "xcommand" in path "x2 x3" is not my descendant}}
test interp-11.6 {testing interp target} {
    foreach a [interp aliases] {
	rename $a {}
    }
    list [catch {interp target {} foo} msg] $msg
} {1 {alias "foo" in path "" not found}}
test interp-11.7 {testing interp target} {
    catch {interp delete a}
    interp create a
    list [catch {interp target a foo} msg] $msg
} {1 {alias "foo" in path "a" not found}}

# Part 11: testing "interp issafe"
test interp-12.1 {testing interp issafe} {
    interp issafe
} 0
test interp-12.2 {testing interp issafe} {
    catch {interp delete a}
    interp create a
    interp issafe a
} 0
test interp-12.3 {testing interp issafe} {
    catch {interp delete a}
    interp create a
    interp create {a x3} -safe
    interp issafe {a x3}
} 1
test interp-12.4 {testing interp issafe} {
    catch {interp delete a}
    interp create a
    interp create {a x3} -safe
    interp create {a x3 foo}
    interp issafe {a x3 foo}
} 1

# Part 12: testing interpreter object command "issafe" sub-command
test interp-13.1 {testing foo issafe} {
    catch {interp delete a}
    interp create a
    a issafe
} 0
test interp-13.2 {testing foo issafe} {
    catch {interp delete a}
    interp create a
    interp create {a x3} -safe
    a eval x3 issafe
} 1
test interp-13.3 {testing foo issafe} {
    catch {interp delete a}
    interp create a
    interp create {a x3} -safe
    interp create {a x3 foo}
    a eval x3 eval foo issafe
} 1

# part 14: testing interp aliases
test interp-14.1 {testing interp aliases} {
    interp aliases
} ""
test interp-14.2 {testing interp aliases} {
    catch {interp delete a}
    interp create a
    a alias a1 puts
    a alias a2 puts
    a alias a3 puts
    lsort [interp aliases a]
} {a1 a2 a3}
test interp-14.3 {testing interp aliases} {