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
}

namespace import ::xotcl::test::*