Index: xotcl/ChangeLog =================================================================== diff -u -rcaee4f272cfc744a06a7df61e2f3c73da1b6be64 -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/ChangeLog (.../ChangeLog) (revision caee4f272cfc744a06a7df61e2f3c73da1b6be64) +++ xotcl/ChangeLog (.../ChangeLog) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -1,3 +1,20 @@ + +2007-10-12: + * Release of XOTcl 1.5.6 + +2007-10-09: + * More fixes for treating gobal volatile objects + during shutdown: + - do not allow to create new objects during shutdown + - do not allow objects to be set volatile during shutdown + - handle cases, where application level destroy methods + fail (this could lead to remaining tcl traces pointing + to destroyed objects) + - handle namespaced variables helding deletion traces + for volatile objects + Guess, it would be much simpler to use Tcl-level + unset traces than C-level unset traces... + 2007-10-04: * Revise fix below. The problem was apparently that change of a @@ -23,17 +40,15 @@ the newly identified and fixed problem cases. 2007-09-29: - * Fix for Tcl 8.4.16 (and maybe some other recent tcl 8.4.* versions, 8.5 is fine) for situations, where Tcl variable contain references to deleted XOTcl objects. The fix added a epoch increment to CallStackDoDestroy(). 2007-09-29: + * Fix for cases, where volatile objects are + deleted before the corrsoponding trace variable. - * Fix for cases, where volatile objects are destroyed - (e.g. manually) before the corresponding trace variable. - 2007-09-18: * Release of XOTcl 1.5.5 Index: xotcl/Makefile =================================================================== diff -u -rcaee4f272cfc744a06a7df61e2f3c73da1b6be64 -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/Makefile (.../Makefile) (revision caee4f272cfc744a06a7df61e2f3c73da1b6be64) +++ xotcl/Makefile (.../Makefile) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: Makefile,v 1.48 2007/10/05 09:05:59 neumann Exp $ +# RCS: @(#) $Id: Makefile,v 1.49 2007/10/12 19:53:32 neumann Exp $ #======================================================================== # Add additional lines to handle any additional AC_SUBST cases that @@ -27,7 +27,7 @@ src_test_dir = ${srcdir}/tests src_app_dir = ${srcdir}/apps src_generic_dir = ${srcdir}/generic -TCL_LIB_SPEC = -L/usr/lib -ltcl8.4 +TCL_LIB_SPEC = -L/usr/local/lib -ltcl8.5 TK_LIB_SPEC = subdirs = aol_prefix = /usr/local/aolserver @@ -107,14 +107,14 @@ SHELL = /bin/sh srcdir = . -prefix = /usr -exec_prefix = /usr +prefix = /usr/local +exec_prefix = /usr/local bindir = ${exec_prefix}/bin -libdir = /usr/lib -datadir = /usr/share +libdir = /usr/local/lib +datadir = /usr/local/share mandir = ${prefix}/man -includedir = /usr/include +includedir = /usr/local/include DESTDIR = @@ -143,19 +143,19 @@ SHLIB_CFLAGS = -fno-common SHLIB_LD = ${CC} -dynamiclib ${CFLAGS} ${LDFLAGS_DEFAULT} -Wl,-single_module SHLIB_LD_FLAGS = @SHLIB_LD_FLAGS@ -SHLIB_LD_LIBS = ${LIBS} -L/usr/lib -ltclstub8.4 +SHLIB_LD_LIBS = ${LIBS} -L/usr/local/lib -ltclstub8.5 STLIB_LD = ${AR} cr -TCL_DEFS = -DNO_VALUES_H=1 -DHAVE_LIMITS_H=1 -DHAVE_UNISTD_H=1 -DHAVE_SYS_PARAM_H=1 -DUSE_THREAD_ALLOC=1 -D_REENTRANT=1 -D_THREAD_SAFE=1 -DHAVE_PTHREAD_ATTR_SETSTACKSIZE=1 -DHAVE_PTHREAD_ATFORK=1 -DTCL_THREADS=1 -DHAVE_COREFOUNDATION=1 -DMAC_OSX_TCL=1 -DTCL_WIDE_INT_TYPE=long\ long -DHAVE_GETCWD=1 -DHAVE_OPENDIR=1 -DHAVE_STRSTR=1 -DHAVE_STRTOL=1 -DHAVE_STRTOLL=1 -DHAVE_STRTOULL=1 -DHAVE_TMPNAM=1 -DHAVE_WAITPID=1 -DHAVE_GETPWUID_R_5=1 -DHAVE_GETPWUID_R=1 -DHAVE_GETPWNAM_R_5=1 -DHAVE_GETPWNAM_R=1 -DHAVE_GETGRGID_R_5=1 -DHAVE_GETGRGID_R=1 -DHAVE_GETGRNAM_R_5=1 -DHAVE_GETGRNAM_R=1 -DHAVE_MTSAFE_GETHOSTBYNAME=1 -DHAVE_MTSAFE_GETHOSTBYADDR=1 -DUSE_TERMIOS=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_TM_ZONE=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_TM_GMTOFF=1 -DHAVE_ST_BLKSIZE=1 -DSTDC_HEADERS=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_PUTENV_THAT_COPIES=1 -DHAVE_LANGINFO=1 -DHAVE_COPYFILE=1 -DHAVE_LIBKERN_OSATOMIC_H=1 -DHAVE_OSSPINLOCKLOCK=1 -DHAVE_PTHREAD_ATFORK=1 -DUSE_VFORK=1 -DTCL_DEFAULT_ENCODING=\"utf-8\" -DTCL_LOAD_FROM_MEMORY=1 -DHAVE_AVAILABILITYMACROS_H=1 -DHAVE_FTS=1 -DHAVE_SYS_IOCTL_H=1 -DHAVE_SYS_FILIO_H=1 -TCL_BIN_DIR = /usr/lib -TCL_SRC_DIR = /usr/local/src/tcl8.4.16 +TCL_DEFS = -DPACKAGE_NAME=\"tcl\" -DPACKAGE_TARNAME=\"tcl\" -DPACKAGE_VERSION=\"8.5\" -DPACKAGE_STRING=\"tcl\ 8.5\" -DPACKAGE_BUGREPORT=\"\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DNO_VALUES_H=1 -DHAVE_LIMITS_H=1 -DHAVE_SYS_PARAM_H=1 -DUSE_THREAD_ALLOC=1 -D_REENTRANT=1 -D_THREAD_SAFE=1 -DHAVE_PTHREAD_ATTR_SETSTACKSIZE=1 -DHAVE_PTHREAD_GET_STACKSIZE_NP=1 -DTCL_THREADS=1 -DTCL_CFGVAL_ENCODING=\"iso8859-1\" -DMODULE_SCOPE=extern\ __attribute__\(\(__visibility__\(\"hidden\"\)\)\) -DHAVE_COREFOUNDATION=1 -DMAC_OSX_TCL=1 -DTCL_SHLIB_EXT=\".dylib\" -DTCL_CFG_OPTIMIZED=1 -DTCL_CFG_DEBUG=1 -DTCL_TOMMATH=1 -DMP_PREC=4 -DTCL_WIDE_INT_TYPE=long\ long -DHAVE_GETCWD=1 -DHAVE_OPENDIR=1 -DHAVE_STRTOL=1 -DHAVE_STRTOLL=1 -DHAVE_STRTOULL=1 -DHAVE_TMPNAM=1 -DHAVE_WAITPID=1 -DHAVE_GETPWUID_R_5=1 -DHAVE_GETPWUID_R=1 -DHAVE_GETPWNAM_R_5=1 -DHAVE_GETPWNAM_R=1 -DHAVE_GETGRGID_R_5=1 -DHAVE_GETGRGID_R=1 -DHAVE_GETGRNAM_R_5=1 -DHAVE_GETGRNAM_R=1 -DHAVE_MTSAFE_GETHOSTBYNAME=1 -DHAVE_MTSAFE_GETHOSTBYADDR=1 -DUSE_TERMIOS=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_STRUCT_TM_TM_ZONE=1 -DHAVE_TM_ZONE=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_MKTIME=1 -DHAVE_TM_GMTOFF=1 -DHAVE_STRUCT_STAT_ST_BLKSIZE=1 -DHAVE_ST_BLKSIZE=1 -DHAVE_INTPTR_T=1 -DHAVE_UINTPTR_T=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_PUTENV_THAT_COPIES=1 -DHAVE_LANGINFO=1 -DHAVE_CHFLAGS=1 -DHAVE_GETATTRLIST=1 -DHAVE_COPYFILE=1 -DHAVE_LIBKERN_OSATOMIC_H=1 -DHAVE_OSSPINLOCKLOCK=1 -DHAVE_PTHREAD_ATFORK=1 -DUSE_VFORK=1 -DTCL_DEFAULT_ENCODING=\"utf-8\" -DTCL_LOAD_FROM_MEMORY=1 -DTCL_WIDE_CLICKS=1 -DHAVE_AVAILABILITYMACROS_H=1 -DHAVE_FTS=1 -DHAVE_SYS_IOCTL_H=1 -DHAVE_SYS_FILIO_H=1 -DTCL_UNLOAD_DLLS=1 +TCL_BIN_DIR = /usr/local/lib +TCL_SRC_DIR = /Users/neumann/src/tcl/tcl # This is necessary for packages that use private Tcl headers -#TCL_TOP_DIR_NATIVE = "/usr/local/src/tcl8.4.16" +#TCL_TOP_DIR_NATIVE = "/Users/neumann/src/tcl/tcl" # Not used, but retained for reference of what libs Tcl required TCL_LIBS = ${DL_LIBS} ${LIBS} ${MATH_LIBS} -pkgdatadir = /usr/share/xotcl1.5.6 -pkglibdir = /usr/lib/xotcl1.5.6 -pkgincludedir = /usr/include/xotcl1.5.6 +pkgdatadir = /usr/local/share/xotcl1.5.6 +pkglibdir = /usr/local/lib/xotcl1.5.6 +pkgincludedir = /usr/local/include/xotcl1.5.6 # XOTCLSH = xotclsh @@ -171,11 +171,11 @@ DYLD_LIBRARY_PATH="$(EXTRA_PATH):$(DYLD_LIBRARY_PATH)" \ PATH="$(EXTRA_PATH):$(PATH)" \ TCLLIBPATH="$(top_builddir) ${srcdir}" -TCLSH_PROG = /usr/bin/tclsh8.4 +TCLSH_PROG = /usr/local/bin/tclsh8.5 TCLSH = $(TCLSH_ENV) $(TCLSH_PROG) SHARED_BUILD = 1 -INCLUDES = -I"/usr/local/src/tcl8.4.16/generic" -I"/usr/local/src/tcl8.4.16/unix" -I./generic +INCLUDES = -I"/Users/neumann/src/tcl/tcl/generic" -I"/Users/neumann/src/tcl/tcl/unix" -I./generic EXTRA_CFLAGS = -DXOTCLVERSION=\"1.5\" -DXOTCLPATCHLEVEL=\".6\" -DHAVE_TCL_COMPILE_H=1 # TCL_DEFS is not strictly need here, but if you remove it, then you @@ -634,7 +634,7 @@ @echo " setenv TCLLIBPATH \"$(TCLLIBPATH)\"" @echo " and" @if test "x$(XOTCLSH)" = "x" ; then \ - echo " /usr/bin/tclsh8.4" ; \ + echo " /usr/local/bin/tclsh8.5" ; \ echo " package require XOTcl; namespace import -force xotcl::*" ; \ echo " or" ; \ echo " put the 'package require' line into your ~/.tclshrc" ; \ Index: xotcl/apps/utils/xotclsh =================================================================== diff -u -rcaee4f272cfc744a06a7df61e2f3c73da1b6be64 -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/apps/utils/xotclsh (.../xotclsh) (revision caee4f272cfc744a06a7df61e2f3c73da1b6be64) +++ xotcl/apps/utils/xotclsh (.../xotclsh) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -1,7 +1,7 @@ -#!/usr/bin/tclsh8.4 +#!/usr/local/bin/tclsh8.5 if {$argc == 0} { puts "Don't use [info script] as interactive shell! Use instead:" - puts " /usr/bin/tclsh8.4" + puts " /usr/local/bin/tclsh8.5" puts " package require XOTcl; namespace import ::xotcl::*" } else { package require XOTcl Index: xotcl/apps/utils/xowish =================================================================== diff -u -rcaee4f272cfc744a06a7df61e2f3c73da1b6be64 -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/apps/utils/xowish (.../xowish) (revision caee4f272cfc744a06a7df61e2f3c73da1b6be64) +++ xotcl/apps/utils/xowish (.../xowish) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -1,5 +1,5 @@ #!@WISH_PROG@ -###!/usr/bin/tclsh8.4 +###!/usr/local/bin/tclsh8.5 ###package require Tk if {$argc == 0} { puts "Don't use [info script] as interactive shell! Use instead:" Index: xotcl/doc/xo-daemon.html =================================================================== diff -u -rcaee4f272cfc744a06a7df61e2f3c73da1b6be64 -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/doc/xo-daemon.html (.../xo-daemon.html) (revision caee4f272cfc744a06a7df61e2f3c73da1b6be64) +++ xotcl/doc/xo-daemon.html (.../xo-daemon.html) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -76,7 +76,7 @@ Date: - [::xotcl::rcs date {$Date: 2007/10/05 09:06:00 $}] + [::xotcl::rcs date {$Date: 2007/10/12 19:53:32 $}] Index: xotcl/doc/xo-whichPkg.html =================================================================== diff -u -rcaee4f272cfc744a06a7df61e2f3c73da1b6be64 -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/doc/xo-whichPkg.html (.../xo-whichPkg.html) (revision caee4f272cfc744a06a7df61e2f3c73da1b6be64) +++ xotcl/doc/xo-whichPkg.html (.../xo-whichPkg.html) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -50,7 +50,7 @@ Date: - [::xotcl::rcs date {$Date: 2007/10/05 09:06:00 $}] + [::xotcl::rcs date {$Date: 2007/10/12 19:53:32 $}] Index: xotcl/generic/xotcl.c =================================================================== diff -u -rcaee4f272cfc744a06a7df61e2f3c73da1b6be64 -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/generic/xotcl.c (.../xotcl.c) (revision caee4f272cfc744a06a7df61e2f3c73da1b6be64) +++ xotcl/generic/xotcl.c (.../xotcl.c) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -1,4 +1,4 @@ -/* $Id: xotcl.c,v 1.50 2007/10/05 09:06:00 neumann Exp $ +/* $Id: xotcl.c,v 1.51 2007/10/12 19:53:32 neumann Exp $ * * XOTcl - Extended Object Tcl * @@ -751,12 +751,12 @@ #if defined(XOTCLOBJ_TRACE) void objTrace(char *string, XOTclObject *obj) { if (obj) - fprintf(stderr,"--- %s tcl %p %s (%d %p) xotcl %p (%d) %s \n", string, - obj->cmdName, obj->cmdName->typePtr ? obj->cmdName->typePtr->name : "NULL", - obj->cmdName->refCount, obj->cmdName->internalRep.twoPtrValue.ptr1, - obj, obj->refCount, ObjStr(obj->cmdName)); + fprintf(stderr,"--- %s tcl %p %s (%d %p) xotcl %p (%d) %s \n", string, + obj->cmdName, obj->cmdName->typePtr ? obj->cmdName->typePtr->name : "NULL", + obj->cmdName->refCount, obj->cmdName->internalRep.twoPtrValue.ptr1, + obj, obj->refCount, ObjStr(obj->cmdName)); else - fprintf(stderr,"--- No object: %s\n",string); + fprintf(stderr,"--- No object: %s\n",string); } #else # define objTrace(a,b) @@ -2373,7 +2373,6 @@ oid = obj->id; obj->id = 0; if (obj->teardown && oid) { - /* This command will call PrimitiveODestroy or PrimitiveCDestroy */ Tcl_DeleteCommandFromToken(in, oid); } } @@ -6081,13 +6080,13 @@ CallStackUseActiveFrames(in,&ctx); if (defVal != 0) { - if (Tcl_ObjSetVar2(in, var, 0, defVal, 0) != NULL) { + if (Tcl_ObjSetVar2(in, var, NULL, defVal, 0) != NULL) { Tcl_SetIntObj(Tcl_GetObjResult(in), 1); } else { result = TCL_ERROR; } } else { - if (Tcl_ObjSetVar2(in, var, 0, + if (Tcl_ObjSetVar2(in, var, NULL, XOTclGlobalObjects[XOTE_EMPTY], 0) != NULL) { Tcl_SetIntObj(Tcl_GetObjResult(in), 0); } else { @@ -6794,6 +6793,114 @@ * object creation & destruction */ +static int +unsetInAllNamespaces(Tcl_Interp *in, Namespace *nsPtr, char *name) { + int rc = 0; + fprintf(stderr, "### unsetInAllNamespaces %s\n",name); + if (nsPtr != NULL) { + Tcl_HashSearch search; + Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); + Tcl_Var *varPtr; + int rc = 0; + + varPtr = (Tcl_Var *) Tcl_FindNamespaceVar(in, name, (Tcl_Namespace *) nsPtr, 0); + /*fprintf(stderr, "found %s in %s -> %p\n",name, nsPtr->fullName, varPtr);*/ + if (varPtr) { + Tcl_DString dFullname, *dsPtr = &dFullname; + Tcl_DStringInit(dsPtr); + Tcl_DStringAppend(dsPtr, "unset ", -1); + Tcl_DStringAppend(dsPtr, nsPtr->fullName, -1); + Tcl_DStringAppend(dsPtr, "::", 2); + Tcl_DStringAppend(dsPtr, name, -1); + /*rc = Tcl_UnsetVar2(in, Tcl_DStringValue(dsPtr), NULL, TCL_LEAVE_ERR_MSG);*/ + rc = Tcl_Eval(in, Tcl_DStringValue(dsPtr)); + /* fprintf(stderr, "fqName = '%s' unset => %d %d\n",Tcl_DStringValue(dsPtr), rc, TCL_OK);*/ + if (rc == TCL_OK) { + rc = 1; + } else { + Tcl_Obj *resultObj = Tcl_GetObjResult(in); + fprintf(stderr, " err = '%s'\n", ObjStr(resultObj)); + } + Tcl_DStringFree(dsPtr); + } + + while (entryPtr != NULL) { + Namespace *childNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr); + /*fprintf(stderr, "child = %s\n", childNsPtr->fullName);*/ + entryPtr = Tcl_NextHashEntry(&search); + rc |= unsetInAllNamespaces(in, childNsPtr, name); + } + } + return rc; +} + +static int +freeUnsetTraceVariable(Tcl_Interp *in, XOTclObject *obj) { + int rc = TCL_OK; + if (obj->opt && obj->opt->volatileVarName) { + /* + Somebody destroys a volatile object manually while + the vartrace is still active. Destroying the object will + be a problem in case the variable is deleted later + and fires the trace. So, we unset the variable here + which will cause a destroy via var trace, which in + turn clears the volatileVarName flag. + */ + /*fprintf(stderr,"### freeUnsetTraceVariable %s\n", obj->opt->volatileVarName);*/ + + rc = Tcl_UnsetVar2(in, obj->opt->volatileVarName, NULL, 0); + if (rc != TCL_OK) { + int rc = Tcl_UnsetVar2(in, obj->opt->volatileVarName, NULL, TCL_GLOBAL_ONLY); + if (rc != TCL_OK) { + Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(in); + if (unsetInAllNamespaces(in, nsPtr, obj->opt->volatileVarName) == 0) { + fprintf(stderr, "### don't know how to delete variable '%s' of volatile object\n", + obj->opt->volatileVarName); + } + } + } + if (rc == TCL_OK) { + /*fprintf(stderr, "### success unset\n");*/ + } + } + return rc; +} + +static char * +XOTclUnsetTrace(ClientData cd, Tcl_Interp *in, CONST84 char *name, CONST84 char *name2, int flags) +{ + Tcl_Obj *obj = (Tcl_Obj *)cd; + XOTclObject *o; + char *result = NULL; + + /*fprintf(stderr,"XOTclUnsetTrace %s flags %x %x\n", name, flags, + flags & TCL_INTERP_DESTROYED); */ + + if ((flags & TCL_INTERP_DESTROYED) == 0) { + if (XOTclObjConvertObject(in, obj, &o) == TCL_OK) { + Tcl_Obj *res = Tcl_GetObjResult(in); /* save the result */ + INCR_REF_COUNT(res); + + /* clear variable, destroy is called from trace */ + if (o->opt && o->opt->volatileVarName) { + o->opt->volatileVarName = NULL; + } + + if (callMethod((ClientData)o, in, XOTclGlobalObjects[XOTE_DESTROY],2,0,0) != TCL_OK) { + result = "Destroy for volatile object failed"; + } else + result = "No XOTcl Object passed"; + + Tcl_SetObjResult(in, res); /* restore the result */ + DECR_REF_COUNT(res); + } + DECR_REF_COUNT(obj); + } else { + /*fprintf(stderr, "omitting destroy on %s %p\n", name);*/ + } + return result; +} + /* * mark an obj on the existing callstack, as not destroyed */ @@ -6919,8 +7026,7 @@ XOTclObject *obj = (XOTclObject*)cd; Tcl_Interp *in; - - /* fprintf(stderr, "****** PrimitiveODestroy %p\n",obj);*/ + /*fprintf(stderr, "****** PrimitiveODestroy %p\n",obj);*/ assert(obj && !(obj->flags & XOTCL_DESTROYED)); /* @@ -6966,11 +7072,9 @@ in Tcl 8.4.* versions. */ Tcl_Command cmd = Tcl_FindCommand(in, ObjStr(obj->cmdName), 0, 0); - /* cmd = Tcl_GetCommandFromObj(in, obj->cmdName);*/ - - if (cmd != NULL) { + + if (cmd != NULL) Tcl_Command_deleteProc(cmd) = 0; - } } #endif @@ -9686,6 +9790,7 @@ } + /* * class method implementations */ @@ -9694,6 +9799,7 @@ XOTclCInstDestroyMethod(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) { XOTclClass *cl = XOTclObjectToClass(cd); XOTclObject *delobj; + int rc; if (!cl) return XOTclObjErrType(in, objv[0], "Class"); if (objc < 2) @@ -9706,17 +9812,9 @@ /* fprintf(stderr,"instdestroy obj=%s, opt=%p\n",ObjStr(delobj->cmdName),delobj->opt);*/ - if (delobj->opt && delobj->opt->volatileVarName) { - /* - Somebody destroys a volatile object manually while - the vartrace is still active. Destroying the object will - be a problem in case the variable is deleted later - and fires the trace. So, we unset the variable here - which will cause a destroy via var trace, which in - turn clears the volatileVarName flag. - */ - /* fprintf(stderr,"volatile var name %s\n",delobj->opt->volatileVarName);*/ - return Tcl_UnsetVar2(in, delobj->opt->volatileVarName, 0, 0); + rc = freeUnsetTraceVariable(in, delobj); + if (rc != TCL_OK) { + return rc; } /* @@ -9969,43 +10067,16 @@ if (objc < 2) return XOTclObjErrArgCnt(in, cl->object.cmdName, "create ?args?"); + if (RUNTIME_STATE(in)->exitHandlerDestroyRound != XOTCL_EXITHANDLER_OFF) { + fprintf(stderr,"### Can't create object %s during shutdown\n",ObjStr(objv[1])); + return TCL_ERROR; + return TCL_OK; /* don't fail, if this happens during destroy, it might be canceled */ + } + return createMethod(in, cl, &cl->object, objc, objv); } -static char * -XOTclUnsetTrace(ClientData cd, Tcl_Interp *in, CONST84 char *name, CONST84 char *name2, int flags) -{ - Tcl_Obj *obj = (Tcl_Obj *)cd; - XOTclObject *o; - char *result = NULL; - if (RUNTIME_STATE(in)->exitHandlerDestroyRound == XOTCL_EXITHANDLER_OFF) { - if (XOTclObjConvertObject(in, obj, &o) == TCL_OK) { - Tcl_Obj *res = Tcl_GetObjResult(in); /* save the result */ - INCR_REF_COUNT(res); - - /* clear variable, destroy is called from trace */ - if (o->opt && o->opt->volatileVarName) { - o->opt->volatileVarName = NULL; - } - - if (callMethod((ClientData)o, in, XOTclGlobalObjects[XOTE_DESTROY],2,0,0) != TCL_OK) { - result = "Destroy for volatile object failed"; - } else - result = "No XOTcl Object passed"; - - Tcl_SetObjResult(in, res); /* restore the result */ - DECR_REF_COUNT(res); - } - DECR_REF_COUNT(obj); - } else { - /*fprintf(stderr, "omitting destroy on %s %p\n", name);*/ - } - return result; -} - - - static int XOTclCNewMethod(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) { XOTclClass *cl = XOTclObjectToClass(cd); @@ -10685,11 +10756,18 @@ if (objc != 1) return XOTclObjErrArgCnt(in, obj->cmdName, "volatile"); + if (RUNTIME_STATE(in)->exitHandlerDestroyRound != XOTCL_EXITHANDLER_OFF) { + fprintf(stderr,"### Can't make objects volatile during shutdown\n"); + return XOTclVarErrMsg(in, "Can't make objects volatile during shutdown\n",NULL); + } + CallStackUseActiveFrames(in, &ctx); vn = NSTail(fullName); - if (Tcl_SetVar2(in, vn, 0, fullName, 0) != NULL) { + if (Tcl_SetVar2(in, vn, NULL, fullName, 0) != NULL) { XOTclObjectOpt *opt = XOTclRequireObjectOpt(obj); + + /*fprintf(stderr,"### setting trace for %s\n", fullName);*/ result = Tcl_TraceVar(in, vn, TCL_TRACE_UNSETS, (Tcl_VarTraceProc*)XOTclUnsetTrace, (ClientData)o); opt->volatileVarName = vn; @@ -11477,14 +11555,14 @@ ordinaryArgsCounter++; } if (argsDefined) { - Tcl_SetVar2(in, "args", 0, "", 0); + Tcl_SetVar2(in, "args", NULL, "", 0); } } else if (argsDefined && ordinaryArgsCounter == ordinaryArgsDefc-1) { - Tcl_SetVar2(in, "args", 0, "", 0); + Tcl_SetVar2(in, "args", NULL, "", 0); } if (!argsDefined) { - Tcl_UnsetVar2(in, "args", 0, 0); + Tcl_UnsetVar2(in, "args", NULL, 0); } /* checking vars */ @@ -11623,7 +11701,7 @@ getVarAndNameFromHash(entryPtr, &varPtr, &nameObj); if (!TclIsVarUndefined(varPtr) || TclIsVarNamespaceVar(varPtr)) { /* fprintf(stderr, "unsetting var %s\n", ObjStr(nameObj));*/ - Tcl_UnsetVar2(in, ObjStr(nameObj), (char *) NULL, TCL_GLOBAL_ONLY); + Tcl_UnsetVar2(in, ObjStr(nameObj), (char *)NULL, TCL_GLOBAL_ONLY); } entryPtr = Tcl_NextHashEntry(&search); } @@ -11691,7 +11769,7 @@ XOTclObject *obj; XOTclClass *thecls, *theobj, *cl; - /*fprintf(stderr,"??? freeAllXOTclObjectsAndClasses in %p\n", in);*/ + /* fprintf(stderr,"??? freeAllXOTclObjectsAndClasses in %p\n", in); */ thecls = RUNTIME_STATE(in)->theClass; theobj = RUNTIME_STATE(in)->theObject; @@ -11704,8 +11782,9 @@ char *key = Tcl_GetHashKey(commandTable, hPtr); obj = XOTclpGetObject(in, key); if (obj && !XOTclObjectIsClass(obj) && !ObjectHasChildren(in,obj)) { - /*fprintf(stderr," ... delete object %s %p, class=%s\n",key,obj, - ObjStr(obj->cl->object.cmdName));*/ + /* fprintf(stderr," ... delete object %s %p, class=%s\n",key,obj, + ObjStr(obj->cl->object.cmdName));*/ + freeUnsetTraceVariable(in, obj); Tcl_DeleteCommandFromToken(in, obj->id); hDel = hPtr; deleted++; @@ -11734,6 +11813,7 @@ && cl != RUNTIME_STATE(in)->theObject ) { /* fprintf(stderr," ... delete class %s %p\n",key,cl); */ + freeUnsetTraceVariable(in, &cl->object); Tcl_DeleteCommandFromToken(in, cl->object.id); hDel = hPtr; deleted++; @@ -11862,8 +11942,8 @@ while (hPtr) { char *key = Tcl_GetHashKey(commandTable, hPtr); obj = XOTclpGetObject(in, key); - /*fprintf(stderr,"key = %s %p %d\n", - key, obj, obj && !XOTclObjectIsClass(obj));*/ + /* fprintf(stderr,"key = %s %p %d\n", + key, obj, obj && !XOTclObjectIsClass(obj)); */ if (obj && !XOTclObjectIsClass(obj) && !(obj->flags & XOTCL_DESTROY_CALLED)) callDestroyMethod((ClientData)obj, in, obj, 0); Index: xotcl/generic/xotclInt.h =================================================================== diff -u -rcaee4f272cfc744a06a7df61e2f3c73da1b6be64 -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/generic/xotclInt.h (.../xotclInt.h) (revision caee4f272cfc744a06a7df61e2f3c73da1b6be64) +++ xotcl/generic/xotclInt.h (.../xotclInt.h) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -1,5 +1,5 @@ /* -*- Mode: c++ -*- - * $Id: xotclInt.h,v 1.26 2007/10/05 09:06:00 neumann Exp $ + * $Id: xotclInt.h,v 1.27 2007/10/12 19:53:32 neumann Exp $ * Extended Object Tcl (XOTcl) * * Copyright (C) 1999-2006 Gustaf Neumann, Uwe Zdun Index: xotcl/library/store/XOTclGdbm/configure.in =================================================================== diff -u -rcaee4f272cfc744a06a7df61e2f3c73da1b6be64 -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/library/store/XOTclGdbm/configure.in (.../configure.in) (revision caee4f272cfc744a06a7df61e2f3c73da1b6be64) +++ xotcl/library/store/XOTclGdbm/configure.in (.../configure.in) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -3,7 +3,7 @@ dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.19 2007/10/05 09:06:00 neumann Exp $ +# RCS: @(#) $Id: configure.in,v 1.20 2007/10/12 19:53:32 neumann Exp $ #----------------------------------------------------------------------- # Sample configure.in for Tcl Extensions. The only places you should Index: xotcl/library/store/XOTclGdbm/tcl.m4 =================================================================== diff -u -r9620bd8d134f2f6c30fc0d32c769c8a84c6c597b -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/library/store/XOTclGdbm/tcl.m4 (.../tcl.m4) (revision 9620bd8d134f2f6c30fc0d32c769c8a84c6c597b) +++ xotcl/library/store/XOTclGdbm/tcl.m4 (.../tcl.m4) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.m4,v 1.1 2007/10/12 19:53:07 neumann Exp $ +# RCS: @(#) $Id: tcl.m4,v 1.2 2007/10/12 19:53:32 neumann Exp $ AC_PREREQ(2.57) Index: xotcl/library/store/XOTclSdbm/configure.in =================================================================== diff -u -rcaee4f272cfc744a06a7df61e2f3c73da1b6be64 -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/library/store/XOTclSdbm/configure.in (.../configure.in) (revision caee4f272cfc744a06a7df61e2f3c73da1b6be64) +++ xotcl/library/store/XOTclSdbm/configure.in (.../configure.in) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -3,7 +3,7 @@ dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.19 2007/10/05 09:06:00 neumann Exp $ +# RCS: @(#) $Id: configure.in,v 1.20 2007/10/12 19:53:32 neumann Exp $ #----------------------------------------------------------------------- # Sample configure.in for Tcl Extensions. The only places you should Index: xotcl/library/store/XOTclSdbm/tcl.m4 =================================================================== diff -u -r9620bd8d134f2f6c30fc0d32c769c8a84c6c597b -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/library/store/XOTclSdbm/tcl.m4 (.../tcl.m4) (revision 9620bd8d134f2f6c30fc0d32c769c8a84c6c597b) +++ xotcl/library/store/XOTclSdbm/tcl.m4 (.../tcl.m4) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.m4,v 1.1 2007/10/12 19:53:07 neumann Exp $ +# RCS: @(#) $Id: tcl.m4,v 1.2 2007/10/12 19:53:32 neumann Exp $ AC_PREREQ(2.57) Index: xotcl/library/xml/TclExpat-1.1/configure.in =================================================================== diff -u -rcaee4f272cfc744a06a7df61e2f3c73da1b6be64 -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/library/xml/TclExpat-1.1/configure.in (.../configure.in) (revision caee4f272cfc744a06a7df61e2f3c73da1b6be64) +++ xotcl/library/xml/TclExpat-1.1/configure.in (.../configure.in) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -3,7 +3,7 @@ dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.19 2007/10/05 09:06:00 neumann Exp $ +# RCS: @(#) $Id: configure.in,v 1.20 2007/10/12 19:53:32 neumann Exp $ #----------------------------------------------------------------------- # Sample configure.in for Tcl Extensions. The only places you should Index: xotcl/library/xml/TclExpat-1.1/tcl.m4 =================================================================== diff -u -r9620bd8d134f2f6c30fc0d32c769c8a84c6c597b -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/library/xml/TclExpat-1.1/tcl.m4 (.../tcl.m4) (revision 9620bd8d134f2f6c30fc0d32c769c8a84c6c597b) +++ xotcl/library/xml/TclExpat-1.1/tcl.m4 (.../tcl.m4) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.m4,v 1.1 2007/10/12 19:53:07 neumann Exp $ +# RCS: @(#) $Id: tcl.m4,v 1.2 2007/10/12 19:53:32 neumann Exp $ AC_PREREQ(2.57) Index: xotcl/tests/testx.xotcl =================================================================== diff -u -rcaee4f272cfc744a06a7df61e2f3c73da1b6be64 -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/tests/testx.xotcl (.../testx.xotcl) (revision caee4f272cfc744a06a7df61e2f3c73da1b6be64) +++ xotcl/tests/testx.xotcl (.../testx.xotcl) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -1,4 +1,4 @@ -#$Id: testx.xotcl,v 1.35 2007/10/05 09:06:00 neumann Exp $ +#$Id: testx.xotcl,v 1.36 2007/10/12 19:53:32 neumann Exp $ package require XOTcl namespace import -force xotcl::* @@ -2934,18 +2934,18 @@ namespace delete foo ::errorCheck [Object isobject ::foo::Foo] 0 "Namespace delete under object" - # destroy test - set x [Object create x] - x destroy - ::errorCheck [catch {$x set a 1}] 1 "Reference to destroyed object still valid" + # destroy test + set x [Object create x] + x destroy + ::errorCheck [catch {$x set a 1}] 1 "Reference to destroyed object still valid" - Object create x -volatile - unset x - ::errorCheck [catch {x destroy}] 1 "Object should not exist anymore" + Object create x -volatile + unset x + ::errorCheck [catch {x destroy}] 1 "Object should not exist anymore" - Object create x -volatile - x destroy - ::errorCheck [catch {unset x}] 1 "Variable should not exist anymore" + Object create x -volatile + x destroy + ::errorCheck [catch {unset x}] 1 "Variable should not exist anymore" } Index: xotcl/unix/xotcl.spec =================================================================== diff -u -rcaee4f272cfc744a06a7df61e2f3c73da1b6be64 -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/unix/xotcl.spec (.../xotcl.spec) (revision caee4f272cfc744a06a7df61e2f3c73da1b6be64) +++ xotcl/unix/xotcl.spec (.../xotcl.spec) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -28,7 +28,7 @@ %build autoconf -# ./configure --with-tcl=/usr/lib --with-all --prefix=/usr --exec-prefix=/usr +# ./configure --with-tcl=/usr/lib --with-all --prefix=/usr/local --exec-prefix=/usr/local ./configure --with-tcl=/usr/lib --with-all --prefix=/usr --exec-prefix=/usr # make CFLAGS_DEFAULT='-O3 -mcpu=i686 -Wall -fomit-frame-pointer' make CFLAGS_DEFAULT='-O3 -Wall -fomit-frame-pointer' Index: xotcl/xotclConfig.sh =================================================================== diff -u -rcaee4f272cfc744a06a7df61e2f3c73da1b6be64 -raabbb5f35122b456414873fb6acb13564cc37c1f --- xotcl/xotclConfig.sh (.../xotclConfig.sh) (revision caee4f272cfc744a06a7df61e2f3c73da1b6be64) +++ xotcl/xotclConfig.sh (.../xotclConfig.sh) (revision aabbb5f35122b456414873fb6acb13564cc37c1f) @@ -24,7 +24,7 @@ # String to pass to compiles to pick up the XOTcl includes from their # installed directory. -XOTCL_INCLUDE_DIR="/usr/include/xotcl1.5.6" +XOTCL_INCLUDE_DIR="/usr/local/include/xotcl1.5.6" XOTCL_INCLUDE_SPEC="-I$XOTCL_INCLUDE_DIR" # The name of the XOTcl library (may be either a .a file or a shared library): @@ -36,7 +36,7 @@ # String to pass to linker to pick up the XOTcl library from its # installed directory. -XOTCL_LIB_SPEC='-L/usr/lib/xotcl1.5.6 -lxotcl1.5.6' +XOTCL_LIB_SPEC='-L/usr/local/lib/xotcl1.5.6 -lxotcl1.5.6' # The name of the XOTcl stub library (a .a file): # XOTCL_STUB_LIB_FILE=libxotclstub1.5.6.a @@ -47,11 +47,11 @@ # String to pass to linker to pick up the XOTcl stub library from its # installed directory. -XOTCL_STUB_LIB_SPEC='-L/usr/lib/xotcl1.5.6 -lxotclstub1.5.6' +XOTCL_STUB_LIB_SPEC='-L/usr/local/lib/xotcl1.5.6 -lxotclstub1.5.6' # Name of the xotcl stub library with full path in build and install directory XOTCL_BUILD_STUB_LIB_PATH='/Users/neumann/src/xotcl-1.5.6/libxotclstub1.5.6.a' -XOTCL_STUB_LIB_PATH='/usr/lib/xotcl1.5.6/libxotclstub1.5.6.a' +XOTCL_STUB_LIB_PATH='/usr/local/lib/xotcl1.5.6/libxotclstub1.5.6.a' # Location of the top-level source directories from which XOTcl # was built. This is the directory that contains generic, unix, etc. @@ -65,5 +65,5 @@ XOTCL_UNSHARED_LIB_SUFFIX=1.5.6.a # the shell in whose installation dirs the xotcl package is installed -XOTCL_COMPATIBLE_TCLSH=/usr/bin/tclsh8.4 +XOTCL_COMPATIBLE_TCLSH=/usr/local/bin/tclsh8.5