Posted to tcl by sebres at Wed Mar 03 21:01:49 GMT 2021view raw

  1.  
  2. proc __on_set_check { condition _this n2 op } {
  3. upvar $_this this
  4. if $condition {} else { return -level 2 -code error "variable $_this set to invalid value [list $this]" }
  5. }
  6.  
  7. proc __typed { _ref condition } {
  8. upvar $_ref ref
  9. trace add variable ref write [list __on_set_check $condition]
  10. }
  11.  
  12. proc int {_var args} {
  13. upvar $_var var
  14. __typed var {[string is integer -strict $this]}
  15. if {[llength $args]} { set var {*}$args }
  16. }
  17.  
  18. proc int? {_var args} {
  19. upvar $_var var
  20. __typed var {[string is integer $this]}
  21. if {[llength $args]} { set var {*}$args }
  22. }
  23.  
  24. int a 123
  25. puts a:[set a]
  26. if {[catch {
  27. set a xxx
  28. }]} { puts $::errorInfo }
  29.  
  30. int? b ""
  31. puts b:[set b]
  32. if {[catch {
  33. set b 123
  34. set b yyy
  35. }]} { puts $::errorInfo }
  36.