package provide xotcl::test 2.0
package require XOTcl

namespace eval ::xotcl::test {
  ::xotcl::use xotcl2

  @ @File {description {
    Simple regression test support.
  }}

  @ Class Test {
    description {
      Class Test is used to configure test instances, which can 
      be configured by the following parameters:
      <@ul>
      <@li>cmd: the command to be executed</@li>
      <@li>expected: the expected result</@li>
      <@li>count: number of executions of cmd</@li>
      <@li>pre: a command to be executed at the begin of the test (before cmd)</@li>
      <@li>post: a command to be executed after the test (after all cmds)</@li>
      <@li>namespace in which pre, post and cmd are evaluated; default ::</@li>
      </@ul>
      The defined tests can be executed by <@tt>Test run</@tt>
    }
  }

  Class create Test -parameter {
    {name ""}
    cmd 
    {namespace ::}
    {verbose 0} 
    {expected 1} 
    {count 100} 
    msg setResult errorReport
    pre post
  } {
    set :count 0

    :public object method case {name} {set :case $name}

    :public object method parameter {name value:optional} {
      if {[info exists value]} {
        #[[self] slot $name] default $value
        [self] slot $name default $value
        :__invalidateobjectparameter
      } else {
        return [[self] slot $name default]
      }
    }

    :public object method new args {
      if {[info exists :case]} {
	if {![info exists :ccount(${:case})]} {set :ccount(${:case}) 0}
	set :name ${:case}.[format %.3d [incr :ccount(${:case})]]
      } else {
	set :name t.[format %.3d [incr :count]]
      }
      eval :create ${:name} -name ${:name} $args
    }

    :public object method run {} {
      set startTime [clock clicks -milliseconds]
      foreach example [lsort [:info instances -closure]] {
	$example run
      }
      puts stderr "Total Time: [expr {[clock clicks -milliseconds]-$startTime}] ms"
    }
    
    :public method call {msg cmd} {
      if {[:verbose]} {puts stderr "$msg: $cmd"}
      namespace eval ${:namespace} $cmd
    }
   
    :public method run args {
      if {[info exists :pre]} {:call "pre" ${:pre}}
      if {![info exists :msg]} {set :msg ${:cmd}}
      set r [:call "run" ${:cmd}]
      if {[info exists :setResult]} {set r [eval [set :setResult]]}
      if {$r eq ${:expected}} {
	if {[info exists :count]} {set c ${:count}} {set c 1000}
	if {[:verbose]} {
	  puts stderr "running test $c times"
	}
	if {$c > 1} {
	  #set r0 [time ${:cmd} $c]
	  #puts stderr "time {time ${:cmd} $c}"
	  set r1 [time {time {namespace eval ${:namespace} ${:cmd}} $c}]
	  #regexp {^(-?[0-9]+) +} $r0 _ mS0
	  regexp {^(-?[0-9]+) +} $r1 _ mS1
	  set ms [expr {$mS1*1.0/$c}]
	  puts stderr "[set :name]:\t[format %6.2f $ms] mms, ${:msg}"
	} else {
	  puts stderr "[set :name]: ${:msg} ok"
	}
      } else {
	puts stderr "[set :name]:\tincorrect result for '${:msg}'"
	puts stderr "\texpected: '${:expected}', got '$r' [info exists :errorReport]"
	if {[info exists :errorReport]} {eval [set :errorReport]}
	exit -1
      }
      if {[info exists :post]} {:call "post" ${:post}}
    }

  }
  namespace export Test
}

proc ? {cmd expected {msg ""}} {
  set namespace [uplevel {namespace current}]
  #puts stderr "eval in namespace $namespace"
  if {$msg ne ""} {
    set t [Test new -cmd $cmd -msg $msg -namespace $namespace]
  } else {
    set t [Test new -cmd $cmd -namespace $namespace]
  }
  $t expected $expected 
  $t run
}
proc ?? {cmd expected {msg ""}} {
  set namespace [uplevel {namespace current}]
  #catch {namespace eval $namespace {$cmd}} errorMsg
  catch $cmd ::xotcl::test::errorMsg
  if {$msg ne ""} {
    set t [Test new -cmd {set ::xotcl::test::errorMsg} -msg $msg -namespace $namespace -count 1]
  } else {
    set t [Test new -cmd {set ::xotcl::test::errorMsg} -namespace $namespace -count 1]
  }
  $t expected $expected 
  $t run
}

namespace import ::xotcl::test::*