# -*- Tcl -*- #memory trace on package prefer latest package require XOTcl 2.0; namespace import ::xotcl::* package require nx::test nx::test new -msg {test multiple dashed args o0} \ -cmd {Object create o0 [list -set a -a1] [list -set b "-b 1 -y 2"]} \ -expected ::o0 \ -post {o0 destroy} nx::test new -msg {test multiple dashed args o1} \ -cmd {Object create o1 -proc foo args {return 1} [list -set a -a1] [list -set b "-b 1 -y 2"]} \ -expected ::o1 \ -post {o1} nx::test new -msg {test multiple dashed args o2} \ -cmd {Object create o2 {-proc foo args {return 1}} {-set -a -t1} {-set b "-b 1 -y 2"}} \ -expected ::o2 \ -post {o2 destroy} nx::test new -msg {test multiple dashed args o3} \ -cmd {Object create o3 -proc foo args {return 1} {-set -a -t1} {-set b "-b 1 -y 2"}} \ -expected ::o3 \ -post {o3 destroy} nx::test configure -count 1000 @ @File {description { Regression and speed test for various ways to achieve a similar behaviour. } } set ccount 20 #set ocount 1014 #set ocount [expr {$ccount + 206}] #set ocount [expr {$ccount + 15}] set ocount [expr {$ccount + 6}] Class M1; Class M2 Class C -parameter {{p 99} {q 98} r} C instproc f args {next} C instproc init args { my instvar n v #for {set i 1} {$i<1000} {incr i} {set n($i) 1} #for {set i 1} {$i<1000} {incr i} {Object [self]::$i} for {set i 0} {$i<$::ccount} {incr i} {set n($i) 1} for {set i 0} {$i<$::ccount} {incr i} {Object [self]::$i} set v 1 } C instproc mixinappend m { my mixin [concat [my info mixin] $m] my info mixin } C instproc ma m { set mix [my info mixin] my mixin [lappend mix $m] my info mixin } C instproc existsViaInstvar {} { my instvar v info exists v } C instproc existsViaMyInstvar {} { my instvar v info exists v } C instproc existsViaExistsMethod {} { [self] exists v } C instproc existsViaMyExistsMethod {} { my exists v } C instproc existsViaDotExistsMethod {} { :exists v } C instproc existsViaResolver {} { info exists :v } C instproc notExistsViaInstvar {} { my instvar xxx info exists xxx } C instproc notExistsViaExistsMethod {} { my exists xxx } C instproc existsAndReturnValue1 {} { if {[my exists v]} { my set v } } C instproc existsAndReturnValue3 {} { if {[my exists v]} { set x [my set v] } } C instproc setViaInstvar x { my instvar v set v $x } C instproc setViaSetMethod x { my set v $x } C instproc setViaParameter x { my r $x } C instproc testAndSetViaInstvar x { my instvar v if {[info exists v]} {set v $x} } C instproc testAndSetViaSetMethod x { if {[my info vars v] ne ""} {my set v $x} } C instproc readViaInstvar {} { my instvar p set p } C instproc readViaSetMethod {} { my set p } C instproc readViaSetMethodNoSelf {} { ::c set p } C instproc readViaParameter {} { my p } C instproc readTwiceViaInstvar {} { my instvar p set p set p } C instproc readTwiceViaSetMethod {} { my set p my set p } C instproc readTwiceViaSetMethodNoSelf {} { ::c set p ::c set p } C instproc readTwiceViaParameter {} { my p my p } C instproc readTwovarsViaInstvar {} { my instvar p q set p set q } C instproc readTwovarsViaSetMethod {} { my set p my set q } C instproc readTwovarsViaSetMethodNoSelf {} { ::c set p ::c set q } C instproc readTwovarsViaParameter {} { my p my q } C instproc instvarAlias {} { my instvar {a b} set b 1 my exists a } C instproc explicitReturn {} { return [set i 1] } C instproc implicitReturn {} { set i 1 } C instproc explicitReturnFromVar {} { set i 1 return $i } C instproc implicitReturnFromVar {} { set i 1 set i } C instproc childNodeNamespace {} { Object [self]::13 } C instproc childNodeNamespaceCreate {} { Object create [self]::13 } C instproc createVolatileRc {} { Object new -volatile return 2 } C c Class D -superclass C D instproc init args {} D d #nx::test new -cmd {llength [c info children]} -count 1 -expected 999 #nx::test new -cmd {set x [llength [c info children]]} -count 1 -expected 999 nx::test new -cmd {llength [c info children]} -count 1 -expected $ccount nx::test new -cmd {set x [llength [c info children]]} -count 1 -expected $ccount nx::test new -cmd {set x [llength [Object info instances]]} -count 1 -expected $ocount nx::test new -cmd {llength [Object info instances]} -count 1 -expected $ocount nx::test new -cmd {d istype D} -expected 1 nx::test new -cmd {c setViaInstvar 100} -expected 100 nx::test new -cmd {c setViaSetMethod 100} -expected 100 nx::test new -cmd {c setViaParameter 100} -expected 100 nx::test new -cmd {c existsViaInstvar} nx::test new -cmd {c existsViaMyInstvar} nx::test new -cmd {c existsViaExistsMethod} nx::test new -cmd {c existsViaMyExistsMethod} nx::test new -cmd {c existsViaDotExistsMethod} nx::test new -cmd {c existsViaResolver} nx::test new -cmd {c exists v} nx::test new -cmd {c notExistsViaInstvar} -expected 0 nx::test new -cmd {c notExistsViaExistsMethod} -expected 0 nx::test new -cmd {c exists xxx} -expected 0 nx::test new -cmd {c existsAndReturnValue1} -expected 100 nx::test new -cmd {c existsAndReturnValue3} -expected 100 nx::test new -cmd {c testAndSetViaInstvar 100} -expected 100 nx::test new -cmd {c testAndSetViaSetMethod 100} -expected 100 nx::test new -cmd {c readViaInstvar} -expected 99 nx::test new -cmd {c readViaSetMethod} -expected 99 nx::test new -cmd {c readViaParameter} -expected 99 nx::test new -cmd {c readViaSetMethodNoSelf} -expected 99 nx::test new -cmd {c readTwiceViaInstvar} -expected 99 nx::test new -cmd {c readTwiceViaSetMethod} -expected 99 nx::test new -cmd {c readTwiceViaParameter} -expected 99 nx::test new -cmd {c readTwiceViaSetMethodNoSelf} -expected 99 nx::test new -cmd {c readTwovarsViaInstvar} -expected 98 nx::test new -cmd {c readTwovarsViaSetMethod} -expected 98 nx::test new -cmd {c readTwovarsViaParameter} -expected 98 nx::test new -cmd {c readTwovarsViaSetMethodNoSelf} -expected 98 nx::test new -cmd {c instvarAlias} nx::test new -cmd {c incr v} -post {c set v 1} -expected 101 nx::test new -cmd {c unset v; set r [c exists v]; c set v 1; set r} -expected 0 nx::test new -cmd {llength [Object info instances]} -count 1 -expected $ocount nx::test new -cmd {set x [llength [Object info instances]]} -count 1 -expected $ocount nx::test new -cmd {c explicitReturn} nx::test new -cmd {c implicitReturn} nx::test new -cmd {c explicitReturnFromVar} nx::test new -cmd {c implicitReturnFromVar} nx::test new -cmd {llength [Object info instances]} -count 1 -expected $ocount nx::test new -cmd {set x [llength [Object info instances]]} -count 1 -expected $ocount nx::test new -cmd {c childNodeNamespace} -expected ::c::13 nx::test new -cmd {llength [Object info instances]} -count 1 -expected $ocount nx::test new -cmd {c childNodeNamespaceCreate} -expected ::c::13 nx::test new -cmd {llength [Object info instances]} -expected $ocount nx::test new -cmd {c createVolatileRc} -expected 2 # should be still the same number as above nx::test new -count 1 -cmd {llength [Object info instances]} -expected $ocount nx::test new -cmd {Object new -volatile} -expected ::nsf::__\#F9 -count 2000 \ -post {foreach o [Object info instances ::nsf::__*] {$o destroy}} # should be still the same number as above nx::test new -count 1 -cmd {llength [Object info instances]} -expected $ocount nx::test new -cmd {Object new} -expected ::nsf::__\#lQ -count 2000 \ -post {foreach o [Object info instances ::nsf::__*] {$o destroy}} # should be still the same number as above nx::test new -count 1 -cmd {llength [Object info instances]} -expected $ocount nx::test new -cmd {Object new -childof o} -expected ::o::__\#0Hh \ -pre {Object o} -post {o destroy} # should be still the same number as above nx::test new -count 1 -cmd {llength [Object info instances]} -expected $ocount nx::test new -count 1000 -pre {::set ::count 0} \ -cmd {Object create [incr ::count]} \ -expected ::1 \ -post {::unset ::count} nx::test new -count 1000 -pre {::set ::count 0} \ -cmd {[incr ::count] destroy} \ -post {::unset ::count} \ -expected "" # nx::test new -count 1 -cmd {llength [Object info instances]} -expected $ocount # we create another object set ocount [expr {$ocount + 1}] nx::test new -cmd {Object create x} -expected ::x nx::test new -count 1 -cmd {llength [Object info instances]} -expected $ocount nx::test new -cmd {Object create x -set a -1 -set b ,, -set c a--} \ -expected ::x nx::test new -count 1 -cmd {llength [Object info instances]} -expected $ocount nx::test new -cmd {expr {[c array names n 5] ne ""}} nx::test new -count 1 -cmd {llength [Object info instances]} -expected $ocount nx::test new -cmd {info exists c::n(5)} nx::test new -count 1 -cmd {llength [Object info instances]} -expected $ocount nx::test new -cmd {c exists n(5)} nx::test new -cmd {llength [c info children]} -expected $ccount nx::test new -cmd {c info children ::c::5} -expected ::c::5 nx::test new -cmd {c info children 5} -expected ::c::5 nx::test new -cmd {c info children 5*} -expected ::c::5 nx::test new -count 1 -cmd {llength [Object info instances]} -expected $ocount nx::test new -cmd {Object info instances ::c::5*} -expected ::c::5 nx::test new -cmd {Object info instances ::c::5} -expected ::c::5 nx::test new -cmd {Object info instances ::c::5000} -expected "" nx::test new -count 100 -pre {set ::c::l ""} \ -cmd {lappend ::c::l 1} \ -post {c unset l} nx::test new \ -count 100 \ -cmd {c mixinappend M1} \ -expected ::M1 \ -post {c mixin ""} nx::test new \ -count 100 \ -cmd {c ma M1} \ -expected ::M1 \ -post {c mixin ""} nx::test new \ -count 100 \ -cmd {c mixin add M1} \ -expected "::M1" \ -post {c mixin ""} nx::test new \ -count 100 \ -cmd {c mixinappend M1; c mixinappend M2} \ -expected {::M1 ::M2} \ -post {c mixin ""} nx::test new \ -count 100 \ -cmd {c ma M1; c ma M2} \ -expected {::M1 ::M2} \ -post {c mixin ""} nx::test new \ -count 100 \ -pre {Class D; Class E; Object o -mixin {D E}} \ -cmd {o info mixin D} \ -expected {::D} \ -post {foreach o {D E o} {$o destroy}} nx::test new \ -count 100 \ -pre {Class D; Class E; Object o -mixin {D E}} \ -cmd {o info mixin E} \ -expected {::E} \ -post {foreach o {D E o} {$o destroy}} nx::test new \ -count 100 \ -pre {Class D; Class E; Object o -mixin {D E}} \ -cmd {o info mixin ::E*} \ -expected {::E} \ -post {foreach o {D E o} {$o destroy}} nx::test new \ -count 100 \ -pre {Class D; Class E; Class E1; Object o -mixin {D E E1}} \ -cmd {o info mixin ::E*} \ -expected {::E ::E1} \ -post {foreach o {D E E1 o} {$o destroy}} nx::test new \ -count 100 \ -pre {Class D; Class E; Class X1 -instmixin {D E}} \ -cmd {X1 info instmixin D} \ -expected {::D} \ -post {foreach o {D E X1} {$o destroy}} nx::test new \ -count 100 \ -pre {Class D; Class E; Class X2 -instmixin {D E}} \ -cmd {X2 info instmixin E} \ -expected {::E} \ -post {foreach o {D E X2} {$o destroy}} nx::test new \ -count 100 \ -pre {Class D; Class E; Class E1; Class X -instmixin {D E E1}} \ -cmd {X info instmixin ::E*} \ -expected {::E ::E1} \ -post {foreach o {D E E1 X} {$o destroy}} nx::test new \ -count 100 \ -pre {Class D; Class E; Class X3 -instmixin {D E}} \ -cmd {X3 info instmixin ::E*} \ -expected {::E} \ -post {foreach o {D E X3} {$o destroy}} nx::test new \ -count 100 \ -pre {Class D; Class E; Class X} \ -cmd {X instmixin {D E}; X instmixin delete ::E; X info instmixin} \ -expected {::D} \ -post {foreach o {D E X} {$o destroy}} nx::test new \ -count 100 \ -pre {Class D; Class E; Class X} \ -cmd {X instmixin {D E}; X instmixin delete E; X info instmixin} \ -expected {::D} \ -post {foreach o {D E X} {$o destroy}} nx::test new \ -count 100 \ -pre {Class D; Class E; Class E1; Class X} \ -cmd {X instmixin {D E E1}; catch {X instmixin delete ::E*}; X info instmixin} \ -expected {::D} \ -post {foreach o {D E E1 X} {$o destroy}} nx::test new \ -count 100 \ -pre {Class D; Class E; Class E1; Class X} \ -cmd {X instmixin {D E E1}; catch {X instmixin delete E*}; X info instmixin} \ -expected {::D} \ -post {foreach o {D E E1 X} {$o destroy}} nx::test new \ -cmd {C instfilter f; C info instfilter} \ -expected f \ -post {C instfilter ""} nx::test new -pre {set s \#hallo} -cmd {string match "\#*" $s} nx::test new -pre {set s \#hallo} -cmd {regexp {^\#} $s} nx::test new -pre {set s \#hallo} -cmd {expr {[string first "\#" $s] == 0}} nx::test new -pre {set s \#hallo} -cmd {expr {[string range $s 0 0] == "\#"}} nx::test new -pre {set s \#hallo} -cmd {regexp {^\#.*a} $s} nx::test new -pre {set s \#hallo} -cmd {regexp {^\#.*a.*o} $s} nx::test new -pre {set s \#hallo} -cmd {regexp {^\#.*a(.*)o} $s} nx::test new -pre {set s \#hallo} -cmd {regexp {^\#.*a(.*)o} $s _} nx::test new -pre {set s \#hallo} -cmd {regexp {^\#.*a(.*)o} $s _ out} nx::test new -msg {call proc of subobject directly} \ -pre {C c2; C c2::o; c2::o proc f a {incr a}} \ -cmd {c2::o::f 10} -expected 11 -count 5000 \ -post {c2 destroy} nx::test new -msg {call proc of subobject via dispatch} \ -pre {C c2; C c2::o; c2::o proc f a {incr a}} \ -cmd {c2::o f 10} -expected 11 -count 5000 \ -post {c2 destroy} #nx::test new -msg {call proc of object and subobject via dispatch} \ # -pre {C c2; C c2::o; c2::o proc f a {incr a}} \ # -cmd {c2 o f 10} -expected 11 -count 5000 \ # -post {c2 destroy} nx::test new -msg {dispatch subobject directly via [self]} \ -pre {C c2; C c2::o; c2::o proc f a {incr a}; c2 proc t a {[self]::o f $a}} \ -cmd {c2 t 12} -expected 13 -count 5000 \ -post {c2 destroy} #nx::test new -msg {dispatch subobject via my} \ # -pre {C c2; C c2::o; c2::o proc f a {incr a}; c2 proc t a {my o f $a}} \ # -cmd {c2 t 12} -expected 13 -count 5000 \ # -post {c2 destroy} ###### insttclcmd tests set cnt 10000 #nx::test new -msg {call insttclcmd (append) and check created variable} \ -pre {Object o} \ -cmd {o append X 1; o exists X} -expected 1 \ -post {o destroy} #nx::test new -msg {call tclcmd (regexep) and check created variable} \ -pre {Object o; o tclcmd regexp} \ -cmd {o regexp (a) a _ x; o exists x} -expected 1 -count $cnt \ -post {o destroy} nx::test new -msg {call forwarder for (append) and check created variable} \ -pre {Object o; o forward append -objscope} \ -cmd {o append X 1; o exists X} -expected 1 \ -post {o destroy} nx::test new -msg {call forwarder (regexep) and check created variable} \ -pre {Object o; o forward regexp -objscope} \ -cmd {o regexp (a) a _ x; o exists x} -expected 1 -count $cnt \ -post {o destroy} nx::test new -msg {call forwarder to another obj} \ -pre {Object o; Object t; o forward set t set; t set x 100} \ -cmd {o set x} -expected 100 -count $cnt \ -post {o destroy} set cnt 100000 nx::test new -msg {call handcoded incr} \ -pre {Class C; C create o; o set x 1} \ -cmd {o incr x 77} -expected 78 -count $cnt \ -post {o destroy} nx::test new -msg {call incr via instforward} \ -pre {Class C; C instforward ::incr -objscope; C create o; o set x 1} \ -cmd {o incr x 77} -expected 78 -count $cnt \ -post {o destroy} nx::test new -msg {call incr via forward} \ -pre {Class C; C create o; o forward ::incr -objscope; o set x 1} \ -cmd {o incr x 77} -expected 78 -count $cnt \ -post {o destroy} set cnt 10000 nx::test new -msg {call obj with namespace via forward} \ -pre {Object n; Object n::x; Object o -forward ::n::x} \ -cmd {o x self} -expected ::n::x -count $cnt \ -post {o destroy} nx::test new -msg {call obj with namespace via instforward} \ -pre {Object n; Object n::x; Class C; C create o; C instforward ::n::x} \ -cmd {o x self} -expected ::n::x -count $cnt \ -post {o destroy} nx::test new -msg {call obj with namespace via instforward and mixinclass} \ -pre {Object n; Object n::x; Class M -instforward ::n::x; Class C -instmixin M; C create o } \ -cmd {o x self} -expected ::n::x -count $cnt \ -post {o destroy} nx::test new -msg {call obj with namespace via instforward and next from proc} \ -pre { Object n; Object n::x; Class C -instforward ::n::x; C create o -proc x args {next} } \ -cmd {o x self} -expected ::n::x -count $cnt \ -post {o destroy} nx::test new -msg {call obj with namespace via instforward and next from instproc} \ -pre { Object n; Object n::x; Class C -instforward ::n::x; Class D -superclass C -instproc x args {next}; D create o } \ -cmd {o x self} -expected ::n::x -count $cnt \ -post {o destroy} nx::test new -msg {call obj with namespace via mixin and instforward and next} \ -pre {Object n; Object n::x; Class M -instforward ::n::x; Class N -superclass M -instproc x args {next}; Class C -instmixin N; C create o} \ -cmd {o x self} -expected ::n::x -count $cnt \ -post {o destroy} nx::test new -msg {return -code break} \ -pre {Class A -instproc br {} {return -code break}; A create a1} \ -cmd {catch {a1 br}} -expected 3 -count 2 \ -post {A destroy; a1 destroy} # # volatile tests # nx::test new -msg {volatile + new overloaded } \ -pre {Class A; A proc new args {next}} \ -cmd {set a [A new -volatile]; $a info class} -expected ::A -count 2 \ -post {A destroy} nx::test new -msg {volatile + next overloaded + proc } \ -pre {Class A; A proc new args {next}; proc foo {} {set a [A new -volatile]; $a info class}} \ -cmd {foo; ::A info instances} -expected {} -count 2 \ -post {A destroy; rename foo ""} nx::test new -msg {volatile + configure overloaded} \ -pre {Class A; A instproc configure args {next}} \ -cmd {A create a1 -volatile; A a2 -volatile; lsort [A info instances]} -expected "::a1 ::a2" -count 2 \ -post {A destroy} nx::test new -msg {volatile + configure overloaded + proc} \ -pre {Class A; A instproc configure args {next}; proc foo {} {A create a1 -volatile; A a2 -volatile}} \ -cmd {foo; ::A info instances} -expected {} -count 2 \ -post {A destroy; rename foo ""} nx::test new -msg {volatile + new overloaded + mixin + proc} \ -pre { Class MC -superclass Class;MC instproc new args {next} Class M; M instproc new args {puts M; next} MC A; A instmixin M MC B -superclass A; B proc new args {next} proc foo {} {B create b1 -volatile; b1 info class} } \ -cmd {foo; ::B info instances} -expected {} -count 2 \ -post {B destroy; A destroy; M destroy; MC destroy; rename foo ""} nx::test run # # Local variables: # mode: tcl # tcl-indent-level: 2 # indent-tabs-mode: nil # End: