1# 2# Tests for method/variable protection and access 3# ---------------------------------------------------------------------- 4# AUTHOR: Michael J. McLennan 5# Bell Labs Innovations for Lucent Technologies 6# mmclennan@lucent.com 7# http://www.tcltk.com/itcl 8# 9# RCS: $Id: protection.test,v 1.4 2004/02/12 18:09:50 davygrvy Exp $ 10# ---------------------------------------------------------------------- 11# Copyright (c) 1993-1998 Lucent Technologies, Inc. 12# ====================================================================== 13# See the file "license.terms" for information on usage and 14# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. 15 16if {[lsearch [namespace children] ::tcltest] == -1} { 17 package require tcltest 2.1 18 namespace import -force ::tcltest::test 19} 20 21::tcltest::loadTestedCommands 22 23# ---------------------------------------------------------------------- 24# Class members are protected by access restrictions 25# ---------------------------------------------------------------------- 26test protect-1.1 {define a class with various protection levels} { 27 itcl::class test_pr { 28 public { 29 variable pubv "public var" 30 common pubc "public com" 31 method pubm {} {return "public method"} 32 method ovpubm {} {return "overloaded public method"} 33 proc pubp {} {return "public proc"} 34 } 35 protected { 36 variable prov "protected var" 37 common proc "protected com" 38 method prom {} {return "protected method"} 39 method ovprom {} {return "overloaded protected method"} 40 proc prop {} {return "protected proc"} 41 } 42 private { 43 variable priv "private var" 44 common pric "private com" 45 method prim {} {return "private method"} 46 method ovprim {} {return "overloaded private method"} 47 proc prip {} {return "private proc"} 48 } 49 method do {args} {eval $args} 50 } 51} "" 52 53test protect-1.2 {create an object to execute tests} { 54 test_pr #auto 55} {test_pr0} 56 57test protect-1.3a {public methods can be accessed from outside} { 58 list [catch {test_pr0 pubm} msg] $msg 59} {0 {public method}} 60 61test protect-1.3b {public methods can be accessed from inside} { 62 list [catch {test_pr0 do pubm} msg] $msg 63} {0 {public method}} 64 65test protect-1.4a {protected methods are blocked from outside} { 66 list [catch {test_pr0 prom} msg] $msg 67} {1 {bad option "prom": should be one of... 68 test_pr0 cget -option 69 test_pr0 configure ?-option? ?value -option value...? 70 test_pr0 do ?arg arg ...? 71 test_pr0 isa className 72 test_pr0 ovpubm 73 test_pr0 pubm}} 74 75test protect-1.4b {protected methods can be accessed from inside} { 76 list [catch {test_pr0 do prom} msg] $msg 77} {0 {protected method}} 78 79test protect-1.5a {private methods are blocked from outside} { 80 list [catch {test_pr0 prim} msg] $msg 81} {1 {bad option "prim": should be one of... 82 test_pr0 cget -option 83 test_pr0 configure ?-option? ?value -option value...? 84 test_pr0 do ?arg arg ...? 85 test_pr0 isa className 86 test_pr0 ovpubm 87 test_pr0 pubm}} 88 89test protect-1.5b {private methods can be accessed from inside} { 90 list [catch {test_pr0 do prim} msg] $msg 91} {0 {private method}} 92 93test protect-1.6a {public procs can be accessed from outside} { 94 list [catch {test_pr::pubp} msg] $msg 95} {0 {public proc}} 96 97test protect-1.6b {public procs can be accessed from inside} { 98 list [catch {test_pr0 do pubp} msg] $msg 99} {0 {public proc}} 100 101test protect-1.7a {protected procs are blocked from outside} { 102 list [catch {test_pr::prop} msg] $msg 103} {1 {can't access "::test_pr::prop": protected function}} 104 105test protect-1.7b {protected procs can be accessed from inside} { 106 list [catch {test_pr0 do prop} msg] $msg 107} {0 {protected proc}} 108 109test protect-1.8a {private procs are blocked from outside} { 110 list [catch {test_pr::prip} msg] $msg 111} {1 {can't access "::test_pr::prip": private function}} 112 113test protect-1.8b {private procs can be accessed from inside} { 114 list [catch {test_pr0 do prip} msg] $msg 115} {0 {private proc}} 116 117test protect-1.9a {public commons can be accessed from outside} { 118 list [catch {set test_pr::pubc} msg] $msg 119} {0 {public com}} 120 121test protect-1.9b {public commons can be accessed from inside} { 122 list [catch {test_pr0 do set pubc} msg] $msg 123} {0 {public com}} 124 125test protect-1.10 {protected commons can be accessed from inside} { 126 list [catch {test_pr0 do set proc} msg] $msg 127} {0 {protected com}} 128 129test protect-1.11 {private commons can be accessed from inside} { 130 list [catch {test_pr0 do set pric} msg] $msg 131} {0 {private com}} 132 133test protect-1.12a {object-specific variables require an access command} { 134 list [catch {set test_pr::pubv} msg] $msg 135} {1 {can't read "test_pr::pubv": no such variable}} 136 137test protect-1.12b {public variables can be accessed from inside} { 138 list [catch {test_pr0 do set pubv} msg] $msg 139} {0 {public var}} 140 141test protect-1.13a {object-specific variables require an access command} { 142 list [catch {set test_pr::prov} msg] $msg 143} {1 {can't read "test_pr::prov": no such variable}} 144 145test protect-1.13b {protected variables can be accessed from inside} { 146 list [catch {test_pr0 do set prov} msg] $msg 147} {0 {protected var}} 148 149test protect-1.14a {object-specific variables require an access command} { 150 list [catch {set test_pr::priv} msg] $msg 151} {1 {can't read "test_pr::priv": no such variable}} 152 153test protect-1.14b {private variables can be accessed from inside} { 154 list [catch {test_pr0 do set priv} msg] $msg 155} {0 {private var}} 156 157# ---------------------------------------------------------------------- 158# Access restrictions work properly with inheritance 159# ---------------------------------------------------------------------- 160test protect-2.1 {define a derived class} { 161 itcl::class test_pr_derived { 162 inherit test_pr 163 method do {args} {eval $args} 164 165 public method ovpubm {} {return "specific public method"} 166 protected method ovprom {} {return "specific protected method"} 167 private method ovprim {} {return "specific private method"} 168 169 public method dpubm {} {return "pub (only in derived)"} 170 protected method dprom {} {return "pro (only in derived)"} 171 private method dprim {} {return "pri (only in derived)"} 172 } 173} "" 174 175test protect-2.2 {create an object to execute tests} { 176 test_pr_derived #auto 177} {test_pr_derived0} 178 179test protect-2.3 {public methods can be accessed from inside} { 180 list [catch {test_pr_derived0 do pubm} msg] $msg 181} {0 {public method}} 182 183test protect-2.4 {protected methods can be accessed from inside} { 184 list [catch {test_pr_derived0 do prom} msg] $msg 185} {0 {protected method}} 186 187test protect-2.5 {private methods are blocked} { 188 list [catch {test_pr_derived0 do prim} msg] $msg 189} {1 {invalid command name "prim"}} 190 191test protect-2.6 {public procs can be accessed from inside} { 192 list [catch {test_pr_derived0 do pubp} msg] $msg 193} {0 {public proc}} 194 195test protect-2.7 {protected procs can be accessed from inside} { 196 list [catch {test_pr_derived0 do prop} msg] $msg 197} {0 {protected proc}} 198 199test protect-2.8 {private procs are blocked} { 200 list [catch {test_pr_derived0 do prip} msg] $msg 201} {1 {invalid command name "prip"}} 202 203test protect-2.9 {public commons can be accessed from inside} { 204 list [catch {test_pr_derived0 do set pubc} msg] $msg 205} {0 {public com}} 206 207test protect-2.10 {protected commons can be accessed from inside} { 208 list [catch {test_pr_derived0 do set proc} msg] $msg 209} {0 {protected com}} 210 211test protect-2.11 {private commons are blocked} { 212 list [catch {test_pr_derived0 do set pric} msg] $msg 213} {1 {can't read "pric": no such variable}} 214 215test protect-2.12 {public variables can be accessed from inside} { 216 list [catch {test_pr_derived0 do set pubv} msg] $msg 217} {0 {public var}} 218 219test protect-2.13 {protected variables can be accessed from inside} { 220 list [catch {test_pr_derived0 do set prov} msg] $msg 221} {0 {protected var}} 222 223test protect-2.14 {private variables are blocked} { 224 list [catch {test_pr_derived0 do set priv} msg] $msg 225} {1 {can't read "priv": no such variable}} 226 227test protect-2.15 {can access overloaded public method} { 228 set cmd {namespace eval test_pr_derived {test_pr_derived0 ovpubm}} 229 list [catch $cmd msg] $msg 230} {0 {specific public method}} 231 232test protect-2.16 {can access overloaded public method} { 233 set cmd {namespace eval test_pr_derived {test_pr_derived0 ovprom}} 234 list [catch $cmd msg] $msg 235} {0 {specific protected method}} 236 237test protect-2.17 {can access overloaded private method} { 238 set cmd {namespace eval test_pr_derived {test_pr_derived0 ovprim}} 239 list [catch $cmd msg] $msg 240} {0 {specific private method}} 241 242test protect-2.18 {can access overloaded public method from base class} { 243 set cmd {namespace eval test_pr {test_pr_derived0 ovpubm}} 244 list [catch $cmd msg] $msg 245} {0 {specific public method}} 246 247test protect-2.19 {can access overloaded protected method from base class} { 248 set cmd {namespace eval test_pr {test_pr_derived0 ovprom}} 249 list [catch $cmd msg] $msg 250} {0 {specific protected method}} 251 252test protect-2.20 {*cannot* access overloaded private method from base class} { 253 set cmd {namespace eval test_pr {test_pr_derived0 ovprim}} 254 list [catch $cmd msg] $msg 255} {1 {bad option "ovprim": should be one of... 256 test_pr_derived0 cget -option 257 test_pr_derived0 configure ?-option? ?value -option value...? 258 test_pr_derived0 do ?arg arg ...? 259 test_pr_derived0 dpubm 260 test_pr_derived0 isa className 261 test_pr_derived0 ovprom 262 test_pr_derived0 ovpubm 263 test_pr_derived0 prim 264 test_pr_derived0 prom 265 test_pr_derived0 pubm}} 266 267test protect-2.21 {can access non-overloaded public method from base class} { 268 set cmd {namespace eval test_pr {test_pr_derived0 dpubm}} 269 list [catch $cmd msg] $msg 270} {0 {pub (only in derived)}} 271 272test protect-2.22 {*cannot* access non-overloaded protected method from base class} { 273 set cmd {namespace eval test_pr {test_pr_derived0 dprom}} 274 list [catch $cmd msg] $msg 275} {1 {bad option "dprom": should be one of... 276 test_pr_derived0 cget -option 277 test_pr_derived0 configure ?-option? ?value -option value...? 278 test_pr_derived0 do ?arg arg ...? 279 test_pr_derived0 dpubm 280 test_pr_derived0 isa className 281 test_pr_derived0 ovprom 282 test_pr_derived0 ovpubm 283 test_pr_derived0 prim 284 test_pr_derived0 prom 285 test_pr_derived0 pubm}} 286 287test protect-2.23 {*cannot* access non-overloaded private method from base class} { 288 set cmd {namespace eval test_pr {test_pr_derived0 dprim}} 289 list [catch $cmd msg] $msg 290} {1 {bad option "dprim": should be one of... 291 test_pr_derived0 cget -option 292 test_pr_derived0 configure ?-option? ?value -option value...? 293 test_pr_derived0 do ?arg arg ...? 294 test_pr_derived0 dpubm 295 test_pr_derived0 isa className 296 test_pr_derived0 ovprom 297 test_pr_derived0 ovpubm 298 test_pr_derived0 prim 299 test_pr_derived0 prom 300 test_pr_derived0 pubm}} 301 302eval namespace delete [itcl::find classes test_pr*] 303 304# ---------------------------------------------------------------------- 305# Access restrictions don't mess up "info" 306# ---------------------------------------------------------------------- 307test protect-3.1 {define a base class with private variables} { 308 itcl::class test_info_base { 309 private variable pribv "pribv-value" 310 private common pribc "pribc-value" 311 protected variable probv "probv-value" 312 protected common probc "probc-value" 313 public variable pubbv "pubbv-value" 314 public common pubbc "pubbc-value" 315 } 316 itcl::class test_info_derived { 317 inherit test_info_base 318 private variable pridv "pridv-value" 319 private common pridc "pridc-value" 320 } 321} "" 322 323test protect-3.2 {create an object to execute tests} { 324 test_info_derived #auto 325} {test_info_derived0} 326 327test protect-3.3 {all variables are reported} { 328 list [catch {test_info_derived0 info variable} msg] [lsort $msg] 329} {0 {::test_info_base::pribc ::test_info_base::pribv ::test_info_base::probc ::test_info_base::probv ::test_info_base::pubbc ::test_info_base::pubbv ::test_info_derived::pridc ::test_info_derived::pridv ::test_info_derived::this}} 330 331test protect-3.4 {private base class variables can be accessed} { 332 list [catch {test_info_derived0 info variable pribv} msg] $msg 333} {0 {private variable ::test_info_base::pribv pribv-value pribv-value}} 334 335test protect-3.5 {private base class commons can be accessed} { 336 list [catch {test_info_derived0 info variable pribc} msg] $msg 337} {0 {private common ::test_info_base::pribc pribc-value pribc-value}} 338 339test protect-3.6 {protected base class variables can be accessed} { 340 list [catch {test_info_derived0 info variable probv} msg] $msg 341} {0 {protected variable ::test_info_base::probv probv-value probv-value}} 342 343test protect-3.7 {protected base class commons can be accessed} { 344 list [catch {test_info_derived0 info variable probc} msg] $msg 345} {0 {protected common ::test_info_base::probc probc-value probc-value}} 346 347test protect-3.8 {public base class variables can be accessed} { 348 list [catch {test_info_derived0 info variable pubbv} msg] $msg 349} {0 {public variable ::test_info_base::pubbv pubbv-value {} pubbv-value}} 350 351test protect-3.9 {public base class commons can be accessed} { 352 list [catch {test_info_derived0 info variable pubbc} msg] $msg 353} {0 {public common ::test_info_base::pubbc pubbc-value pubbc-value}} 354 355test protect-3.10 {private derived class variables can be accessed} { 356 list [catch {test_info_derived0 info variable pridv} msg] $msg 357} {0 {private variable ::test_info_derived::pridv pridv-value pridv-value}} 358 359test protect-3.11 {private derived class commons can be accessed} { 360 list [catch {test_info_derived0 info variable pridc} msg] $msg 361} {0 {private common ::test_info_derived::pridc pridc-value pridc-value}} 362 363test protect-3.12 {private base class variables can't be accessed from class} { 364 list [catch { 365 namespace eval test_info_derived {info variable pribv} 366 } msg] $msg 367} {1 {cannot access object-specific info without an object context}} 368 369test protect-3.13 {private base class commons can be accessed from class} { 370 list [catch { 371 namespace eval test_info_derived {info variable pribc} 372 } msg] $msg 373} {0 {private common ::test_info_base::pribc pribc-value pribc-value}} 374 375eval namespace delete [itcl::find classes test_info*] 376 377::tcltest::cleanupTests 378return 379