# # Tests for method/variable protection and access # ---------------------------------------------------------------------- # AUTHOR: Michael J. McLennan # Bell Labs Innovations for Lucent Technologies # mmclennan@lucent.com # http://www.tcltk.com/itcl # # RCS: $Id: protection.test,v 1.3 2000/06/01 20:34:35 wart Exp $ # ---------------------------------------------------------------------- # Copyright (c) 1993-1998 Lucent Technologies, Inc. # ====================================================================== # See the file "license.terms" for information on usage and # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest namespace import -force ::tcltest::* if {[string compare test [info procs test]] == 1} then {source defs} package require Itcl # ---------------------------------------------------------------------- # Class members are protected by access restrictions # ---------------------------------------------------------------------- test protect-1.1 {define a class with various protection levels} { itcl::class test_pr { public { variable pubv "public var" common pubc "public com" method pubm {} {return "public method"} method ovpubm {} {return "overloaded public method"} proc pubp {} {return "public proc"} } protected { variable prov "protected var" common proc "protected com" method prom {} {return "protected method"} method ovprom {} {return "overloaded protected method"} proc prop {} {return "protected proc"} } private { variable priv "private var" common pric "private com" method prim {} {return "private method"} method ovprim {} {return "overloaded private method"} proc prip {} {return "private proc"} } method do {args} {eval $args} } } "" test protect-1.2 {create an object to execute tests} { test_pr #auto } {test_pr0} test protect-1.3a {public methods can be accessed from outside} { list [catch {test_pr0 pubm} msg] $msg } {0 {public method}} test protect-1.3b {public methods can be accessed from inside} { list [catch {test_pr0 do pubm} msg] $msg } {0 {public method}} test protect-1.4a {protected methods are blocked from outside} { list [catch {test_pr0 prom} msg] $msg } {1 {bad option "prom": should be one of... test_pr0 cget -option test_pr0 configure ?-option? ?value -option value...? test_pr0 do ?arg arg ...? test_pr0 isa className test_pr0 ovpubm test_pr0 pubm}} test protect-1.4b {protected methods can be accessed from inside} { list [catch {test_pr0 do prom} msg] $msg } {0 {protected method}} test protect-1.5a {private methods are blocked from outside} { list [catch {test_pr0 prim} msg] $msg } {1 {bad option "prim": should be one of... test_pr0 cget -option test_pr0 configure ?-option? ?value -option value...? test_pr0 do ?arg arg ...? test_pr0 isa className test_pr0 ovpubm test_pr0 pubm}} test protect-1.5b {private methods can be accessed from inside} { list [catch {test_pr0 do prim} msg] $msg } {0 {private method}} test protect-1.6a {public procs can be accessed from outside} { list [catch {test_pr::pubp} msg] $msg } {0 {public proc}} test protect-1.6b {public procs can be accessed from inside} { list [catch {test_pr0 do pubp} msg] $msg } {0 {public proc}} test protect-1.7a {protected procs are blocked from outside} { list [catch {test_pr::prop} msg] $msg } {1 {can't access "::test_pr::prop": protected function}} test protect-1.7b {protected procs can be accessed from inside} { list [catch {test_pr0 do prop} msg] $msg } {0 {protected proc}} test protect-1.8a {private procs are blocked from outside} { list [catch {test_pr::prip} msg] $msg } {1 {can't access "::test_pr::prip": private function}} test protect-1.8b {private procs can be accessed from inside} { list [catch {test_pr0 do prip} msg] $msg } {0 {private proc}} test protect-1.9a {public commons can be accessed from outside} { list [catch {set test_pr::pubc} msg] $msg } {0 {public com}} test protect-1.9b {public commons can be accessed from inside} { list [catch {test_pr0 do set pubc} msg] $msg } {0 {public com}} test protect-1.10 {protected commons can be accessed from inside} { list [catch {test_pr0 do set proc} msg] $msg } {0 {protected com}} test protect-1.11 {private commons can be accessed from inside} { list [catch {test_pr0 do set pric} msg] $msg } {0 {private com}} test protect-1.12a {object-specific variables require an access command} { list [catch {set test_pr::pubv} msg] $msg } {1 {can't read "test_pr::pubv": no such variable}} test protect-1.12b {public variables can be accessed from inside} { list [catch {test_pr0 do set pubv} msg] $msg } {0 {public var}} test protect-1.13a {object-specific variables require an access command} { list [catch {set test_pr::prov} msg] $msg } {1 {can't read "test_pr::prov": no such variable}} test protect-1.13b {protected variables can be accessed from inside} { list [catch {test_pr0 do set prov} msg] $msg } {0 {protected var}} test protect-1.14a {object-specific variables require an access command} { list [catch {set test_pr::priv} msg] $msg } {1 {can't read "test_pr::priv": no such variable}} test protect-1.14b {private variables can be accessed from inside} { list [catch {test_pr0 do set priv} msg] $msg } {0 {private var}} # ---------------------------------------------------------------------- # Access restrictions work properly with inheritance # ---------------------------------------------------------------------- test protect-2.1 {define a derived class} { itcl::class test_pr_derived { inherit test_pr method do {args} {eval $args} public method ovpubm {} {return "specific public method"} protected method ovprom {} {return "specific protected method"} private method ovprim {} {return "specific private method"} public method dpubm {} {return "pub (only in derived)"} protected method dprom {} {return "pro (only in derived)"} private method dprim {} {return "pri (only in derived)"} } } "" test protect-2.2 {create an object to execute tests} { test_pr_derived #auto } {test_pr_derived0} test protect-2.3 {public methods can be accessed from inside} { list [catch {test_pr_derived0 do pubm} msg] $msg } {0 {public method}} test protect-2.4 {protected methods can be accessed from inside} { list [catch {test_pr_derived0 do prom} msg] $msg } {0 {protected method}} test protect-2.5 {private methods are blocked} { list [catch {test_pr_derived0 do prim} msg] $msg } {1 {invalid command name "prim"}} test protect-2.6 {public procs can be accessed from inside} { list [catch {test_pr_derived0 do pubp} msg] $msg } {0 {public proc}} test protect-2.7 {protected procs can be accessed from inside} { list [catch {test_pr_derived0 do prop} msg] $msg } {0 {protected proc}} test protect-2.8 {private procs are blocked} { list [catch {test_pr_derived0 do prip} msg] $msg } {1 {invalid command name "prip"}} test protect-2.9 {public commons can be accessed from inside} { list [catch {test_pr_derived0 do set pubc} msg] $msg } {0 {public com}} test protect-2.10 {protected commons can be accessed from inside} { list [catch {test_pr_derived0 do set proc} msg] $msg } {0 {protected com}} test protect-2.11 {private commons are blocked} { list [catch {test_pr_derived0 do set pric} msg] $msg } {1 {can't read "pric": no such variable}} test protect-2.12 {public variables can be accessed from inside} { list [catch {test_pr_derived0 do set pubv} msg] $msg } {0 {public var}} test protect-2.13 {protected variables can be accessed from inside} { list [catch {test_pr_derived0 do set prov} msg] $msg } {0 {protected var}} test protect-2.14 {private variables are blocked} { list [catch {test_pr_derived0 do set priv} msg] $msg } {1 {can't read "priv": no such variable}} test protect-2.15 {can access overloaded public method} { set cmd {namespace eval test_pr_derived {test_pr_derived0 ovpubm}} list [catch $cmd msg] $msg } {0 {specific public method}} test protect-2.16 {can access overloaded public method} { set cmd {namespace eval test_pr_derived {test_pr_derived0 ovprom}} list [catch $cmd msg] $msg } {0 {specific protected method}} test protect-2.17 {can access overloaded private method} { set cmd {namespace eval test_pr_derived {test_pr_derived0 ovprim}} list [catch $cmd msg] $msg } {0 {specific private method}} test protect-2.18 {can access overloaded public method from base class} { set cmd {namespace eval test_pr {test_pr_derived0 ovpubm}} list [catch $cmd msg] $msg } {0 {specific public method}} test protect-2.19 {can access overloaded protected method from base class} { set cmd {namespace eval test_pr {test_pr_derived0 ovprom}} list [catch $cmd msg] $msg } {0 {specific protected method}} test protect-2.20 {*cannot* access overloaded private method from base class} { set cmd {namespace eval test_pr {test_pr_derived0 ovprim}} list [catch $cmd msg] $msg } {1 {bad option "ovprim": should be one of... test_pr_derived0 cget -option test_pr_derived0 configure ?-option? ?value -option value...? test_pr_derived0 do ?arg arg ...? test_pr_derived0 dpubm test_pr_derived0 isa className test_pr_derived0 ovprom test_pr_derived0 ovpubm test_pr_derived0 prim test_pr_derived0 prom test_pr_derived0 pubm}} test protect-2.21 {can access non-overloaded public method from base class} { set cmd {namespace eval test_pr {test_pr_derived0 dpubm}} list [catch $cmd msg] $msg } {0 {pub (only in derived)}} test protect-2.22 {*cannot* access non-overloaded protected method from base class} { set cmd {namespace eval test_pr {test_pr_derived0 dprom}} list [catch $cmd msg] $msg } {1 {bad option "dprom": should be one of... test_pr_derived0 cget -option test_pr_derived0 configure ?-option? ?value -option value...? test_pr_derived0 do ?arg arg ...? test_pr_derived0 dpubm test_pr_derived0 isa className test_pr_derived0 ovprom test_pr_derived0 ovpubm test_pr_derived0 prim test_pr_derived0 prom test_pr_derived0 pubm}} test protect-2.23 {*cannot* access non-overloaded private method from base class} { set cmd {namespace eval test_pr {test_pr_derived0 dprim}} list [catch $cmd msg] $msg } {1 {bad option "dprim": should be one of... test_pr_derived0 cget -option test_pr_derived0 configure ?-option? ?value -option value...? test_pr_derived0 do ?arg arg ...? test_pr_derived0 dpubm test_pr_derived0 isa className test_pr_derived0 ovprom test_pr_derived0 ovpubm test_pr_derived0 prim test_pr_derived0 prom test_pr_derived0 pubm}} eval namespace delete [itcl::find classes test_pr*] # ---------------------------------------------------------------------- # Access restrictions don't mess up "info" # ---------------------------------------------------------------------- test protect-3.1 {define a base class with private variables} { itcl::class test_info_base { private variable pribv "pribv-value" private common pribc "pribc-value" protected variable probv "probv-value" protected common probc "probc-value" public variable pubbv "pubbv-value" public common pubbc "pubbc-value" } itcl::class test_info_derived { inherit test_info_base private variable pridv "pridv-value" private common pridc "pridc-value" } } "" test protect-3.2 {create an object to execute tests} { test_info_derived #auto } {test_info_derived0} test protect-3.3 {all variables are reported} { list [catch {test_info_derived0 info variable} msg] [lsort $msg] } {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}} test protect-3.4 {private base class variables can be accessed} { list [catch {test_info_derived0 info variable pribv} msg] $msg } {0 {private variable ::test_info_base::pribv pribv-value pribv-value}} test protect-3.5 {private base class commons can be accessed} { list [catch {test_info_derived0 info variable pribc} msg] $msg } {0 {private common ::test_info_base::pribc pribc-value pribc-value}} test protect-3.6 {protected base class variables can be accessed} { list [catch {test_info_derived0 info variable probv} msg] $msg } {0 {protected variable ::test_info_base::probv probv-value probv-value}} test protect-3.7 {protected base class commons can be accessed} { list [catch {test_info_derived0 info variable probc} msg] $msg } {0 {protected common ::test_info_base::probc probc-value probc-value}} test protect-3.8 {public base class variables can be accessed} { list [catch {test_info_derived0 info variable pubbv} msg] $msg } {0 {public variable ::test_info_base::pubbv pubbv-value {} pubbv-value}} test protect-3.9 {public base class commons can be accessed} { list [catch {test_info_derived0 info variable pubbc} msg] $msg } {0 {public common ::test_info_base::pubbc pubbc-value pubbc-value}} test protect-3.10 {private derived class variables can be accessed} { list [catch {test_info_derived0 info variable pridv} msg] $msg } {0 {private variable ::test_info_derived::pridv pridv-value pridv-value}} test protect-3.11 {private derived class commons can be accessed} { list [catch {test_info_derived0 info variable pridc} msg] $msg } {0 {private common ::test_info_derived::pridc pridc-value pridc-value}} test protect-3.12 {private base class variables can't be accessed from class} { list [catch { namespace eval test_info_derived {info variable pribv} } msg] $msg } {1 {cannot access object-specific info without an object context}} test protect-3.13 {private base class commons can be accessed from class} { list [catch { namespace eval test_info_derived {info variable pribc} } msg] $msg } {0 {private common ::test_info_base::pribc pribc-value pribc-value}} eval namespace delete [itcl::find classes test_info*] ::tcltest::cleanupTests return