Posted to tcl by ro at Thu Sep 03 19:17:35 GMT 2009view raw

  1. proc limited_while {cond body {limit 10}} {
  2. set n 0
  3. while 1 {
  4. if {$n == $limit} {
  5. return -code error "hit limit of $n loops"
  6. }
  7.  
  8. puts "----"
  9.  
  10. puts "cond => $cond"
  11. set cond_value [uplevel [list expr $cond]]
  12. puts "cond_value => $cond_value"
  13. if {!$cond_value} return
  14.  
  15. catch {uplevel $body} xres xopt
  16. puts "xres => $xres"
  17. puts "xopt => $xopt"
  18. set code [dict get $xopt -code]
  19. puts "code => $code"
  20.  
  21. if {$code == 3} {
  22. uplevel [list return -options $xopt -code break $xres]
  23. #uplevel [list return -code break]
  24. #break
  25. }
  26.  
  27. incr n
  28. }
  29. return
  30. }
  31.  
  32. set n 0
  33. limited_while {$n < 25} {
  34.  
  35. puts "the value of n is $n"
  36. if {$n == 1} break
  37.  
  38. incr n
  39. }