Subversion Repositories or1k

#

# 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.1.1.1 2002-01-16 10:24:47 markom 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.

if {[string compare test [info procs test]] == 1} then {source defs}

# ----------------------------------------------------------------------

#  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 [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 [find classes test_info*]