PageRenderTime 44ms CodeModel.GetById 16ms RepoModel.GetById 0ms app.codeStats 0ms

/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
  1. # file: runme.tcl
  2. # Test various properties of classes defined in separate modules
  3. puts "Testing the %import directive"
  4. catch { load ./base[info sharedlibextension] base}
  5. catch { load ./foo[info sharedlibextension] foo}
  6. catch { load ./bar[info sharedlibextension] bar}
  7. catch { load ./spam[info sharedlibextension] spam}
  8. # Create some objects
  9. puts "Creating some objects"
  10. set a [Base]
  11. set b [Foo]
  12. set c [Bar]
  13. set d [Spam]
  14. # Try calling some methods
  15. puts "Testing some methods"
  16. puts "Should see 'Base::A' ---> "
  17. $a A
  18. puts "Should see 'Base::B' ---> "
  19. $a B
  20. puts "Should see 'Foo::A' ---> "
  21. $b A
  22. puts "Should see 'Foo::B' ---> "
  23. $b B
  24. puts "Should see 'Bar::A' ---> "
  25. $c A
  26. puts "Should see 'Bar::B' ---> "
  27. $c B
  28. puts "Should see 'Spam::A' ---> "
  29. $d A
  30. puts "Should see 'Spam::B' ---> "
  31. $d B
  32. # Try some casts
  33. puts "\nTesting some casts\n"
  34. Base x -this [$a toBase]
  35. puts "Should see 'Base::A' ---> "
  36. x A
  37. puts "Should see 'Base::B' ---> "
  38. x B
  39. rename x ""
  40. Base x -this [$b toBase]
  41. puts "Should see 'Foo::A' ---> "
  42. x A
  43. puts "Should see 'Base::B' ---> "
  44. x B
  45. rename x ""
  46. Base x -this [$c toBase]
  47. puts "Should see 'Bar::A' ---> "
  48. x A
  49. puts "Should see 'Base::B' ---> "
  50. x B
  51. rename x ""
  52. Base x -this [$d toBase]
  53. puts "Should see 'Spam::A' ---> "
  54. x A
  55. puts "Should see 'Base::B' ---> "
  56. x B
  57. rename x ""
  58. Bar x -this [$d toBar]
  59. puts "Should see 'Bar::B' ---> "
  60. x B
  61. rename x ""
  62. puts "\nTesting some dynamic casts\n"
  63. Base x -this [$d toBase]
  64. puts "Spam -> Base -> Foo : "
  65. set y [Foo_fromBase [x cget -this]]
  66. if {$y != "NULL"} {
  67. puts "bad swig"
  68. } {
  69. puts "good swig"
  70. }
  71. puts "Spam -> Base -> Bar : "
  72. set y [Bar_fromBase [x cget -this]]
  73. if {$y != "NULL"} {
  74. puts "good swig"
  75. } {
  76. puts "bad swig"
  77. }
  78. puts "Spam -> Base -> Spam : "
  79. set y [Spam_fromBase [x cget -this]]
  80. if {$y != "NULL"} {
  81. puts "good swig"
  82. } {
  83. puts "bad swig"
  84. }
  85. puts "Foo -> Spam : "
  86. set y [Spam_fromBase $b]
  87. if {$y != "NULL"} {
  88. puts "bad swig"
  89. } {
  90. puts "good swig"
  91. }