ten/test.tcl

   1 namespace eval ::ten::test:: {
   2
   3   variable test_count 0
   4
   5   proc pass {reason} {
   6     variable test_count
   7     incr test_count
   8     puts stdout "ok $test_count $reason"
   9   }
  10
  11   proc fail {reason} {
  12     variable test_count
  13     incr test_count
  14     puts stdout "not ok $test_count $reason"
  15   }
  16
  17   proc ok {cond reason} {
  18     if $cond {
  19       pass $reason
  20     } else {
  21       fail "$reason: $cond false"
  22     }
  23   }
  24
  25   proc cmp_ok {op left right reason} {
  26     if [expr $left $op $right] {
  27       pass $reason
  28     } else {
  29       fail "$reason: $left $op $right false"
  30     }
  31   }
  32
  33   proc is {left right reason} {
  34     switch $left \
  35       $right { pass $reason } \
  36       default { fail "$reason: expected $right, got $left" }
  37   }
  38
  39   proc done_testing {} {
  40     variable test_count
  41     puts stdout "1..$test_count"
  42   }
  43
  44   namespace export pass fail is ok cmp_ok done_testing
  45 }
  46
  47 package provide ten::test 0.0.1