# -*- 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
  behavior.
  }
}

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 new -msg {dict external} \
    -pre {
      unset ::_
      Object create o
    } \
    -cmd {
      lappend ::_ [o dict set d a first]
      lappend ::_ [o dict set d b second]
      lappend ::_ [o dict get [o set d] b]
      set ::_
    } -expected {{a first} {a first b second} second} -count 2 \
    -post {o destroy; unset ::_}

nx::test new -msg {dict resolver} \
    -pre {
      Object create o
      o proc foo {} {
        dict set :mydict 1 one
        dict set :mydict 2 two
        dict keys ${:mydict}
      }
    } \
    -cmd {
      o foo
    } -expected {1 2} -count 2 \
    -post {o destroy}

#
# Check whether the setting of the autoname object property is already
# visible immediately after the object creation (e.g. in an overloaded
# "create" method. This is e.g. important for ttrace, catching object
# creates via instmixin.
#
nx::test new -msg {autonamed property + overloaded create} \
    -pre {
      set ::_ {}
      ::xotcl::Class create ::xotcl::_creator -instproc create {args} {
        set r [next]
        lappend ::_ [nsf::object::property $r autonamed]
        return $r
      }
      ::xotcl::Class instmixin ::xotcl::_creator
    } \
    -cmd {::xotcl::Object new; ::xotcl::Object a; ::xotcl::Object create a; ::xotcl::Object new; set ::_} \
    -expected {1 0 0 1} -count 1 \
    -post {::xotcl::Class instmixin ""; ::xotcl::_creator destroy; a destroy}


nx::test run

#
# Local variables:
#    mode: tcl
#    tcl-indent-level: 2
#    indent-tabs-mode: nil
# End:
