+++ /dev/null
-#---------------------------------------------------------------------
-# TITLE:
-# typefunction.test
-#
-# AUTHOR:
-# Arnulf Wiedemann with a lot of code form the snit tests by
-# Will Duquette
-#
-# DESCRIPTION:
-# Test cases for ::itcl::type proc, method, typemethod commands.
-# Uses the ::tcltest:: harness.
-#
-# The tests assume tcltest 2.2
-#-----------------------------------------------------------------------
-
-package require tcltest 2.2
-namespace import ::tcltest::*
-::tcltest::loadTestedCommands
-package require itcl
-
-interp alias {} type {} ::itcl::type
-
-#-----------------------------------------------------------------------
-# Type variables
-
-test typevariable-1.2 {undefined typevariables are OK} -body {
- type dog {
- typevariable theValue
- method tset {value} {
- set theValue $value
- }
-
- method tget {} {
- return $theValue
- }
- }
-
- dog create spot
- dog create fido
- spot tset Howdy
-
- list [spot tget] [fido tget] [set ::dog::theValue]
-} -cleanup {
- dog destroy
-} -result {Howdy Howdy Howdy}
-
-test typevariable-1.3 {predefined typevariables are OK} -body {
- type dog {
- typevariable greeting Hello
-
- method tget {} {
- return $greeting
- }
- }
-
- dog create spot
- dog create fido
-
- list [spot tget] [fido tget] ;# FIXME [set ::dog::greeting]
-} -cleanup {
- dog destroy
-} -result {Hello Hello}
-
-test typevariable-1.4 {typevariables can be arrays} -body {
- type dog {
- typevariable greetings
-
- method fill {} {
- set greetings(a) Hi
- set greetings(b) Howdy
- }
- }
-
- dog create spot
- spot fill
- list $::dog::greetings(a) $::dog::greetings(b)
-} -cleanup {
- dog destroy
-} -result {Hi Howdy}
-
-test typevariable-1.5 {typevariables can used in typemethods} -body {
- type dog {
- typevariable greetings Howdy
-
- typemethod greet {} {
- return $greetings
- }
- }
-
- dog greet
-} -cleanup {
- dog destroy
-} -result {Howdy}
-
-test typevariable-1.6 {typevariables can used in procs} -body {
- type dog {
- typevariable greetings Howdy
-
- method greet {} {
- return [realGreet]
- }
-
- proc realGreet {} {
- return $greetings
- }
- }
-
- dog create spot
- spot greet
-} -cleanup {
- dog destroy
-} -result {Howdy}
-
-test typevariable-1.7 {mytypevar qualifies typevariables} -body {
- type dog {
- method tvname {name} {
- mytypevar $name
- }
- }
-
- dog create spot
- spot tvname myvar
-} -cleanup {
- dog destroy
-} -result {::dog::myvar}
-
-test typevariable-1.8 {typevariable with too many initializers throws an error} -body {
- type dog {
- typevariable color dark brown
- }
-} -returnCodes {
- error
-} -result {wrong # args: should be "typevariable varname ?init?"}
-
-test typevariable-1.9 {typevariable with too many initializers throws an error} -body {
- type dog {
- typevariable color -array dark brown
- }
-
- set result
-} -returnCodes {
- error
-} -result {wrong # args: should be "typevariable varname ?init|-array init?"}
-
-test typevariable-1.10 {typevariable can initialize array variables} -body {
- type dog {
- typevariable data -array {
- family jones
- color brown
- }
-
- typemethod getdata {item} {
- return $data($item)
- }
- }
-
- list [dog getdata family] [dog getdata color]
-} -cleanup {
- dog destroy
-} -result {jones brown}
-
-#-----------------------------------------------------------------------
-# instance variable
-
-test ivariable-1.1 {myvar qualifies instance variables} -body {
- type dog {
- method vname {name} {
- myvar $name
- }
- }
-
- dog create spot
- spot vname somevar
-} -cleanup {
- dog destroy
-} -result {::itcl::internal::variables::spot::dog::somevar}
-
-test ivariable-1.2 {undefined instance variables are OK} -body {
- type dog {
- variable greeting
- method setgreeting {value} {
- set greeting $value
- }
-
- method getgreeting {} {
- return $greeting
- }
- }
-
- set spot [dog create spot]
- spot setgreeting Hey
-
- dog create fido
- fido setgreeting Howdy
-
- list [spot getgreeting] [fido getgreeting] [set ::itcl::internal::variables::spot::dog::greeting]
-} -cleanup {
- dog destroy
-} -result {Hey Howdy Hey}
-
-test ivariable-1.3 {instance variables are destroyed automatically} -body {
- type dog {
- variable greeting
- constructor {args} {
- set greeting Hi
- }
- }
-
- dog create spot
- set g1 $::itcl::internal::variables::spot::dog::greeting
-
- spot destroy
- list $g1 [info exists ::itcl::internal::variables::spot::dog::greeting]
-} -cleanup {
- dog destroy
-} -result {Hi 0}
-
-test ivariable-1.4 {defined instance variables need not be declared} -body {
- type dog {
- variable greetings
-
- method put {} {
- set greetings Howdy
- }
-
- method get {} {
- return $greetings
- }
- }
-
- dog create spot
- spot put
- spot get
-} -cleanup {
- dog destroy
-} -result {Howdy}
-
-test ivariable-1.5 {instance variables can be arrays} -body {
- type dog {
- variable greetings
-
- method fill {} {
- set greetings(a) Hi
- set greetings(b) Howdy
- }
-
- method vname {} {
- return [myvar greetings]
- }
- }
-
- dog create spot
- spot fill
- list [set [spot vname](a)] [set [spot vname](b)]
-} -cleanup {
- dog destroy
-} -result {Hi Howdy}
-
-test ivariable-1.6 {instance variables can be initialized in the definition} -body {
- type dog {
- variable greetings {Hi Howdy}
- variable empty {}
-
- method list {} {
- list $greetings $empty
- }
- }
-
- dog create spot
- spot list
-} -cleanup {
- dog destroy
-} -result {{Hi Howdy} {}}
-
-test ivariable-1.9 {procs which define selfns see instance variables} -body {
- type dog {
- variable greeting Howdy
-
- method caller {} {
- return [callee $selfns]
- }
-
- proc callee {selfns} {
- return [set ${selfns}::greeting]
- }
- }
-
- dog create spot
-
- spot caller
-} -cleanup {
- dog destroy
-} -result {Howdy}
-
-test ivariable-1.11 {variable with too many initializers throws an error} -body {
- type dog {
- variable color dark brown
- }
-} -returnCodes {
- error
-} -result {wrong # args: should be "variable name ?init?"}
-
-test ivariable-1.12 {variable with too many initializers throws an error} -body {
- type dog {
- variable color -array dark brown
- }
-} -returnCodes {
- error
-} -result {wrong # args: should be "variable varname ?init|-array init?"}
-
-test ivariable-1.13 {variable can initialize array variables} -body {
- type dog {
- variable data -array {
- family jones
- color brown
- }
-
- method getdata {item} {
- return $data($item)
- }
- }
-
- dog spot
- list [spot getdata family] [spot getdata color]
-} -cleanup {
- dog destroy
-} -result {jones brown}
-
-
-#---------------------------------------------------------------------
-# Clean up
-
-cleanupTests
-return
OSDN Git Service
