privacy.test

linux 下的源代码分析阅读器 red hat公司新版

#
# Privacy options for components
# ----------------------------------------------------------------------
#   AUTHOR:  Michael J. McLennan
#            Bell Labs Innovations for Lucent Technologies
#            [e-mail]
#            http://www.tcltk.com/itcl
#
#      RCS:  $Id: privacy.test 144 2003-02-05 10:56:26Z mdejong $
# ----------------------------------------------------------------------
#            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 Itk

# ----------------------------------------------------------------------
#  Define a base class with public variables and a simple mega-widget
# ----------------------------------------------------------------------
test privacy-1.1 {define simple mega-widget class} {
    itcl::class TestPrivacy {
        inherit itk::Widget
        constructor {args} {
            eval itk_initialize $args
        }
        method do {args} {
            return [eval $args]
        }
    }
    set testobj [TestPrivacy .#auto]
    pack $testobj
} {}

test privacy-1.2 {"itk_component add" requires certain arguments} {
    list [catch {$testobj do itk_component add foo} msg] $msg \
         [catch {$testobj do itk_component add foo bar baz qux} msg] $msg
} {1 {wrong # args: should be "itk_component add ?-protected? ?-private? ?--? name createCmds ?optionCmds?"} 1 {wrong # args: should be "add ?-protected? ?-private? ?--? name createCmds ?optionCmds?}}

test privacy-1.3 {"itk_component add" rejects invalid options} {
    list [catch {
             $testobj do itk_component add -foo bar baz qux
         } msg] $msg \
         [catch {
             $testobj do itk_component add -- -foo {label $itk_interior.l}
         } msg] $msg
} {1 {bad option "-foo": should be -private, -protected or --} 0 -foo}

test privacy-1.4 {"itk_component add" recognizes privacy options} {
    list [catch {
             $testobj do itk_component add -protected x {label $itk_interior.x}
         } msg] $msg \
         [catch {
             $testobj do itk_component add -private y {label $itk_interior.y}
         } msg] $msg
} {0 x 0 y}

test privacy-1.5 {protected/private components are hidden} {
    list [lsort [$testobj component]] \
         [lsort [$testobj do component]]
} {{-foo hull} {-foo hull x y}}

test privacy-1.6 {define a derived class and add protected/private comps} {
    itcl::class TestMorePrivacy {
        inherit TestPrivacy
        constructor {args} {
            eval itk_initialize $args
        }
        method do {args} {
            return [eval $args]
        }
    }
    set testobj2 [TestMorePrivacy .#auto]
    $testobj2 TestPrivacy::do itk_component add -private x {
        label $itk_interior.x
    }
    $testobj2 TestPrivacy::do itk_component add -protected y {
        label $itk_interior.y
    }
    $testobj2 TestPrivacy::do itk_component add z {
        label $itk_interior.z
    }
} {z}

test privacy-1.7 {components are visible depending on namespace context} {
    list [lsort [$testobj2 component]] \
         [lsort [$testobj2 do component]] \
         [lsort [$testobj2 TestPrivacy::do component]]
} {{hull z} {hull y z} {hull x y z}}

# ----------------------------------------------------------------------
#  Clean up
# ----------------------------------------------------------------------
itcl::delete class TestPrivacy TestMorePrivacy

::tcltest::cleanupTests
exit