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