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