#memory trace on

#../xotclsh
# $Id: s.speedtest.xotcl 1.13 01/05/16 14:27:49+02:00 neumann@mohegan.wu-wien.ac.at $
@ @File {description {
  Regression and speed test for various ways to achieve a similar
  behaviour.
  }
}
Class M1; Class M2
Class C -parameter {{p 99} {q 98} r}
#C instproc destroy args {
#  puts stderr "[self] is destroyed"
#  next
#}
C instproc f args {next}
C instproc init args {
  [self] 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}  
  set v 1
}

C instproc mixinappend m {
  [self] mixin [concat [[self] info mixin] $m]
  [self] info mixin
}
C instproc ma m {
  set mix [[self] info mixin]
  [self] mixin [lappend mix $m]
  [self] info mixin
}

C instproc existsViaInstvar {} {
  [self] instvar v 
  info exists v
}
C instproc existsViaNamespace {}  {
  info exists [self]::v
} 
C instproc existsViaExistsMethod {}  { 
  [self] exists v
}
C instproc notExistsViaInstvar {} {
  [self] instvar xxx
  info exists xxx
}
C instproc notExistsViaNamespace {}  {
  info exists [self]::xxx
}
C instproc notExistsViaExistsMethod {}  {
  [self] exists xxx
}

C instproc existsAndReturnValue1 {} { 
  if {[[self] exists v]} {
    [self] set v
  }
}
#C instproc existsAndReturnValue2 {} { 
#  if {[[self] exists v x]} {
#    set x
#  }
#}
C instproc existsAndReturnValue3 {} { 
  if {[[self] exists v]} {
    set x [[self] set v]
  }
}

C instproc setViaInstvar x {
  [self] instvar v
  set v $x
}
C instproc setViaSetMethod x {
  [self] set v $x
}
C instproc setViaNamespace x {
  set [self]::v $x
}
C instproc setViaNamespaceNoSelf x {
  set ::c::v $x
}
C instproc setViaParameter x {
  [self] r $x
}
C instproc testAndSetViaInstvar x {
  [self] instvar v
  if {[info exists v]} {set v $x}
}
C instproc testAndSetViaSetMethod x {
  if {[[self] info vars v] != ""} {[self] set v $x}
}
C instproc testAndSetViaNamespace x {
  if {[info exists [self]::v]} {set [self]::v $x}
}
C instproc testAndSetViaNamespaceNoSelf x {
  if {[info exists ::c::v]} {set ::c::v $x}
}
C instproc testAndSetViaNamespace2 x {
  set v [self]::v
  if {[info exists $v]} {set $v $x}
}

C instproc readViaInstvar {} {
  [self] instvar p
  set p
}
C instproc readViaSetMethod {} {
  [self] set p
}
C instproc readViaSetMethodNoSelf {} {
  ::c set p
}
C instproc readViaNamespace {} {
  set [self]::p
}
C instproc readViaNamespaceNoSelf {} {
  set ::c::p
}
C instproc readViaParameter {} {
  [self] p
  [self] p
}

C instproc readTwiceViaInstvar {} {
  [self] instvar p
  set p
  set p
}
C instproc readTwiceViaSetMethod {} {
  [self] set p
  [self] set p
}
C instproc readTwiceViaSetMethodNoSelf {} {
  ::c set p
  ::c set p
}
C instproc readTwiceViaNamespace {} {
  set [self]::p
  set [self]::p
}
C instproc readTwiceViaNamespaceNoSelf {} {
  set ::c::p
  set ::c::p
}
C instproc readTwiceViaParameter {} {
  [self] p
  [self] p
}
C instproc readTwovarsViaInstvar {} {
  [self] instvar p q
  set p
  set q
}
C instproc readTwovarsViaSetMethod {} {
  [self] set p
  [self] set q
}
C instproc readTwovarsViaSetMethodNoSelf {} {
  ::c set p
  ::c set q
}
C instproc readTwovarsViaNamespace {} {
  set [self]::p
  set [self]::q
}
C instproc readTwovarsViaNamespaceNoSelf {} {
  set ::c::p
  set ::c::q
}
C instproc readTwovarsViaParameter {} {
  [self] p
  [self] q
}

C instproc instvarAlias {} {
  [self] instvar {a b}
  set b 1
  [self] 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 childNodeClassMethod {} {
#  [self] Object 13
#}
# the following create ::c::create
#C instproc childNodeClassMethodCreate {} {
#  [self] Object create 13
#}
C instproc childNodeNamespace {} {
  Object [self]::13
}
C instproc childNodeNamespaceCreate {} {
  Object create [self]::13
}


C c
Class D -superclass C
D instproc init args {}
D d

Class Test  -parameter {
  cmd 
  {solution 1} 
  {count 1000} 
  reset pre}
Test set count 0 
Test proc new args {
  eval [self] create e[format %.3d [incr [self]::count]] $args
}
Test proc run {} {
  [self] set totalTime 0
  foreach example [lsort [[self] info instances]] {
    $example run
  }
  puts stderr "Total Time: [expr {[[self] set totalTime] / 1000.0}] ms"
}
Test instproc run args {
  [self] instvar cmd solution pre count reset 
  if {[info exists pre]} {eval $pre}
  set r [eval $cmd]
  if {$r == $solution} {
    if {[info exists count]} {set c $count} {set c 1000}
    regexp {^([0-9]+) +} [time $cmd $c] _ microSecs
    [self class] incr totalTime $microSecs
    puts stderr "[self]:\t[format %5d $microSecs] mms, \[$cmd\] = $r"
  } else {
    puts stderr "[self]:\tincorrect result for <$cmd>"
    puts stderr "\texpected: '$solution', got '$r'"
    exit -1
  }
  if {[info exists reset]} {eval $reset}
}

if {0} {
Test new -cmd {c setViaInstvar 100} -solution 100
Test new -cmd {c setViaSetMethod 100} -solution 100
Test new -cmd {c setViaNamespace 100} -solution 100
Test new -cmd {c setViaNamespaceNoSelf 100} -solution 100
Test new -cmd {c setViaParameter 100} -solution 100
} else {
Test new -cmd {d istype D} -solution 1

Test new -cmd {c setViaInstvar 100} -solution 100
Test new -cmd {c setViaSetMethod 100} -solution 100
Test new -cmd {c setViaNamespace 100} -solution 100
Test new -cmd {c setViaNamespaceNoSelf 100} -solution 100
Test new -cmd {c setViaParameter 100} -solution 100
Test new -cmd {c existsViaInstvar}
Test new -cmd {c existsViaNamespace}
Test new -cmd {c existsViaExistsMethod}
Test new -cmd {c exists v}
Test new -cmd {c notExistsViaInstvar}  -solution 0
Test new -cmd {c notExistsViaNamespace} -solution 0
Test new -cmd {c notExistsViaExistsMethod} -solution 0
Test new -cmd {c exists xxx}  -solution 0

Test new -cmd {c existsAndReturnValue1}  -solution 100
#Test new -cmd {c existsAndReturnValue2}  -solution 100
Test new -cmd {c existsAndReturnValue3}  -solution 100

Test new -cmd {c testAndSetViaInstvar 100} -solution 100
Test new -cmd {c testAndSetViaSetMethod 100} -solution 100
Test new -cmd {c testAndSetViaNamespace 100} -solution 100
Test new -cmd {c testAndSetViaNamespace2 100} -solution 100
Test new -cmd {c testAndSetViaNamespaceNoSelf 100} -solution 100

Test new -cmd {c readViaInstvar} -solution 99
Test new -cmd {c readViaSetMethod} -solution 99
Test new -cmd {c readViaNamespace} -solution 99
Test new -cmd {c readViaParameter} -solution 99
Test new -cmd {c readViaSetMethodNoSelf} -solution 99
Test new -cmd {c readViaNamespaceNoSelf} -solution 99

Test new -cmd {c readTwiceViaInstvar} -solution 99
Test new -cmd {c readTwiceViaSetMethod} -solution 99
Test new -cmd {c readTwiceViaNamespace} -solution 99
Test new -cmd {c readTwiceViaParameter} -solution 99
Test new -cmd {c readTwiceViaSetMethodNoSelf} -solution 99
Test new -cmd {c readTwiceViaNamespaceNoSelf} -solution 99

Test new -cmd {c readTwovarsViaInstvar} -solution 98
Test new -cmd {c readTwovarsViaSetMethod} -solution 98
Test new -cmd {c readTwovarsViaNamespace} -solution 98
Test new -cmd {c readTwovarsViaParameter} -solution 98
Test new -cmd {c readTwovarsViaSetMethodNoSelf} -solution 98
Test new -cmd {c readTwovarsViaNamespaceNoSelf} -solution 98

Test new -cmd {c instvarAlias}

Test new -cmd {c incr v} -reset {c set v 1} -solution 101
Test new -cmd {c unset v; set r [c exists v]; c set v 1; set r} -solution 0


Test new -cmd {c explicitReturn}
Test new -cmd {c implicitReturn}
Test new -cmd {c explicitReturnFromVar}
Test new -cmd {c implicitReturnFromVar}

#Test new -cmd {c childNodeClassMethod} -solution ::c::13
#Test new -cmd {c childNodeClassMethodCreate} -solution ::c::13
Test new -cmd {c childNodeNamespace} -solution ::c::13
Test new -cmd {c childNodeNamespaceCreate} -solution ::c::13
Test new -cmd {Object create x} -solution ::x
Test new -cmd {Object create x -set a -1 -set b ,, -set c a--} \
    -solution ::x
Test new -count 100 -pre {::set ::count 0} \
    -cmd {Object create [incr ::count]} \
    -solution ::1 \
    -reset {::unset ::count}
Test new -count 100 -pre {::set ::count 0} \
    -cmd {[incr ::count] destroy} \
    -reset {::unset ::count} \
    -solution ""

Test new -cmd {expr {[c array names n 500] != ""}}
Test new -cmd {info exists c::n(500)}
Test new -cmd {c exists n(500)}

Test new -cmd {llength [c info children]} -solution 999
Test new -cmd {c info children ::c::500}  -solution ::c::500
if {[info exists xotcl_version]} {
  Test new -cmd {llength [Object info instances]} -solution 1001
} else {
  Test new -cmd {llength [Object info instances]} -solution 1003
}

Test new -cmd {Object info instances ::c::500} -solution ::c::500

Test new -count 100 -pre {set ::c::l ""} \
    -cmd {lappend ::c::l 1} \
    -reset {c unset l}

Test new \
    -count 100 \
    -cmd {c mixinappend M1} \
    -solution ::M1 \
    -reset {c mixin ""}

Test new \
    -count 100 \
    -cmd  {c ma M1} \
    -solution ::M1 \
    -reset {c mixin ""}

Test new \
    -count 100 \
    -cmd {c mixinappend M1; c mixinappend M2} \
    -solution {::M1 ::M2} \
    -reset {c mixin ""}

Test new \
    -count 100 \
    -cmd {c ma M1; c ma M2} \
    -solution {::M1 ::M2} \
    -reset {c mixin ""}

Test new \
    -cmd {C filter f; C info filter} \
    -solution f \
    -reset {C filter ""}

Test new -pre {set s \#hallo} -cmd {string match "\#*" $s}
Test new -pre {set s \#hallo} -cmd {regexp {^\#} $s}
Test new -pre {set s \#hallo} -cmd {expr {[string first "\#" $s] == 0}}
Test new -pre {set s \#hallo} -cmd {expr {[string range $s 0 0] == "\#"}}

Test new -pre {set s \#hallo} -cmd {regexp {^\#.*a} $s}
Test new -pre {set s \#hallo} -cmd {regexp {^\#.*a.*o} $s}
Test new -pre {set s \#hallo} -cmd {regexp {^\#.*a(.*)o} $s}
Test new -pre {set s \#hallo} -cmd {regexp {^\#.*a(.*)o} $s _}
Test new -pre {set s \#hallo} -cmd {regexp {^\#.*a(.*)o} $s _ out}
}

Test run
