/trunk/Examples/tcl/import/runme.tcl
TCL | 114 lines | 86 code | 23 blank | 5 comment | 8 complexity | 0e2e235d1876c1570505883f27743b28 MD5 | raw file
Possible License(s): LGPL-2.1, Cube, GPL-3.0, 0BSD, GPL-2.0
- # file: runme.tcl
- # Test various properties of classes defined in separate modules
- puts "Testing the %import directive"
- catch { load ./base[info sharedlibextension] base}
- catch { load ./foo[info sharedlibextension] foo}
- catch { load ./bar[info sharedlibextension] bar}
- catch { load ./spam[info sharedlibextension] spam}
- # Create some objects
- puts "Creating some objects"
- set a [Base]
- set b [Foo]
- set c [Bar]
- set d [Spam]
- # Try calling some methods
- puts "Testing some methods"
- puts "Should see 'Base::A' ---> "
- $a A
- puts "Should see 'Base::B' ---> "
- $a B
- puts "Should see 'Foo::A' ---> "
- $b A
- puts "Should see 'Foo::B' ---> "
- $b B
- puts "Should see 'Bar::A' ---> "
- $c A
- puts "Should see 'Bar::B' ---> "
- $c B
- puts "Should see 'Spam::A' ---> "
- $d A
- puts "Should see 'Spam::B' ---> "
- $d B
- # Try some casts
- puts "\nTesting some casts\n"
- Base x -this [$a toBase]
- puts "Should see 'Base::A' ---> "
- x A
- puts "Should see 'Base::B' ---> "
- x B
- rename x ""
- Base x -this [$b toBase]
- puts "Should see 'Foo::A' ---> "
- x A
- puts "Should see 'Base::B' ---> "
- x B
- rename x ""
- Base x -this [$c toBase]
- puts "Should see 'Bar::A' ---> "
- x A
- puts "Should see 'Base::B' ---> "
- x B
- rename x ""
- Base x -this [$d toBase]
- puts "Should see 'Spam::A' ---> "
- x A
- puts "Should see 'Base::B' ---> "
- x B
- rename x ""
- Bar x -this [$d toBar]
- puts "Should see 'Bar::B' ---> "
- x B
- rename x ""
- puts "\nTesting some dynamic casts\n"
- Base x -this [$d toBase]
- puts "Spam -> Base -> Foo : "
- set y [Foo_fromBase [x cget -this]]
- if {$y != "NULL"} {
- puts "bad swig"
- } {
- puts "good swig"
- }
- puts "Spam -> Base -> Bar : "
- set y [Bar_fromBase [x cget -this]]
- if {$y != "NULL"} {
- puts "good swig"
- } {
- puts "bad swig"
- }
-
- puts "Spam -> Base -> Spam : "
- set y [Spam_fromBase [x cget -this]]
- if {$y != "NULL"} {
- puts "good swig"
- } {
- puts "bad swig"
- }
- puts "Foo -> Spam : "
- set y [Spam_fromBase $b]
- if {$y != "NULL"} {
- puts "bad swig"
- } {
- puts "good swig"
- }