Sample interaction.
======
eltclsh > test *
==============================================
testsuite 'cannon' : results : 11/11  :  100% 
==============================================
testsuite 'cursor' : results : 11/11  :  100% 
==============================================
testsuite 'makes' : results : 1/1  :  100% 
========================================================
testsuite 'namespacequestions' : results : 1/1  :  100% 
========================================================
testsuite 'rat' : results : 5/5  :  100% 
==========================================
testsuite 'ratv' : results : 5/5  :  100% 
===========================================
testsuite 'trans' : results : 2/2  :  100% 
===========================================
========================================================
testsuite 'generic' : results : 14/15  :  1 test failed.
========================================================
test 'new' failed
s/b [generic::color {kin 8}] ...
...Blue...
   Yellow
=======================================================
testsuite 'command' : results : 7/9  :  2 tests failed.
=======================================================
test 'arithmetic' failed
s/b [command::+ 3] ...
...nsdate {1966 6 4}...
   invalid command name "command::+"
test 'parse' failed
s/b [command::kin 10 25 2014] ...
......
   100
======
Testsuites organize tests.

Example testsuite:
======
   testsuite equations {
     test "quadratic" {
         s/b {quadratic_eq 1 0 -16} {4 -4}
         s/nb {quadratic_eq 1 0 -16} 4
         s/b {quadratic_eq 1 0 -9} {3 -3}
     }
   }
======
A testsuite has a title and a collection of tests

A test has a title and a body (collection of statements)

A body is arbitrary tcl code

s/b and s/nb perform the testing, which means - 
   * [eval] the 1st phrase in the global scope
   * compare to the 2nd pharse.
======
  # tclunit
  # a featherweight test harness
  ###############################################################################
  namespace eval tclunit {
      set version 0.3
      variable lastsuiteglob ""
      variable suites
      variable successcount
      variable failcount
      variable testcount
      variable msglog
      variable echoonrepeat 1
      variable logsuccess 0
      variable zourcevalue ""
      variable zourcestate uninitialized
      array set suites {}
      namespace export testsuite s/b s/nb
  }
  namespace eval tclunitcmds {
      namespace export zource test 
  }
  ###############################################################################
  # [ zource ] 
  # a proc/parameter.
  # called w/ a value; make an assignment
  # called w/o no value; eval assignment in global namespace
  ###############################################################################
  proc tclunitcmds::zource {args} {
      switch [llength $args] {
          0 {
              if {$::tclunit::zourcestate eq "uninitialized"} {
                  puts "zource uninitialized."
                  return
              }
              catch {uplevel #0 $::tclunit::zourcevalue} res
              return
          }
          default {
              set ::tclunit::zourcestate ""
              set ::tclunit::zourcevalue {*}$args
          }
      }
  }
  ###############################################################################
  # [ test ] 
  # called w/o args; resets env and repeats last set of tests
  # called w/ args; globs against the names of currently defined testsuites
  ###############################################################################
  proc tclunitcmds::test {args} {
      zource
      ::tclunit::testrunner $args
  }
  ###############################################################################
  # [s/b]
  # cmd is presumed to be a statement in tcl
  # expected is matched against return value 
  # s/b 'expects' them to match
  # s/nb 'expects' them to not match
  ###############################################################################
  proc tclunit::s/b {cmd expected} {
      catch {uplevel 1 $cmd} res
      if {$res != $expected} {
          return -code error "s/b \[$cmd\] ...\n...$expected...\n   $res"
      }
  }
  proc tclunit::s/nb {cmd expected} {
      catch {uplevel 1 $cmd} res
      if {$res == $expected} {
          return -code error "s/nb \[$cmd\] ...\n...$expected...\n   $res"
      }
  }
  ###############################################################################
  # [test] again. This [test] is internal to the [testsuite]. see examples.
  ###############################################################################
  proc tclunit::-test {title body} {
      # consumes test, does nothing, use to disable a test, like comment out
  }
  proc tclunit::test {title body} {
      incr ::tclunit::testcount
      if { [catch {uplevel #0 $body} res opts]  } {
          incr ::tclunit::failcount
          log "test '$title' failed\n$res"
      } {
          incr ::tclunit::successcount
          if { $::tclunit::logsuccess } { log "...success : $res" }
      }
  }
  ###############################################################################
  proc tclunit::log {msg} {
      lappend ::tclunit::msglog $msg
  }
  proc tclunit::testsuite {title tests} {
      # initial glob pattern picks up first testsuite
      if { $::tclunit::lastsuiteglob eq "" } {
          set ::tclunit::lastsuiteglob $title
      }
      set ::tclunit::suites($title) $tests
  }
  proc tclunit::testrunner {suiteglob} {
      variable ::tclunit::lastsuiteglob
      variable ::tclunit::suites
      variable ::tclunit::successcount
      variable ::tclunit::failcount
      variable ::tclunit::msglog
      variable ::tclunit::testcount
      variable ::tclunit::echoonrepeat
  
      # arg processing
      if {$suiteglob eq "" || $suiteglob eq {}} {
          if { ![info exists lastsuiteglob] || $lastsuiteglob eq "" } { 
              puts "yawn."
              return
          }
          set suiteglob $lastsuiteglob 
          if {$echoonrepeat} {
              puts "testing: $suiteglob"
          }
      }
  
      set lastsuiteglob $suiteglob
      set results [list ]
      set hbar0 ""
      set q00 ""
  
      foreach suite [lsort [array names suites $suiteglob]] {
          set tests $suites($suite)
  
          # reset stuff
          set msglog ""
          set failcount 0
          set successcount 0
          set testcount 0
  
          # get and run the tests
          foreach {test title body} $tests {
              eval [list $test $title $body]
          }
  
          if {$failcount} {
              # collect the results
              lappend results [list $suite $testcount $successcount $failcount $msglog]
          } {
              set q0 "testsuite '$suite' : results : $successcount/$testcount  : "
              set q "$q0 100% "
              set p [string repeat = [string length $q]]
              if { [string length $p] > [string length $hbar0] } { set hbar0 $p }
              if { [string length $hbar0] > [string length $q00] } { set hbar0 $p }
              set q00 $q
              puts $hbar0
              puts $q
          }
  
      }
      # sort the results, printing success first and in a compressed manner
      foreach r [lsort -increasing -integer -index 3 $results] {
          lassign $r suite testcount successcount failcount msglog
          if { $hbar0 ne "" } {
              puts $hbar0
              set hbar0 ""
          }
          set q0 "testsuite '$suite' : results : $successcount/$testcount  : "
          if { $failcount == 1 } {
              set q2 "test failed."
          } {
              set q2 "tests failed."
          }
          set q "$q0 $failcount $q2"
          set p [string repeat = [string length $q]]
          puts $p
          puts $q
          puts $p
          if { $msglog ne "" } {
              puts [join $msglog \n]
          }
      }
      if { $hbar0 ne "" } { puts $hbar0 }
  }
  ###############################################################################
  # forces [zource] [test] [testsuite] [s/b] [s/nb] into global namespace.
  namespace import -force tclunit::*
  namespace import -force tclunitcmds::*
  ###############################################################################
  package provide tclunit $tclunit::version
  ###############################################################################
======

<<categories>>Enter Category Here