Index: xotcl/ChangeLog =================================================================== diff -u -r894d9fdf1f31a1e18c1942007edebd85ebc5ae59 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/ChangeLog (.../ChangeLog) (revision 894d9fdf1f31a1e18c1942007edebd85ebc5ae59) +++ xotcl/ChangeLog (.../ChangeLog) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -1,3 +1,13 @@ +2004-07-02 Gustaf.Neumann@wu-wien.ac.at + * rename forward option -inscope to -objscope + * xotcl.c: added current namespace prefix, when a forwarder is + defined with -objscope and no namespace prefix was specified + * optimzed forward/instforward such it reaches practically + same speed as tclcmd/insttclcmd. + * removed tclcmd/insttclcmd + * added tests for forward to regreession test suite + * applied and fixed the config improvements by Jim Lynch + 2004-07-01 Gustaf.Neumann@wu-wien.ac.at * xotcl.c: allow literal %self, %proc, %1 etc. as arguments of the forwarder: arguments in the definition of a forwarder proc Index: xotcl/Makefile =================================================================== diff -u -r894d9fdf1f31a1e18c1942007edebd85ebc5ae59 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/Makefile (.../Makefile) (revision 894d9fdf1f31a1e18c1942007edebd85ebc5ae59) +++ xotcl/Makefile (.../Makefile) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -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.8 2004/07/01 10:39:34 neumann Exp $ +# RCS: @(#) $Id: Makefile,v 1.9 2004/07/02 11:22:31 neumann Exp $ #======================================================================== # Add additional lines to handle any additional AC_SUBST cases that @@ -108,11 +108,6 @@ DESTDIR = -PKG_DIR = $(PACKAGE_NAME)$(PACKAGE_VERSION) -pkgdatadir = $(datadir)/$(PKG_DIR) -pkglibdir = $(libdir)/$(PKG_DIR) -pkgincludedir = $(includedir)/$(PKG_DIR) - top_builddir = . INSTALL = /usr/bin/install -c @@ -123,7 +118,7 @@ PACKAGE_NAME = xotcl PACKAGE_VERSION = 1.2.1 CC = gcc -pipe -CFLAGS_DEFAULT = -O -g +CFLAGS_DEFAULT = -O CFLAGS_WARNING = -Wall -Wconversion -Wno-implicit-int CLEANFILES = *.o *.a *.so *~ core gmon.out config.* EXEEXT = @@ -148,6 +143,10 @@ # Not used, but retained for reference of what libs Tcl required TCL_LIBS = ${DL_LIBS} ${LIBS} ${MATH_LIBS} +pkgdatadir = /usr/share/xotcl1.2.1 +pkglibdir = /usr/lib/xotcl1.2.1 +pkgincludedir = /usr/include/xotcl1.2.1 + #======================================================================== # TCLLIBPATH seeds the auto_path in Tcl's init.tcl so we can test our # package without installing. The other environment variables allow us @@ -266,6 +265,7 @@ (cd $(src_lib_dir); $(INSTALL) $$i $(DESTDIR)$(pkglibdir)/$$i) ; \ done; cat ${srcdir}/unix/pkgIndex.unix >> $(DESTDIR)$(pkglibdir)/pkgIndex.tcl + $(INSTALL) xotclConfig.sh $(DESTDIR)$(libdir)/ @for i in $(appdirs) ; do \ echo "Installing $$i" ; \ rm -rf $(DESTDIR)$(pkglibdir)/apps/$$i ; \ @@ -307,6 +307,8 @@ -libdir `echo $(PLATFORM_DIR)` $(TESTFLAGS) $(TCLSH_PROG) `echo $(src_test_dir)/speedtest.xotcl` \ -libdir `echo $(PLATFORM_DIR)` $(TESTFLAGS) + $(TCLSH_PROG) `echo $(src_test_dir)/forwardtest.xotcl` \ + -libdir `echo $(PLATFORM_DIR)` $(TESTFLAGS) $(TCLSH_PROG) `echo $(src_test_dir)/xocomm.test` \ -libdir `echo $(PLATFORM_DIR)` $(TESTFLAGS) test-actiweb: $(TCLSH_PROG) Index: xotcl/Makefile.in =================================================================== diff -u -ra095dd118343e4b469b25c6801fd0de73192686c -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/Makefile.in (.../Makefile.in) (revision a095dd118343e4b469b25c6801fd0de73192686c) +++ xotcl/Makefile.in (.../Makefile.in) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -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.in,v 1.3 2004/06/18 08:27:57 neumann Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.4 2004/07/02 11:22:31 neumann Exp $ #======================================================================== # Add additional lines to handle any additional AC_SUBST cases that @@ -108,11 +108,6 @@ DESTDIR = -PKG_DIR = $(PACKAGE_NAME)$(PACKAGE_VERSION) -pkgdatadir = $(datadir)/$(PKG_DIR) -pkglibdir = $(libdir)/$(PKG_DIR) -pkgincludedir = $(includedir)/$(PKG_DIR) - top_builddir = . INSTALL = @INSTALL@ @@ -148,6 +143,10 @@ # Not used, but retained for reference of what libs Tcl required TCL_LIBS = @TCL_LIBS@ +pkgdatadir = @pkgdatadir@ +pkglibdir = @pkglibdir@ +pkgincludedir = @pkgincludedir@ + #======================================================================== # TCLLIBPATH seeds the auto_path in Tcl's init.tcl so we can test our # package without installing. The other environment variables allow us @@ -266,6 +265,7 @@ (cd $(src_lib_dir); $(INSTALL) $$i $(DESTDIR)$(pkglibdir)/$$i) ; \ done; cat ${srcdir}/unix/pkgIndex.unix >> $(DESTDIR)$(pkglibdir)/pkgIndex.tcl + $(INSTALL) xotclConfig.sh $(DESTDIR)$(libdir)/ @for i in $(appdirs) ; do \ echo "Installing $$i" ; \ rm -rf $(DESTDIR)$(pkglibdir)/apps/$$i ; \ @@ -307,6 +307,8 @@ -libdir `@CYGPATH@ $(PLATFORM_DIR)` $(TESTFLAGS) $(TCLSH_PROG) `@CYGPATH@ $(src_test_dir)/speedtest.xotcl` \ -libdir `@CYGPATH@ $(PLATFORM_DIR)` $(TESTFLAGS) + $(TCLSH_PROG) `@CYGPATH@ $(src_test_dir)/forwardtest.xotcl` \ + -libdir `@CYGPATH@ $(PLATFORM_DIR)` $(TESTFLAGS) $(TCLSH_PROG) `@CYGPATH@ $(src_test_dir)/xocomm.test` \ -libdir `@CYGPATH@ $(PLATFORM_DIR)` $(TESTFLAGS) test-actiweb: $(TCLSH_PROG) Index: xotcl/configure.in =================================================================== diff -u -rcbbcdfc2c1fcbf6d16a0fe9a1f3f8408ae0cbdee -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/configure.in (.../configure.in) (revision cbbcdfc2c1fcbf6d16a0fe9a1f3f8408ae0cbdee) +++ xotcl/configure.in (.../configure.in) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -18,7 +18,7 @@ # Call TEA_INIT as the first TEA_ macro to set up initial vars. # This will define a ${TEA_PLATFORM} variable == "unix" or "windows". #-------------------------------------------------------------------- - + TEA_INIT([3.0]) AC_CONFIG_AUX_DIR(config) @@ -323,23 +323,43 @@ TEA_PROG_TCLSH +# make this available, for such as xotclConfig.sh +XOTCL_COMPATIBLE_TCLSH=${TCLSH_PROG} +AC_SUBST(XOTCL_COMPATIBLE_TCLSH) + +# resolve the variables +eval "libdir=${libdir}" +eval "datadir=${datadir}" +eval "includedir=${includedir}" + +PKG_DIR="${PACKAGE_NAME}${PACKAGE_VERSION}" +pkgdatadir="${datadir}/${PKG_DIR}" +pkglibdir="${libdir}/${PKG_DIR}" +pkgincludedir="${includedir}/${PKG_DIR}" + +AC_SUBST(PKG_DIR) +AC_SUBST(pkgdatadir) +AC_SUBST(pkglibdir) +AC_SUBST(pkgincludedir) + # # XOTcl specific configs # + XOTCL_BUILD_LIB_SPEC="-L`pwd` -lxotcl${PACKAGE_VERSION}" -XOTCL_LIB_SPEC="-L${exec_prefix}/lib -lxotcl${PACKAGE_VERSION}" +XOTCL_LIB_SPEC="-L${pkglibdir} -lxotcl${PACKAGE_VERSION}" # stub libs are not build for 8.0 if test "${TCL_MAJOR_VERSION}" = "8" -a "${TCL_MINOR_VERSION}" = "0"; then - XOTCL_BUILD_STUB_LIB_SPEC="" - XOTCL_STUB_LIB_SPEC="" XOTCL_BUILD_STUB_LIB_PATH="" XOTCL_STUB_LIB_PATH="" + XOTCL_BUILD_STUB_LIB_SPEC="" + XOTCL_STUB_LIB_SPEC="" else - XOTCL_BUILD_STUB_LIB_SPEC="-L`pwd` -lxotclstub${PACKAGE_VERSION}" - XOTCL_STUB_LIB_SPEC="-L${exec_prefix}/lib -lxotclstub${PACKAGE_VERSION}" XOTCL_BUILD_STUB_LIB_PATH="`pwd`/${PKG_STUB_LIB_FILE}" - XOTCL_STUB_LIB_PATH="${exec_prefix}/lib/${PKG_STUB_LIB_FILE}" + XOTCL_STUB_LIB_PATH="${pkglibdir}/${PKG_STUB_LIB_FILE}" + XOTCL_BUILD_STUB_LIB_SPEC="-L`pwd` -lxotclstub${PACKAGE_VERSION}" + XOTCL_STUB_LIB_SPEC="-L${pkglibdir} -lxotclstub${PACKAGE_VERSION}" AC_DEFINE(COMPILE_XOTCL_STUBS) fi Index: xotcl/doc/Serializer-xotcl.html =================================================================== diff -u -rf7894d9be99a8da3a04218abcdb9bd46b6d625c8 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/doc/Serializer-xotcl.html (.../Serializer-xotcl.html) (revision f7894d9be99a8da3a04218abcdb9bd46b6d625c8) +++ xotcl/doc/Serializer-xotcl.html (.../Serializer-xotcl.html) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -14,7 +14,7 @@

Package/File Information

Package required: XOTcl 1.0
- Package provided: xotcl::serializer 0.3 + Package provided: xotcl::serializer 0.4

Defined Objects/Classes: @@ -62,7 +62,7 @@ Date: - $Date: 2004/05/23 22:50:39 $ + $Date: 2004/07/02 11:22:31 $ Index: xotcl/doc/index.html =================================================================== diff -u -rf7894d9be99a8da3a04218abcdb9bd46b6d625c8 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/doc/index.html (.../index.html) (revision f7894d9be99a8da3a04218abcdb9bd46b6d625c8) +++ xotcl/doc/index.html (.../index.html) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -22,7 +22,7 @@

Index: xotcl/doc/langRef-xotcl.html =================================================================== diff -u -r894d9fdf1f31a1e18c1942007edebd85ebc5ae59 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/doc/langRef-xotcl.html (.../langRef-xotcl.html) (revision 894d9fdf1f31a1e18c1942007edebd85ebc5ae59) +++ xotcl/doc/langRef-xotcl.html (.../langRef-xotcl.html) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -121,7 +121,7 @@ Date: - $Date: 2004/07/01 10:39:34 $ + $Date: 2004/07/02 11:22:31 $ Index: xotcl/generic/predefined.h =================================================================== diff -u -rf7894d9be99a8da3a04218abcdb9bd46b6d625c8 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/generic/predefined.h (.../predefined.h) (revision f7894d9be99a8da3a04218abcdb9bd46b6d625c8) +++ xotcl/generic/predefined.h (.../predefined.h) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -1,11 +1,19 @@ static char cmd[] = -"# $Id: predefined.h,v 1.1 2004/05/23 22:50:39 neumann Exp $\n" +"# $Id: predefined.h,v 1.2 2004/07/02 11:22:31 neumann Exp $\n" "::xotcl::Object instproc init args {}\n" "::xotcl::Object create ::xotcl::@\n" "::xotcl::@ proc unknown args {}\n" "namespace eval ::xotcl { namespace export @ }\n" "foreach cmd {array append lappend trace eval} {\n" -"::xotcl::Object insttclcmd $cmd}\n" +"::xotcl::Object instforward $cmd -objscope}\n" +"::xotcl::Object instproc tclcmd {t} {\n" +"set cmd [list [::xotcl::self] forward $t -objscope]\n" +"puts stderr \"the method tclcmd is deprecated; use instead '$cmd'\"\n" +"eval $cmd}\n" +"::xotcl::Class instproc insttclcmd {t} {\n" +"set cmd [list [::xotcl::self] instforward $t -objscope]\n" +"puts stderr \"the method tclcmd is deprecated; use instead '$cmd'\"\n" +"eval $cmd}\n" "::xotcl::Object instproc self {} {return [::xotcl::self]}\n" "::xotcl::Object instproc defaultmethod {} {\n" "return [::xotcl::self]}\n" Index: xotcl/generic/predefined.xotcl =================================================================== diff -u -rf7894d9be99a8da3a04218abcdb9bd46b6d625c8 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/generic/predefined.xotcl (.../predefined.xotcl) (revision f7894d9be99a8da3a04218abcdb9bd46b6d625c8) +++ xotcl/generic/predefined.xotcl (.../predefined.xotcl) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -1,4 +1,4 @@ -# $Id: predefined.xotcl,v 1.1 2004/05/23 22:50:39 neumann Exp $ +# $Id: predefined.xotcl,v 1.2 2004/07/02 11:22:31 neumann Exp $ # init must exist on Object. per default it is empty. ::xotcl::Object instproc init args {} @@ -22,8 +22,18 @@ # provide some Tcl-commands as methods for Objects foreach cmd {array append lappend trace eval} { - ::xotcl::Object insttclcmd $cmd + ::xotcl::Object instforward $cmd -objscope } +::xotcl::Object instproc tclcmd {t} { + set cmd [list [::xotcl::self] forward $t -objscope] + puts stderr "the method tclcmd is deprecated; use instead '$cmd'" + eval $cmd +} +::xotcl::Class instproc insttclcmd {t} { + set cmd [list [::xotcl::self] instforward $t -objscope] + puts stderr "the method tclcmd is deprecated; use instead '$cmd'" + eval $cmd +} ::xotcl::Object instproc self {} {return [::xotcl::self]} ::xotcl::Object instproc defaultmethod {} { Index: xotcl/generic/xotcl.c =================================================================== diff -u -r894d9fdf1f31a1e18c1942007edebd85ebc5ae59 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/generic/xotcl.c (.../xotcl.c) (revision 894d9fdf1f31a1e18c1942007edebd85ebc5ae59) +++ xotcl/generic/xotcl.c (.../xotcl.c) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -1,4 +1,4 @@ -/* $Id: xotcl.c,v 1.9 2004/07/01 10:39:34 neumann Exp $ +/* $Id: xotcl.c,v 1.10 2004/07/02 11:22:31 neumann Exp $ * * XOTcl - Extended OTcl * @@ -11,8 +11,7 @@ * * (b) University of Essen * Specification of Software Systems - * Altendorferstra�e 97-101 - * D-45143 Essen, Germany + * Altendorferstra�e 97-101 * D-45143 Essen, Germany * * Permission to use, copy, modify, distribute, and sell this * software and its documentation for any purpose is hereby granted @@ -112,8 +111,9 @@ typedef struct forwardCmdClientData { XOTcl_Object *obj; Tcl_Obj *cmdName; + int nr_args; Tcl_Obj *args; - int inscope; + int objscope; Tcl_Obj *prefix; int nr_subcommands; Tcl_Obj *subcommands; @@ -126,8 +126,10 @@ static int XOTclNextMethod(XOTclObject *obj, Tcl_Interp *in, XOTclClass *givenCl, char *givenMethod, int objc, Tcl_Obj *CONST objv[], int useCSObjs); +#if defined(TCLCMD) static int XOTclOEvalMethod(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj * CONST objv[]); +#endif static int XOTclForwardMethod(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj * CONST objv[]); static int callDestroyMethod(ClientData cd, Tcl_Interp *in, XOTclObject *obj, int flags); @@ -687,8 +689,8 @@ */ -Tcl_Obj* -NameInNamespace(Tcl_Interp *in, char *name, Tcl_Namespace *ns) { +static Tcl_Obj* +NameInNamespaceObj(Tcl_Interp *in, char *name, Tcl_Namespace *ns) { Tcl_Obj *objName; int len; char *p; @@ -698,7 +700,7 @@ objName = Tcl_NewStringObj(ns->fullName,-1); len = Tcl_GetCharLength(objName); p = ObjStr(objName); - if (len == 2 && p[1] == ':') { + if (len == 2 && p[0] == ':' && p[1] == ':') { } else { Tcl_AppendToObj(objName,"::",2); } @@ -726,7 +728,7 @@ ov[0] = RUNTIME_STATE(in)->theClass->object.cmdName; ov[1] = XOTclGlobalObjects[__UNKNOWN]; if (*objName != ':') { - ov[2] = NameInNamespace(in,objName,Tcl_GetCurrentNamespace(in)); + ov[2] = NameInNamespaceObj(in,objName,Tcl_GetCurrentNamespace(in)); } else { ov[2] = objPtr; } @@ -3760,8 +3762,12 @@ objv[0] ); */ - if (isTclProc || (Tcl_Command_objProc(cmd) == XOTclObjDispatch) || - (Tcl_Command_objProc(cmd) == XOTclOEvalMethod) ) { + if (isTclProc || (Tcl_Command_objProc(cmd) == XOTclObjDispatch) + || (Tcl_Command_objProc(cmd) == XOTclForwardMethod) +#if defined(TCLCMD) + || (Tcl_Command_objProc(cmd) == XOTclOEvalMethod) +#endif + ) { /* push the xotcl info */ if ((CallStackPush(in, obj, cl, cmd, objc,objv, frameType)) == TCL_OK) callStackPushed = 1; @@ -3907,7 +3913,10 @@ int xotclCall = 0; if (cp) { - if (Tcl_Command_objProc(cmd) == XOTclOEvalMethod || + if ( +#if defined(TCLCMD) + Tcl_Command_objProc(cmd) == XOTclOEvalMethod || +#endif Tcl_Command_objProc(cmd) == XOTclForwardMethod) { /*fprintf(stderr,"calling oeval obj=%p %s\n", obj, ObjStr(obj->cmdName));*/ @@ -4429,8 +4438,8 @@ Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj("-default",-1)); Tcl_ListObjAppendElement(in, list, tcd->subcommands); } - if (tcd->inscope) { - Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj("-inscope",-1)); + if (tcd->objscope) { + Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj("-objscope",-1)); } Tcl_ListObjAppendElement(in, list, tcd->cmdName); if (tcd->args) { @@ -5675,7 +5684,6 @@ XOTclObject *obj = (XOTclObject*)cl; memset(cl, 0, sizeof(XOTclClass)); - MEM_COUNT_ALLOC("XOTclObject/XOTclClass",cl); /* fprintf(stderr, " +++ CLS alloc: %s\n", name); @@ -6981,7 +6989,7 @@ return result; } - +#if defined(TCLCMD) static int XOTclOEvalMethod(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj * CONST objv[]) { tclCmdClientData *tcd = (tclCmdClientData *)cd; @@ -7009,26 +7017,23 @@ FREE_TCL_OBJS_ON_STACK(ov); return result; } +#endif static int XOTclForwardMethod(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj * CONST objv[]) { forwardCmdClientData *tcd = (forwardCmdClientData *)cd; XOTcl_FrameDecls; - int result, j, inputarg=1, outputarg=0, clientargs=0; + int result, j, inputarg=1, outputarg=0; if (!tcd || !tcd->obj) return XOTclObjErrType(in, objv[0], "Object"); - if (tcd->args) { - Tcl_ListObjLength(in, tcd->args, &clientargs); - } - { - DEFINE_NEW_TCL_OBJS_ON_STACK(objc + clientargs + 3, OV); + DEFINE_NEW_TCL_OBJS_ON_STACK(objc + tcd->nr_args + 3, OV); Tcl_Obj **ov=&OV[1], *freeList=NULL; - XOTclCallStackContent *top = RUNTIME_STATE(in)->cs.top; /* it is a c-method; establish a value for the currentFramePtr */ - top->currentFramePtr = (Tcl_CallFrame *) Tcl_Interp_varFramePtr(in); - + RUNTIME_STATE(in)->cs.top->currentFramePtr = + (Tcl_CallFrame *) Tcl_Interp_varFramePtr(in); + #if 0 fprintf(stderr,"command %s (%p) objc=%d, subcommand=%d, args=%p, nrargs\n", ObjStr(objv[0]), tcd, objc, @@ -7093,7 +7098,6 @@ fprintf(stderr, "objc=%d, tcd->nr_subcommands=%d size=%d\n", objc, tcd->nr_subcommands, objc+ 2 );*/ - if (objc-inputarg>0) { /*fprintf(stderr, " copying remaining %d args starting at [%d]\n", objc-inputarg, outputarg);*/ @@ -7118,11 +7122,12 @@ } #endif - if (tcd->inscope) { + if (tcd->objscope) { XOTcl_PushFrame(in, tcd->obj); } - if (GetXOTclObjectFromObj(in, tcd->cmdName, (void*)&cd) == TCL_OK) { + if (tcd->cmdName->typePtr == &XOTclObjectType + && GetXOTclObjectFromObj(in, tcd->cmdName, (void*)&cd) == TCL_OK) { /*fprintf(stderr, "XOTcl object %s, objc=%d\n", ObjStr(tcd->cmdName),objc);*/ result = ObjDispatch(cd, in, objc, ov, 0); } else { @@ -7131,7 +7136,7 @@ result = Tcl_EvalObjv(in, objc, ov, 0); } - if (tcd->inscope) { + if (tcd->objscope) { XOTcl_PopFrame(in, tcd->obj); } @@ -7819,7 +7824,7 @@ Tcl_Namespace *ns = csc ? csc->currentFramePtr->nsPtr : NULL; /*XOTclCallStackDump(in);*/ - tmpName = NameInNamespace(in,objName,ns); + tmpName = NameInNamespaceObj(in,objName,ns); objName = ObjStr(tmpName); /*fprintf(stderr," **** name could be '%s' csc = %p\n", objName, csc);*/ @@ -8484,6 +8489,7 @@ return TCL_OK; } +#if defined(TCLCMD) static void tclCmdDeleteProc(ClientData cd) { tclCmdClientData *tcd = (tclCmdClientData *)cd; DECR_REF_COUNT(tcd->cmdName); @@ -8522,7 +8528,7 @@ name = ObjStr(objv[1]); if (*name != ':') { - cmdObj = NameInNamespace(in, name, NULL); + cmdObj = NameInNamespaceObj(in, name, NULL); } else { cmdObj = objv[1]; } @@ -8539,6 +8545,7 @@ (ClientData)tcd, tclCmdDeleteProc); return TCL_OK; } +#endif static void forwardCmdDeleteProc(ClientData cd) { forwardCmdClientData *tcd = (forwardCmdClientData *)cd; @@ -8560,10 +8567,11 @@ tcd = NEW(forwardCmdClientData); tcd->cmdName = 0; tcd->args = 0; - tcd->nr_subcommands = 0; + tcd->nr_args = 0; tcd->subcommands = 0; + tcd->nr_subcommands = 0; tcd->prefix = 0; - tcd->inscope = 0; + tcd->objscope = 0; for (i=2; iprefix = objv[i+1]; INCR_REF_COUNT(tcd->prefix); i++; - } else if (!strcmp(ObjStr(objv[i]),"-inscope")) { - tcd->inscope = 1; + } else if (!strcmp(ObjStr(objv[i]),"-objscope")) { + tcd->objscope = 1; } else { break; } @@ -8590,17 +8598,30 @@ tcd->cmdName = objv[i]; } else if (tcd->args == 0) { tcd->args = Tcl_NewListObj(1, &objv[i]); + tcd->nr_args++; INCR_REF_COUNT(tcd->args); } else { Tcl_ListObjAppendElement(in, tcd->args, objv[i]); + tcd->nr_args++; } } if (!tcd->cmdName) { - rc = TCL_ERROR; - } else { - INCR_REF_COUNT(tcd->cmdName); + tcd->cmdName = objv[1]; } + if (tcd->objscope) { + /* when we evaluating objscope, and define ... + o forward append -objscope append + a call to + o append ... + would lead to a recursive call; so we add the current namespace + */ + char * name = ObjStr(tcd->cmdName); + if (*name != ':') { + tcd->cmdName = NameInNamespaceObj(in, name, NULL); + } + } + INCR_REF_COUNT(tcd->cmdName); if (rc == TCL_OK) { *tcdp = tcd; @@ -8632,7 +8653,7 @@ } else { forward_argc_error: return XOTclObjErrArgCnt(in, cl->object.cmdName, - "instforward method obj ?args? ?-default name? ?-inscope? ?-methodprefix string?"); + "instforward method ?target? ?-default name? ?-objscope? ?-methodprefix string? ?args?"); } } @@ -8657,7 +8678,7 @@ } else { forward_argc_error: return XOTclObjErrArgCnt(in, obj->cmdName, - "forward method obj ?args? ?-default name? ?-inscope? ?-methodprefix string?"); + "forward method ?target? ?-default name? ?-objscope? ?-methodprefix string? ?args?"); } } @@ -9843,7 +9864,9 @@ XOTclAddIMethod(in, (XOTcl_Class*) theobj, "procsearch", (Tcl_ObjCmdProc*)XOTclOProcSearchMethod, 0, 0); XOTclAddIMethod(in, (XOTcl_Class*) theobj, "requireNamespace", (Tcl_ObjCmdProc*)XOTclORequireNamespaceMethod, 0, 0); XOTclAddIMethod(in, (XOTcl_Class*) theobj, "set", (Tcl_ObjCmdProc*)XOTclOSetMethod, 0, 0); +#if defined(TCLCMD) XOTclAddIMethod(in, (XOTcl_Class*) theobj, "tclcmd", (Tcl_ObjCmdProc*)XOTclCTclCmdMethod, 0, 0); +#endif XOTclAddIMethod(in, (XOTcl_Class*) theobj, "forward", (Tcl_ObjCmdProc*)XOTclCForwardMethod, 0, 0); XOTclAddIMethod(in, (XOTcl_Class*) theobj, "unset", XOTclOUnsetMethod, 0, 0); XOTclAddIMethod(in, (XOTcl_Class*) theobj, "uplevel", XOTclOUplevelMethod, 0,0); @@ -9865,7 +9888,9 @@ XOTclAddIMethod(in, (XOTcl_Class*) thecls, "instmixinguard", (Tcl_ObjCmdProc*)XOTclCInstMixinGuardMethod, 0, 0); XOTclAddIMethod(in, (XOTcl_Class*) thecls, "instparametercmd", (Tcl_ObjCmdProc*)XOTclCInstParameterCmdMethod, 0, 0); XOTclAddIMethod(in, (XOTcl_Class*) thecls, "instproc", (Tcl_ObjCmdProc*)XOTclCInstProcMethod, 0, 0); +#if defined(TCLCMD) XOTclAddIMethod(in, (XOTcl_Class*) thecls, "insttclcmd", (Tcl_ObjCmdProc*)XOTclCInstTclCmdMethod, 0, 0); +#endif XOTclAddIMethod(in, (XOTcl_Class*) thecls, "instforward", (Tcl_ObjCmdProc*)XOTclCInstForwardMethod, 0, 0); XOTclAddIMethod(in, (XOTcl_Class*) thecls, "parameter", (Tcl_ObjCmdProc*)XOTclCParameterMethod, 0, 0); Index: xotcl/library/store/XOTclGdbm/Makefile =================================================================== diff -u -r894d9fdf1f31a1e18c1942007edebd85ebc5ae59 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/library/store/XOTclGdbm/Makefile (.../Makefile) (revision 894d9fdf1f31a1e18c1942007edebd85ebc5ae59) +++ xotcl/library/store/XOTclGdbm/Makefile (.../Makefile) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -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.9 2004/07/01 10:39:34 neumann Exp $ +# RCS: @(#) $Id: Makefile,v 1.10 2004/07/02 11:22:31 neumann Exp $ #======================================================================== # Add additional lines to handle any additional AC_SUBST cases that Index: xotcl/library/store/XOTclSdbm/Makefile =================================================================== diff -u -r894d9fdf1f31a1e18c1942007edebd85ebc5ae59 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/library/store/XOTclSdbm/Makefile (.../Makefile) (revision 894d9fdf1f31a1e18c1942007edebd85ebc5ae59) +++ xotcl/library/store/XOTclSdbm/Makefile (.../Makefile) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -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.9 2004/07/01 10:39:34 neumann Exp $ +# RCS: @(#) $Id: Makefile,v 1.10 2004/07/02 11:22:31 neumann Exp $ #======================================================================== # Add additional lines to handle any additional AC_SUBST cases that Index: xotcl/library/store/pkgIndex-subdir.add =================================================================== diff -u -rf7894d9be99a8da3a04218abcdb9bd46b6d625c8 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/library/store/pkgIndex-subdir.add (.../pkgIndex-subdir.add) (revision f7894d9be99a8da3a04218abcdb9bd46b6d625c8) +++ xotcl/library/store/pkgIndex-subdir.add (.../pkgIndex-subdir.add) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -1,10 +1,10 @@ -set __dir__ $dir +set __store_dir__ $dir foreach index [glob -nocomplain [file join $dir * pkgIndex.tcl]] { set dir [file dirname $index] #puts subdir=$dir,index=$index source $index } -set dir $__dir__ -if {[info exists __dir]} {unset __dir__} +set dir $__store_dir__ +unset __store_dir__ Index: xotcl/library/store/pkgIndex.tcl =================================================================== diff -u -rf7894d9be99a8da3a04218abcdb9bd46b6d625c8 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/library/store/pkgIndex.tcl (.../pkgIndex.tcl) (revision f7894d9be99a8da3a04218abcdb9bd46b6d625c8) +++ xotcl/library/store/pkgIndex.tcl (.../pkgIndex.tcl) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -16,13 +16,15 @@ package ifneeded xotcl::store::tclgdbm 0.84 [list source [file join $dir TclGdbmStorage.xotcl]] package ifneeded xotcl::store::textfile 0.84 [list source [file join $dir TextFileStorage.xotcl]] -set __dir__ $dir +set __store_dir__ $dir foreach index [glob -nocomplain [file join $dir * pkgIndex.tcl]] { set dir [file dirname $index] #puts subdir=$dir,index=$index source $index } -set dir $__dir__ -if {[info exists __dir]} {unset __dir__} +set dir $__store_dir__ +unset __store_dir__ + + Index: xotcl/library/xml/TclExpat-1.1/Makefile =================================================================== diff -u -r894d9fdf1f31a1e18c1942007edebd85ebc5ae59 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/library/xml/TclExpat-1.1/Makefile (.../Makefile) (revision 894d9fdf1f31a1e18c1942007edebd85ebc5ae59) +++ xotcl/library/xml/TclExpat-1.1/Makefile (.../Makefile) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -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.9 2004/07/01 10:39:34 neumann Exp $ +# RCS: @(#) $Id: Makefile,v 1.10 2004/07/02 11:22:31 neumann Exp $ #======================================================================== # Add additional lines to handle any additional AC_SUBST cases that Index: xotcl/tests/speedtest.xotcl =================================================================== diff -u -rf7894d9be99a8da3a04218abcdb9bd46b6d625c8 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/tests/speedtest.xotcl (.../speedtest.xotcl) (revision f7894d9be99a8da3a04218abcdb9bd46b6d625c8) +++ xotcl/tests/speedtest.xotcl (.../speedtest.xotcl) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -1,5 +1,5 @@ #memory trace on -# $Id: speedtest.xotcl,v 1.1 2004/05/23 22:50:39 neumann Exp $ +# $Id: speedtest.xotcl,v 1.2 2004/07/02 11:22:31 neumann Exp $ package require XOTcl namespace import -force xotcl::* lappend auto_path [file dirname [info script]]/.. @@ -325,59 +325,72 @@ ###### insttclcmd tests set cnt 10000 -Test new -msg {call insttclcmd (append) and check created variable} \ +#Test new -msg {call insttclcmd (append) and check created variable} \ -pre {Object o} \ -cmd {o append X 1; o exists X} -expected 1 \ -post {o destroy} -Test new -msg {call tclcmd (regexep) and check created variable} \ +#Test new -msg {call tclcmd (regexep) and check created variable} \ -pre {Object o; o tclcmd regexp} \ -cmd {o regexp (a) a _ x; o exists x} -expected 1 -count $cnt \ -post {o destroy} +Test new -msg {call forwarder for (append) and check created variable} \ + -pre {Object o; o forward append -objscope} \ + -cmd {o append X 1; o exists X} -expected 1 \ + -post {o destroy} +Test new -msg {call forwarder (regexep) and check created variable} \ + -pre {Object o; o forward regexp -objscope} \ + -cmd {o regexp (a) a _ x; o exists x} -expected 1 -count $cnt \ + -post {o destroy} +Test new -msg {call forwarder to another obj} \ + -pre {Object o; Object t; o forward set t set; t set x 100} \ + -cmd {o set x} -expected 100 -count $cnt \ + -post {o destroy} + set cnt 100000 Test new -msg {call handcoded incr} \ -pre {Class C; C create o; o set x 1} \ -cmd {o incr x 77} -expected 78 -count $cnt \ -post {o destroy} -Test new -msg {call incr via insttclcmd} \ - -pre {Class C; C insttclcmd ::incr; C create o; o set x 1} \ +Test new -msg {call incr via instforward} \ + -pre {Class C; C instforward ::incr -objscope; C create o; o set x 1} \ -cmd {o incr x 77} -expected 78 -count $cnt \ -post {o destroy} -Test new -msg {call incr via tclcmd} \ - -pre {Class C; C create o; o tclcmd ::incr; o set x 1} \ +Test new -msg {call incr via forward} \ + -pre {Class C; C create o; o forward ::incr -objscope; o set x 1} \ -cmd {o incr x 77} -expected 78 -count $cnt \ -post {o destroy} set cnt 10000 -Test new -msg {call obj with namespace via tclcmd} \ - -pre {Object n; Object n::x; Object o; o tclcmd ::n::x} \ +Test new -msg {call obj with namespace via forward} \ + -pre {Object n; Object n::x; Object o -forward ::n::x} \ -cmd {o x self} -expected ::n::x -count $cnt \ -post {o destroy} -Test new -msg {call obj with namespace via insttclcmd} \ - -pre {Object n; Object n::x; Class C; C create o; C insttclcmd ::n::x} \ +Test new -msg {call obj with namespace via instforward} \ + -pre {Object n; Object n::x; Class C; C create o; C instforward ::n::x} \ -cmd {o x self} -expected ::n::x -count $cnt \ -post {o destroy} -Test new -msg {call obj with namespace via insttclcmd and mixinclass} \ - -pre {Object n; Object n::x; Class M; M insttclcmd ::n::x; +Test new -msg {call obj with namespace via instforward and mixinclass} \ + -pre {Object n; Object n::x; Class M -instforward ::n::x; Class C -instmixin M; C create o } \ -cmd {o x self} -expected ::n::x -count $cnt \ -post {o destroy} -Test new -msg {call obj with namespace via insttclcmd and next from proc} \ +Test new -msg {call obj with namespace via instforward and next from proc} \ -pre { Object n; Object n::x; - Class C; C insttclcmd ::n::x; + Class C -instforward ::n::x; C create o -proc x args {next} } \ -cmd {o x self} -expected ::n::x -count $cnt \ -post {o destroy} -Test new -msg {call obj with namespace via insttclcmd and next from instproc} \ +Test new -msg {call obj with namespace via instforward and next from instproc} \ -pre { Object n; Object n::x; - Class C -insttclcmd ::n::x; + Class C -instforward ::n::x; Class D -superclass C -instproc x args {next}; D create o } \ -cmd {o x self} -expected ::n::x -count $cnt \ -post {o destroy} -Test new -msg {call obj with namespace via mixin and insttclcmd and next} \ +Test new -msg {call obj with namespace via mixin and instforward and next} \ -pre {Object n; Object n::x; - Class M -insttclcmd ::n::x; + Class M -instforward ::n::x; Class N -superclass M -instproc x args {next}; Class C -instmixin N; C create o} \ -cmd {o x self} -expected ::n::x -count $cnt \ Index: xotcl/tests/testx.xotcl =================================================================== diff -u -r894d9fdf1f31a1e18c1942007edebd85ebc5ae59 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/tests/testx.xotcl (.../testx.xotcl) (revision 894d9fdf1f31a1e18c1942007edebd85ebc5ae59) +++ xotcl/tests/testx.xotcl (.../testx.xotcl) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -1,4 +1,4 @@ -#$Id: testx.xotcl,v 1.8 2004/07/01 10:39:34 neumann Exp $ +#$Id: testx.xotcl,v 1.9 2004/07/02 11:22:31 neumann Exp $ package require XOTcl namespace import -force xotcl::* @@ -2858,14 +2858,14 @@ ::errorCheck [lsort [b info methods]] "__next abstract append array autoname check class cleanup configure copy defaultmethod destroy eval exists extractConfigureArg f filter filterappend filterguard filtersearch forward hasclass incr info infoTraceFilter init instvar invar isclass ismetaclass ismixin isobject istype lappend mixin mixinappend mixinguard move myProc myProc2 myProcMix1 myProcMix2 noinit objproc parametercmd proc procsearch recreate requireNamespace self set setFilter tclcmd trace unset uplevel upvar volatile vwait" "[self]: b info methods" - ::errorCheck [lsort [b info methods -nocmds]] "abstract copy defaultmethod extractConfigureArg f filterappend hasclass infoTraceFilter init mixinappend move myProc myProc2 myProcMix1 myProcMix2 objproc recreate self setFilter" "[self]: b info methods -nocmds" + ::errorCheck [lsort [b info methods -nocmds]] "abstract copy defaultmethod extractConfigureArg f filterappend hasclass infoTraceFilter init mixinappend move myProc myProc2 myProcMix1 myProcMix2 objproc recreate self setFilter tclcmd" "[self]: b info methods -nocmds" - ::errorCheck [lsort [b info methods -noprocs]] "__next append array autoname check class cleanup configure destroy eval exists filter filterguard filtersearch forward incr info instvar invar isclass ismetaclass ismixin isobject istype lappend mixin mixinguard noinit parametercmd proc procsearch requireNamespace set tclcmd trace unset uplevel upvar volatile vwait" "[self]: b info methods -noprocs" - ::errorCheck [lsort [b info methods -nocmds -nomixins]] "abstract copy defaultmethod extractConfigureArg f filterappend hasclass infoTraceFilter init mixinappend move myProc myProc2 objproc self setFilter" "[self]: b info methods -nocmds -nomixins" + ::errorCheck [lsort [b info methods -noprocs]] "__next append array autoname check class cleanup configure destroy eval exists filter filterguard filtersearch forward incr info instvar invar isclass ismetaclass ismixin isobject istype lappend mixin mixinguard noinit parametercmd proc procsearch requireNamespace set trace unset uplevel upvar volatile vwait" "[self]: b info methods -noprocs" + ::errorCheck [lsort [b info methods -nocmds -nomixins]] "abstract copy defaultmethod extractConfigureArg f filterappend hasclass infoTraceFilter init mixinappend move myProc myProc2 objproc self setFilter tclcmd" "[self]: b info methods -nocmds -nomixins" ::errorCheck [b info methods -nocmds -noprocs] "" "[self]: b info methods -nocmds -noprocs" - ::errorCheck [lsort [B info methods -nocmds]] "abstract copy defaultmethod extractConfigureArg f filterappend hasclass infoTraceFilter init instfilterappend instmixinappend mixinappend move recreate self setFilter" "[self]: B info methods -nocmds" + ::errorCheck [lsort [B info methods -nocmds]] "abstract copy defaultmethod extractConfigureArg f filterappend hasclass infoTraceFilter init instfilterappend instmixinappend insttclcmd mixinappend move recreate self setFilter tclcmd" "[self]: B info methods -nocmds" namespace eval a { proc o args {return o} @@ -3042,9 +3042,9 @@ ::errorCheck [e1 parametercmd y] "" "parametercmd 1" ::errorCheck [e1 y 3] 3 "parametercmd 2" ::errorCheck [e1 y] 3 "parametercmd 3" - ::errorCheck [e1 tclcmd regexp] "" "tclcmd 1" - ::errorCheck [e1 regexp (y) xyz _ X] "1" "tclcmd 2" - ::errorCheck [e1 exists X] "1" "tclcmd 3" + ::errorCheck [e1 forward regexp -objscope] "" "forward 1" + ::errorCheck [e1 regexp (y) xyz _ X] "1" "forward 2" + ::errorCheck [e1 exists X] "1" "forward 3" ::errorCheck [e1 q] q "self proc" ::errorCheck [E info commands] p "class commands" Index: xotcl/unix/pkgIndex.unix =================================================================== diff -u -rf7894d9be99a8da3a04218abcdb9bd46b6d625c8 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/unix/pkgIndex.unix (.../pkgIndex.unix) (revision f7894d9be99a8da3a04218abcdb9bd46b6d625c8) +++ xotcl/unix/pkgIndex.unix (.../pkgIndex.unix) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -1,4 +1,4 @@ package ifneeded XOTcl 1.2.1 [list load \ - [file join $dir .. libxotcl1.2.1.so] XOTcl] + [file join $dir libxotcl1.2.1.so] XOTcl] Index: xotcl/unix/pkgIndex.unix.in =================================================================== diff -u -rf7894d9be99a8da3a04218abcdb9bd46b6d625c8 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/unix/pkgIndex.unix.in (.../pkgIndex.unix.in) (revision f7894d9be99a8da3a04218abcdb9bd46b6d625c8) +++ xotcl/unix/pkgIndex.unix.in (.../pkgIndex.unix.in) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -1,4 +1,4 @@ package ifneeded XOTcl @PACKAGE_VERSION@ [list load \ - [file join $dir .. @PKG_LIB_FILE@] XOTcl] + [file join $dir @PKG_LIB_FILE@] XOTcl] Index: xotcl/xotclConfig.sh =================================================================== diff -u -r894d9fdf1f31a1e18c1942007edebd85ebc5ae59 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/xotclConfig.sh (.../xotclConfig.sh) (revision 894d9fdf1f31a1e18c1942007edebd85ebc5ae59) +++ xotcl/xotclConfig.sh (.../xotclConfig.sh) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -54,3 +54,6 @@ XOTCL_SHARED_LIB_SUFFIX=1.2.1.so XOTCL_UNSHARED_LIB_SUFFIX=1.2.1.a +# the shell in whose installation dirs the xotcl package is installed +XOTCL_COMPATIBLE_TCLSH=/home/neumann/tcl8.4.5/unix/tclsh + Index: xotcl/xotclConfig.sh.in =================================================================== diff -u -rf7894d9be99a8da3a04218abcdb9bd46b6d625c8 -r9722a51911e1502444c173306c8c88f7f3888989 --- xotcl/xotclConfig.sh.in (.../xotclConfig.sh.in) (revision f7894d9be99a8da3a04218abcdb9bd46b6d625c8) +++ xotcl/xotclConfig.sh.in (.../xotclConfig.sh.in) (revision 9722a51911e1502444c173306c8c88f7f3888989) @@ -54,3 +54,6 @@ XOTCL_SHARED_LIB_SUFFIX=@SHARED_LIB_SUFFIX@ XOTCL_UNSHARED_LIB_SUFFIX=@UNSHARED_LIB_SUFFIX@ +# the shell in whose installation dirs the xotcl package is installed +XOTCL_COMPATIBLE_TCLSH=@XOTCL_COMPATIBLE_TCLSH@ +