util/src/TclTk/tcl8.6.12/pkgs/itcl4.2.2/tests/interp.test

   1 #
   2 # Tests for using [incr Tcl] in child interpreters
   3 # ----------------------------------------------------------------------
   4 #   AUTHOR:  Michael J. McLennan
   5 #            Bell Labs Innovations for Lucent Technologies
   6 #            mmclennan@lucent.com
   7 #            http://www.tcltk.com/itcl
   8 # ----------------------------------------------------------------------
   9 #            Copyright (c) 1993-1998  Lucent Technologies, Inc.
  10 # ======================================================================
  11 # See the file "license.terms" for information on usage and
  12 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13
  14 package require tcltest 2.1
  15 namespace import ::tcltest::test
  16 ::tcltest::loadTestedCommands
  17 package require itcl
  18
  19 # ----------------------------------------------------------------------
  20 #  Make sure that child interpreters can be created and loaded
  21 #  with [incr Tcl]...
  22 # ----------------------------------------------------------------------
  23 test interp-1.1 {create a child interp with [incr Tcl]} {
  24     interp create child
  25     load "" Itcl child
  26     list [child eval "namespace children :: itcl"] [interp delete child]
  27 } {::itcl {}}
  28
  29 test interp-1.2 {create a safe child interp with [incr Tcl]} {
  30     interp create -safe child
  31     load "" Itcl child
  32     list [child eval "namespace children :: itcl"] [interp delete child]
  33 } {::itcl {}}
  34
  35 test interp-1.3 {errors are okay when child interp is deleted} {
  36 catch {interp delete child}
  37     interp create child
  38     load "" Itcl child
  39     child eval {
  40         itcl::class Troublemaker {
  41             destructor { error "cannot delete this object" }
  42         }
  43         itcl::class Foo {
  44             variable obj ""
  45             constructor {} {
  46                 set obj [Troublemaker #auto]
  47             }
  48             destructor {
  49                 delete object $obj
  50             }
  51         }
  52         Foo f
  53     }
  54     interp delete child
  55 } {}
  56
  57 test interp-1.4 {one namespace can cause another to be destroyed} {
  58     interp create child
  59     load "" Itcl child
  60     child eval {
  61         namespace eval group {
  62             itcl::class base1 {}
  63             itcl::class base2 {}
  64         }
  65         itcl::class TroubleMaker {
  66             inherit group::base1 group::base2
  67         }
  68     }
  69     interp delete child
  70 } {}
  71
  72 test interp-1.5 {cleanup interp object list, this should not
  73         include an object that deletes itself in ctor} {
  74     interp create child
  75     load "" Itcl child
  76     child eval {
  77         itcl::class DeleteSelf {
  78             constructor {} {
  79                 itcl::delete object $this
  80             }
  81         }
  82         DeleteSelf ds
  83     }
  84     interp delete child
  85 } {}
  86
  87 ::tcltest::cleanupTests
  88 return