Create an object/Native demonstration: Difference between revisions
Content added Content deleted
(Updated D entry) |
(→{{header|zkl}}: added Tcl) |
||
Line 759: | Line 759: | ||
end |
end |
||
end</lang> |
end</lang> |
||
=={{header|Tcl}}== |
|||
This solution uses a dict(ionary), so requires Tcl 8.5 or better. Variable traces are used to detect write or unset access to such a protected variable, restore it to the backup value at protection time, and throw an exception |
|||
<lang Tcl>proc protect _var { |
|||
upvar 1 $_var var |
|||
set backup $var |
|||
trace add variable var {write unset} [list protect0 $backup] |
|||
} |
|||
proc protect0 {backup name1 name2 op} { |
|||
upvar 1 $name1 var |
|||
trace remove variable var {write unset} [list protect 0 $backup] |
|||
set var $backup |
|||
trace add variable var {write unset} [list protect0 $backup] |
|||
return -code error "$name1 is protected" |
|||
} |
|||
proc trying cmd { #-- convenience function for demo |
|||
puts "trying: $cmd" |
|||
if [catch {uplevel 1 $cmd} msg] {puts $msg} |
|||
}</lang> |
|||
Testing: |
|||
dict set dic 1 one |
|||
dict set dic 2 two |
|||
puts dic:$dic |
|||
protect dic |
|||
trying "dict set dic 3 three" |
|||
puts dic:$dic |
|||
trying "dict unset dic 1" |
|||
trying "unset dic" |
|||
puts dic:$dic |
|||
displays on stdout: |
|||
dic:1 one 2 two |
|||
trying: dict set dic 3 three |
|||
can't set "dic": dic is protected |
|||
dic:1 one 2 two |
|||
trying: dict unset dic 1 |
|||
can't set "dic": dic is protected |
|||
trying: unset dic |
|||
dic:1 one 2 two |
|||
=={{header|zkl}}== |
=={{header|zkl}}== |