tests/try.test

   1 source [file dirname [info script]]/testing.tcl
   2 needs cmd try tclcompat
   3
   4 test try-1.1 "Simple case" {
   5         try {
   6                 set x 0
   7         } finally {
   8                 incr x
   9         }
  10 } 0
  11
  12 test try-1.2 "Error in body" {
  13         list [catch {
  14                 try {
  15                         set x 0
  16                         error message
  17                 } finally {
  18                         incr x
  19                 }
  20         } msg] $msg $x
  21 } {1 message 1}
  22
  23 test try-1.3 "Error in finally" {
  24         list [catch {
  25                 try {
  26                         set x 0
  27                 } finally {
  28                         incr x
  29                         error finally
  30                 }
  31         } msg] $msg $x
  32 } {1 finally 1}
  33
  34 test try-1.4 "Error in both" {
  35         list [catch {
  36                 try {
  37                         set x 0
  38                         error message
  39                 } finally {
  40                         incr x
  41                         error finally
  42                 }
  43         } msg] $msg $x
  44 } {1 finally 1}
  45
  46 test try-1.5 "break in body" {
  47         list [catch {
  48                 try {
  49                         set x 0
  50                         break
  51                 } finally {
  52                         incr x
  53                 }
  54         } msg] $msg $x
  55 } {3 {} 1}
  56
  57 test try-1.6 "break in finally" {
  58         list [catch {
  59                 try {
  60                         set x 0
  61                 } finally {
  62                         incr x
  63                         break
  64                 }
  65         } msg] $msg $x
  66 } {3 {} 1}
  67
  68 test try-1.7 "return value from try, not finally" {
  69         list [catch {
  70                 try {
  71                         set x 0
  72                 } finally {
  73                         incr x
  74                 }
  75         } msg] $msg $x
  76 } {0 0 1}
  77
  78 test try-1.8 "return from within try" {
  79         proc a {} {
  80                 try {
  81                         return 1
  82                 }
  83                 # notreached
  84                 return 2
  85         }
  86         a
  87 } {1}
  88
  89 test try-1.9 "return -code from within try" {
  90         proc a {} {
  91                 try {
  92                         return -code break text
  93                 }
  94                 # notreached
  95                 return 2
  96         }
  97         list [catch a msg] $msg
  98 } {3 text}
  99
 100 proc c {} {
 101         try {
 102                 error here
 103         } on error {msg opts} {
 104                 # jim can do simply:
 105                 if {[catch {incr opts(-level)}]} {
 106                         # Must be Tcl
 107                         dict incr opts -level
 108                 }
 109                 return {*}$opts $msg
 110         }
 111 }
 112
 113 test try-3.1 "rethrow error in try/on handler" {
 114         list [catch c msg] $msg
 115 } {1 here}
 116
 117 testreport