tests/error.test

   1 source [file dirname [info script]]/testing.tcl
   2 needs constraint jim; needs cmd package
   3 proc a {} {
   4         error "error thrown from a"
   5 }
   6
   7 proc b {} {
   8         set rc [catch {a} msg]
   9         if {$rc} {
  10                 error $msg [info stacktrace]
  11         }
  12 }
  13
  14 test error-1.1 "Rethrow caught error" {
  15         set rc [catch {b} msg]
  16         #puts stderr "error-1.1\n[errorInfo $msg]\n"
  17
  18         list $rc $msg [info stacktrace]
  19 } {1 {error thrown from a} {{} error.test 4 a error.test 8 b error.test 15}}
  20
  21 proc c {} {
  22         a
  23 }
  24
  25 proc d {} {
  26         c
  27 }
  28
  29 proc e {} {
  30         d
  31 }
  32
  33 test error-1.2 "Modify stacktrace" {
  34         set rc [catch {e} msg]
  35         set st [info stacktrace]
  36         # Now elide one entry from the stacktrace
  37         #puts [errorInfo $msg]
  38         set newst {}
  39         foreach {p f l} $st {
  40                 if {$p ne "d"} {
  41                         lappend newst $p $f $l
  42                 }
  43         }
  44         # Now rethrow with the new stack
  45         set rc [catch {error $msg $newst} msg]
  46         #puts [errorInfo $msg]
  47         info stacktrace
  48 } {{} error.test 4 a error.test 22 c error.test 26 e error.test 34}
  49
  50 # Package should be able to invoke exit, which should exit if not caught
  51 test error-2.1 "Exit from package" {
  52         list [catch -exit {package require exitpackage} msg] $msg
  53 } {6 {Can't load package exitpackage}}
  54
  55 testreport