Index: ChangeLog =================================================================== diff -u -r2111020b49da8ce57758e51accf0b6073037f0d2 -r4eafc074cdca60b0089c2a950954c83d519b91d3 --- ChangeLog (.../ChangeLog) (revision 2111020b49da8ce57758e51accf0b6073037f0d2) +++ ChangeLog (.../ChangeLog) (revision 4eafc074cdca60b0089c2a950954c83d519b91d3) @@ -1,5 +1,38 @@ +copyhandler: we cannot use "set" method, since the object system might to provide it Method ::xotcl::Object->__exitHandler became ::xotcl::__exitHandler +testx.xotcl: handle new command setvalues in filters +configure returns now instead of the posision the list of arguments preceding dash-arguments +TODO document + - setvalues + - ::xotcl::is and ::xotcl::relation work independent from methods (e.g. even on ::oo::object) + - document, what happens with instances, if a Class is turned into an object in respect with ::oo + +type checker todo: + colorchecker in testx deactivated: drop feature or implement + introsepction & error messages return now -x:type=required instead of -x:required + +Class info info: + # new (must be documented): + check, hasNamespace, instargs, instmixinguard, + instnonposargs, is, mixinguard, nonposargs, slotobjects, slots + # lost (need to be implemented as separate methods) + mixinof, instmixinof + + +incompatible change: +====== +Class O -parameter { + {a -default 0} + {b -default {[cmd 3 4]}} c d + {e -default 3} + {Self -default [self]} +} +Class Meta -superclass Class +Meta C -superclass O -parameter {a {b -default ""} {c -default 1}} +C c1 ;# c1 has no no default value for "a", before it had +====== + 2009-06-14 - fixed potential access to deleted command list item in FilterSearchAgain() Index: doc/index.html =================================================================== diff -u -r2111020b49da8ce57758e51accf0b6073037f0d2 -r4eafc074cdca60b0089c2a950954c83d519b91d3 --- doc/index.html (.../index.html) (revision 2111020b49da8ce57758e51accf0b6073037f0d2) +++ doc/index.html (.../index.html) (revision 4eafc074cdca60b0089c2a950954c83d519b91d3) @@ -23,7 +23,7 @@

Index: generic/predefined.h =================================================================== diff -u -r2111020b49da8ce57758e51accf0b6073037f0d2 -r4eafc074cdca60b0089c2a950954c83d519b91d3 --- generic/predefined.h (.../predefined.h) (revision 2111020b49da8ce57758e51accf0b6073037f0d2) +++ generic/predefined.h (.../predefined.h) (revision 4eafc074cdca60b0089c2a950954c83d519b91d3) @@ -5,6 +5,8 @@ "puts stderr \"::xotcl::setrelation is deprecated, use '::xotcl::relation $args' instead\"\n" "uplevel ::xotcl::relation $args}\n" "if {[info command ::oo::object] ne \"\"} {\n" +"::xotcl::alias ::oo::object destroy ::xotcl::cmd::Object::destroy\n" +"::xotcl::alias ::oo::class instdestroy ::xotcl::cmd::Class::instdestroy\n" "::xotcl::alias ::oo::class alloc ::xotcl::cmd::Class::alloc\n" "::oo::class alloc ::xotcl::Object\n" "::oo::class alloc ::xotcl::Class\n" @@ -200,6 +202,7 @@ "::xotcl::Attribute instproc mk_type_checker {} {\n" "set __initcmd \"\"\n" "if {[::xotcl::my exists type]} {\n" +"puts stderr \"mktypechecker, type=$type\"\n" "::xotcl::my instvar type name\n" "if {[::xotcl::Object isclass $type]} {\n" "set predicate [subst -nocommands {\n" Index: generic/predefined.xotcl =================================================================== diff -u -r2111020b49da8ce57758e51accf0b6073037f0d2 -r4eafc074cdca60b0089c2a950954c83d519b91d3 --- generic/predefined.xotcl (.../predefined.xotcl) (revision 2111020b49da8ce57758e51accf0b6073037f0d2) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision 4eafc074cdca60b0089c2a950954c83d519b91d3) @@ -5,9 +5,27 @@ uplevel ::xotcl::relation $args } if {[info command ::oo::object] ne ""} { + # When the system shuts down, destroy is called for every + # available object. When ::xotcl::Object and ::xotcl::Class are + # destroyed, there would be no means to delete other objects, when + # "destroy" and "instdestroy" are only defined on these + # objects. So, we register these on ::oo::object and ::oo::class + # for the time being, since these two classes are deleted last. + ::xotcl::alias ::oo::object destroy ::xotcl::cmd::Object::destroy + ::xotcl::alias ::oo::class instdestroy ::xotcl::cmd::Class::instdestroy + # + # Perform the basic setup of XOTcl. First, let us allocate objects + # and classed via the method named "alloc". + # ::xotcl::alias ::oo::class alloc ::xotcl::cmd::Class::alloc + # + # Create the basic Classes of XOTcl ... + # ::oo::class alloc ::xotcl::Object ::oo::class alloc ::xotcl::Class + # + # ... and define the superclass and class relations on these. + # ::xotcl::relation ::xotcl::Class superclass {::oo::class ::xotcl::Object} ::xotcl::relation ::xotcl::Object class ::xotcl::Class ::xotcl::relation ::xotcl::Class class ::xotcl::Class @@ -632,7 +650,6 @@ } ::xotcl::Object::CopyHandler instproc copyNSVarsAndCmds {orig dest} { - #puts stderr "copyNSVarsAndCmds $orig $dest" ::xotcl::namespace_copyvars $orig $dest ::xotcl::namespace_copycmds $orig $dest } Index: generic/xotcl.c =================================================================== diff -u -r2111020b49da8ce57758e51accf0b6073037f0d2 -r4eafc074cdca60b0089c2a950954c83d519b91d3 --- generic/xotcl.c (.../xotcl.c) (revision 2111020b49da8ce57758e51accf0b6073037f0d2) +++ generic/xotcl.c (.../xotcl.c) (revision 4eafc074cdca60b0089c2a950954c83d519b91d3) @@ -5967,8 +5967,8 @@ static Tcl_Obj * NonposArgsFormat(Tcl_Interp *interp, Tcl_Obj *nonposArgsData) { - int r1, npalistc, npac, checkc, i, j, first; - Tcl_Obj **npalistv, **npav, **checkv, + int r1, npalistc, npac, checkc, checkArgc, i, j, first; + Tcl_Obj **npalistv, **npav, **checkv, **checkArgv, *list = Tcl_NewListObj(0, NULL), *innerlist, *nameStringObj; @@ -5993,7 +5993,8 @@ } else { Tcl_AppendToObj(nameStringObj,",", 1); } - Tcl_AppendToObj(nameStringObj, ObjStr(checkv[j]), -1); + r1 = Tcl_ListObjGetElements(interp, checkv[j], &checkArgc, &checkArgv); + Tcl_AppendToObj(nameStringObj, ObjStr(checkArgv[0]), -1); } } } @@ -6047,9 +6048,14 @@ } static Tcl_Obj* -nonposargType(char *start, int len) { - Tcl_Obj *result = Tcl_NewStringObj("type=", 5); - Tcl_AppendToObj(result, start, len); +nonposargType(Tcl_Interp *interp, char *start, int len) { + Tcl_Obj *result = Tcl_NewListObj(0, NULL); + Tcl_Obj *type = Tcl_NewStringObj(start, len); + Tcl_Obj *checker = Tcl_NewStringObj("type=", 5); + + Tcl_AppendToObj(checker, start, len); + Tcl_ListObjAppendElement(interp, result, type); + Tcl_ListObjAppendElement(interp, result, checker); /*fprintf(stderr, "nonposargType TYPE = '%s'\n", ObjStr(result));*/ return result; } @@ -6099,16 +6105,14 @@ int l; Tcl_Obj *list = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(interp, npaObj, Tcl_NewStringObj(arg+1, j-1)); Tcl_ListObjAppendElement(interp, npaObj, Tcl_NewStringObj(arg+1, j-1)); - start = j+1; while(start0 && isspace((int)arg[end-1]); end--); Tcl_ListObjAppendElement(interp, list, - nonposargType(arg+start, end-start)); + nonposargType(interp, arg+start, end-start)); l++; start = l; while (start0 && isspace((int)arg[end-1]); end--); Tcl_ListObjAppendElement(interp, list, - nonposargType(arg+start, end-start)); + nonposargType(interp, arg+start, end-start)); /* append the whole thing to the list */ Tcl_ListObjAppendElement(interp, npaObj, list); /* fprintf(stderr," appending list npa='%s'\n", ObjStr(npaObj));*/ @@ -10093,6 +10097,7 @@ if (value == NULL) { result = Tcl_ObjGetVar2(interp, name, NULL, flags); } else { + /*fprintf(stderr,"setvar in obj %s: name %s = %s\n",ObjStr(obj->cmdName),ObjStr(name),ObjStr(value));*/ result = Tcl_ObjSetVar2(interp, name, NULL, value, flags); } XOTcl_PopFrame(interp, obj); @@ -11608,8 +11613,6 @@ normalArgs = i-1; Tcl_ResetResult(interp); - /*fprintf(stderr, "setvalues oc=%d, i=%d\n",objc,i);*/ - for( ; i < objc; argc=nextArgc, argv=nextArgv, methodName=nextMethodName) { Tcl_ResetResult(interp); switch (isdasharg) { @@ -11677,6 +11680,7 @@ */ result = callMethod((ClientData) obj, interp, XOTclGlobalObjects[XOTE_SETVALUES], objc+1, objv+1, 0); + /* fprintf(stderr, "setvalues returned %d\n",result);*/ if (result != TCL_OK) { goto configure_exit; } @@ -12162,7 +12166,7 @@ XOTclObject *matchObject; Tcl_DString ds, *dsPtr = &ds; static CONST char *options[] = {"-closure", NULL}; - int withClosure; + int withClosure = 0; /* todo: test and use getModifieres everywhere */ modifiers = getModifiers(objc, 2, objv, options, &set); @@ -12183,7 +12187,8 @@ if (getMatchObject(interp, &pattern, &matchObject, dsPtr) == -1) { return TCL_OK; } - + + Tcl_ResetResult(interp); rc = listInstances(interp, cl, pattern, withClosure, matchObject); if (matchObject) { @@ -12531,7 +12536,6 @@ Tcl_DString ds, *dsPtr = &ds; char *pattern; static CONST char *options[] = {"-closure", NULL}; - enum options {closureIdx}; /* todo: test and use getModifieres everywhere */ modifiers = getModifiers(objc, 2, objv, options, &set); @@ -12546,13 +12550,13 @@ /* We have only one modifier, so it must be closure; if there would be multiple modifieres would have to check the resulting "set" */ withClosure = modifiers > 0; - pattern = args == 3 ? ObjStr(objv[3+modifiers]) : NULL; + pattern = args == 3 ? ObjStr(objv[objc-1]) : NULL; DSTRING_INIT(dsPtr); if (getMatchObject(interp, &pattern, &matchObject, dsPtr) == -1) { return TCL_OK; } - + if (withClosure) { XOTclClasses *saved = cl->order, *subclasses; cl->order = NULL; @@ -13709,19 +13713,24 @@ Tcl_HashEntry *hPtr; TclVarHashTable *varTable; int rc = TCL_OK; - XOTclObject *obj; + XOTclObject *obj, *destObj; char *destFullName; Tcl_Obj *destFullNameObj; TclCallFrame frame, *framePtr = &frame; Tcl_Obj *varNameObj = NULL; +#if 1 +#else Tcl_Obj *nobjv[4]; int nobjc; Tcl_Obj *setObj; +#endif if (objc != 3) return XOTclObjErrArgCnt(interp, objv[0], NULL, " "); ns = ObjFindNamespace(interp, objv[1]); + /*fprintf(stderr,"copyvars from %s to %s, ns=%p\n", ObjStr(objv[1]), ObjStr(objv[2]), ns);*/ + if (ns) { newNs = ObjFindNamespace(interp, objv[2]); if (!newNs) @@ -13749,11 +13758,16 @@ destFullName = ObjStr(destFullNameObj); } +#if 1 + destObj = XOTclpGetObject(interp, destFullName); +#else + /* TODO cleanup */ setObj= Tcl_NewStringObj("set", 3); INCR_REF_COUNT(setObj); nobjc = 4; nobjv[0] = destFullNameObj; nobjv[1] = setObj; +#endif /* copy all vars in the ns */ hPtr = varTable ? Tcl_FirstHashEntry(VarHashTable(varTable), &hSrch) : NULL; @@ -13769,9 +13783,12 @@ * be able to intercept the copying */ if (obj) { + /* + fprintf(stderr, "copy in obj %s var %s val '%s'\n",ObjStr(obj->cmdName),ObjStr(varNameObj), + ObjStr(valueOfVar(Tcl_Obj, varPtr, objPtr)));*/ #if 1 /* can't rely on "set", if there are multiple object systems */ - setInstVar(interp, obj, varNameObj, valueOfVar(Tcl_Obj, varPtr, objPtr)); + setInstVar(interp, destObj, varNameObj, valueOfVar(Tcl_Obj, varPtr, objPtr)); #else nobjv[2] = varNameObj; nobjv[3] = valueOfVar(Tcl_Obj, varPtr, objPtr); @@ -13798,7 +13815,7 @@ if (TclIsVarScalar(eltVar)) { if (obj) { #if 1 - XOTcl_ObjSetVar2((XOTcl_Object*)obj, interp, varNameObj, eltNameObj, valueOfVar(Tcl_Obj, eltVar, objPtr), 0); + XOTcl_ObjSetVar2((XOTcl_Object*)destObj, interp, varNameObj, eltNameObj, valueOfVar(Tcl_Obj, eltVar, objPtr), 0); #else Tcl_Obj *fullVarNameObj = Tcl_DuplicateObj(varNameObj); @@ -13829,7 +13846,10 @@ DECR_REF_COUNT(destFullNameObj); Tcl_PopCallFrame(interp); } +#if 1 +#else DECR_REF_COUNT(setObj); +#endif return rc; } @@ -14041,16 +14061,22 @@ (char *) NULL); } + /*fprintf(stderr,"InterpretNonpositionalArgs: setting defaults\n");*/ + /* setting variables to default values */ for (i=0; i < nonposArgsDefc; i++) { r1 = Tcl_ListObjGetElements(interp, nonposArgsDefv[i], &npac, &npav); + if (r1 == TCL_OK) { if (npac == 3) { Tcl_SetVar2Ex(interp, ObjStr(npav[0]), NULL, npav[2], 0); /* for unknown reasons, we can't use Tcl_ObjSetVar2 here in case the variable is referenced via eval (sample murr6) */ /* Tcl_ObjSetVar2(interp, npav[0], NULL, npav[2], 0); */ - } else if (npac == 2 && !strcmp(ObjStr(npav[1]), "switch")) { + } else if (npac == 2 && !strncmp(ObjStr(npav[1]), "{switch",7)) { + /* we could as well do yet another split to get the type from + the first element of the list*/ + /*fprintf(stderr,"setting default value for switch %s\n",ObjStr(npav[0]));*/ Tcl_SetVar2Ex(interp, ObjStr(npav[0]), NULL, Tcl_NewBooleanObj(0), 0); } } @@ -14063,6 +14089,8 @@ } } + /* fprintf(stderr,"InterpretNonpositionalArgs: setting values\n");*/ + /* setting specified variables */ for (i=0; i < argsc; i++) { @@ -14076,7 +14104,9 @@ i++; } if (isNonposArg(interp, argStr, nonposArgsDefc, nonposArgsDefv, &var,&type)) { - if (*type == 's' && !strcmp(type, "switch")) { + /* we could as well do yet another split to get the type from + the first element of the list*/ + if (*type == '{' && !strncmp(type, "{switch",7)) { int bool; Tcl_Obj *boolObj = Tcl_ObjGetVar2(interp, var, 0, 0); if (Tcl_GetBooleanFromObj(interp, boolObj, &bool) != TCL_OK) { @@ -14198,7 +14228,8 @@ } } invocation[0] = checkObj; - invocation[1] = checkv[j]; + /*invocation[1] = checkv[j];*/ + invocation[1] = checkArgv[1]; varPtr = TclVarTraceExists(interp, ObjStr(npav[0])); invocation[2] = npav[0]; ic = 3; @@ -14208,9 +14239,10 @@ } result = Tcl_EvalObjv(interp, ic, invocation, 0); /* - objPtr = Tcl_ConcatObj(ic, invocation); + {Tcl_Obj *objPtr = Tcl_ConcatObj(ic, invocation); fprintf(stderr,"eval on <%s>\n", ObjStr(objPtr)); result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT); + } */ if (result == TCL_OK && ic == 4) { result = Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp),&checkResult); @@ -14900,7 +14932,7 @@ }; methodDefinition definitions3[] = { {"type=required", XOTclCheckRequiredArgs}, - {"type=switch", XOTclCheckBooleanArgs}, + {"type=switch", XOTclCheckBooleanArgs}, /* for boolean and switch, we use the same checker */ {"type=boolean", XOTclCheckBooleanArgs} }; methodDefinition definitions4[] = { @@ -15040,27 +15072,6 @@ XOTclBytecodeInit(); #endif - /* - nonposArgsCl = PrimitiveCCreate(interp, - XOTclGlobalStrings[XOTE_NON_POS_ARGS_CL], - thecls); - XOTclAddIMethod(interp, (XOTcl_Class*) nonposArgsCl, - "required", - (Tcl_ObjCmdProc*) XOTclCheckRequiredArgs, 0, 0); - XOTclAddIMethod(interp, (XOTcl_Class*) nonposArgsCl, - "switch", - (Tcl_ObjCmdProc*) XOTclCheckBooleanArgs, 0, 0); - XOTclAddIMethod(interp, (XOTcl_Class*) nonposArgsCl, - "boolean", - (Tcl_ObjCmdProc*) XOTclCheckBooleanArgs, 0, 0); - PrimitiveOCreate(interp, XOTclGlobalStrings[XOTE_NON_POS_ARGS_OBJ], - nonposArgsCl); - paramCl = PrimitiveCCreate(interp, XOTclGlobalStrings[XOTE_PARAM_CL], thecls); - XOTclAddPMethod(interp, (XOTcl_Object*) paramObject, - XOTclGlobalStrings[XOTE_SEARCH_DEFAULTS], - (Tcl_ObjCmdProc*) ParameterSearchDefaultsMethod, 0, 0); - * set runtime version information in Tcl variable - */ Tcl_SetVar(interp, "::xotcl::version", XOTCLVERSION, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "::xotcl::patchlevel", XOTCLPATCHLEVEL, TCL_GLOBAL_ONLY); Index: generic/xotclDecls.h =================================================================== diff -u -r2111020b49da8ce57758e51accf0b6073037f0d2 -r4eafc074cdca60b0089c2a950954c83d519b91d3 --- generic/xotclDecls.h (.../xotclDecls.h) (revision 2111020b49da8ce57758e51accf0b6073037f0d2) +++ generic/xotclDecls.h (.../xotclDecls.h) (revision 4eafc074cdca60b0089c2a950954c83d519b91d3) @@ -25,154 +25,256 @@ * Exported function declarations: */ +#ifndef Xotcl_Init_TCL_DECLARED +#define Xotcl_Init_TCL_DECLARED /* 0 */ -EXTERN int Xotcl_Init _ANSI_ARGS_((Tcl_Interp * interp)); +EXTERN int Xotcl_Init (Tcl_Interp * interp); +#endif /* Slot 1 is reserved */ +#ifndef XOTclIsClass_TCL_DECLARED +#define XOTclIsClass_TCL_DECLARED /* 2 */ -EXTERN struct XOTcl_Class * XOTclIsClass _ANSI_ARGS_((Tcl_Interp * interp, - ClientData cd)); +EXTERN struct XOTcl_Class * XOTclIsClass (Tcl_Interp * interp, ClientData cd); +#endif /* Slot 3 is reserved */ +#ifndef XOTclGetObject_TCL_DECLARED +#define XOTclGetObject_TCL_DECLARED /* 4 */ -EXTERN struct XOTcl_Object * XOTclGetObject _ANSI_ARGS_((Tcl_Interp * interp, - char * name)); +EXTERN struct XOTcl_Object * XOTclGetObject (Tcl_Interp * interp, + char * name); +#endif +#ifndef XOTclGetClass_TCL_DECLARED +#define XOTclGetClass_TCL_DECLARED /* 5 */ -EXTERN struct XOTcl_Class * XOTclGetClass _ANSI_ARGS_((Tcl_Interp * interp, - char * name)); +EXTERN struct XOTcl_Class * XOTclGetClass (Tcl_Interp * interp, char * name); +#endif +#ifndef XOTclCreateObject_TCL_DECLARED +#define XOTclCreateObject_TCL_DECLARED /* 6 */ -EXTERN int XOTclCreateObject _ANSI_ARGS_((Tcl_Interp * interp, - Tcl_Obj * name, struct XOTcl_Class * cl)); +EXTERN int XOTclCreateObject (Tcl_Interp * interp, + Tcl_Obj * name, struct XOTcl_Class * cl); +#endif /* Slot 7 is reserved */ +#ifndef XOTclCreateClass_TCL_DECLARED +#define XOTclCreateClass_TCL_DECLARED /* 8 */ -EXTERN int XOTclCreateClass _ANSI_ARGS_((Tcl_Interp * interp, - Tcl_Obj * name, struct XOTcl_Class * cl)); +EXTERN int XOTclCreateClass (Tcl_Interp * interp, + Tcl_Obj * name, struct XOTcl_Class * cl); +#endif +#ifndef XOTclDeleteObject_TCL_DECLARED +#define XOTclDeleteObject_TCL_DECLARED /* 9 */ -EXTERN int XOTclDeleteObject _ANSI_ARGS_((Tcl_Interp * interp, - struct XOTcl_Object * obj)); +EXTERN int XOTclDeleteObject (Tcl_Interp * interp, + struct XOTcl_Object * obj); +#endif +#ifndef XOTclDeleteClass_TCL_DECLARED +#define XOTclDeleteClass_TCL_DECLARED /* 10 */ -EXTERN int XOTclDeleteClass _ANSI_ARGS_((Tcl_Interp * interp, - struct XOTcl_Class * cl)); +EXTERN int XOTclDeleteClass (Tcl_Interp * interp, + struct XOTcl_Class * cl); +#endif +#ifndef XOTclAddPMethod_TCL_DECLARED +#define XOTclAddPMethod_TCL_DECLARED /* 11 */ -EXTERN Tcl_Command XOTclAddPMethod _ANSI_ARGS_((Tcl_Interp * interp, - struct XOTcl_Object* obj, CONST char* nm, - Tcl_ObjCmdProc * proc, ClientData cd, - Tcl_CmdDeleteProc * dp)); +EXTERN Tcl_Command XOTclAddPMethod (Tcl_Interp * interp, + struct XOTcl_Object * obj, CONST char* nm, + Tcl_ObjCmdProc* proc, ClientData cd, + Tcl_CmdDeleteProc * dp); +#endif +#ifndef XOTclAddIMethod_TCL_DECLARED +#define XOTclAddIMethod_TCL_DECLARED /* 12 */ -EXTERN Tcl_Command XOTclAddIMethod _ANSI_ARGS_((Tcl_Interp * interp, - struct XOTcl_Class* cl, CONST char* nm, - Tcl_ObjCmdProc * proc, ClientData cd, - Tcl_CmdDeleteProc * dp)); +EXTERN Tcl_Command XOTclAddIMethod (Tcl_Interp * interp, + struct XOTcl_Class * cl, CONST char* nm, + Tcl_ObjCmdProc* proc, ClientData cd, + Tcl_CmdDeleteProc * dp); +#endif +#ifndef XOTclRemovePMethod_TCL_DECLARED +#define XOTclRemovePMethod_TCL_DECLARED /* 13 */ -EXTERN void XOTclRemovePMethod _ANSI_ARGS_((Tcl_Interp * interp, - struct XOTcl_Object * obj, char * nm)); +EXTERN void XOTclRemovePMethod (Tcl_Interp * interp, + struct XOTcl_Object * obj, char * nm); +#endif +#ifndef XOTclRemoveIMethod_TCL_DECLARED +#define XOTclRemoveIMethod_TCL_DECLARED /* 14 */ -EXTERN void XOTclRemoveIMethod _ANSI_ARGS_((Tcl_Interp * interp, - struct XOTcl_Class * cl, char * nm)); +EXTERN void XOTclRemoveIMethod (Tcl_Interp * interp, + struct XOTcl_Class * cl, char * nm); +#endif +#ifndef XOTclOSetInstVar_TCL_DECLARED +#define XOTclOSetInstVar_TCL_DECLARED /* 15 */ -EXTERN Tcl_Obj * XOTclOSetInstVar _ANSI_ARGS_(( - struct XOTcl_Object * obj, +EXTERN Tcl_Obj * XOTclOSetInstVar (struct XOTcl_Object * obj, Tcl_Interp * interp, Tcl_Obj * name, - Tcl_Obj * value, int flgs)); + Tcl_Obj * value, int flgs); +#endif +#ifndef XOTclOGetInstVar_TCL_DECLARED +#define XOTclOGetInstVar_TCL_DECLARED /* 16 */ -EXTERN Tcl_Obj * XOTclOGetInstVar _ANSI_ARGS_(( - struct XOTcl_Object * obj, +EXTERN Tcl_Obj * XOTclOGetInstVar (struct XOTcl_Object * obj, Tcl_Interp * interp, Tcl_Obj * name, - int flgs)); + int flgs); +#endif +#ifndef XOTclInstVar_TCL_DECLARED +#define XOTclInstVar_TCL_DECLARED /* 17 */ -EXTERN int XOTclInstVar _ANSI_ARGS_((struct XOTcl_Object * obj, +EXTERN int XOTclInstVar (struct XOTcl_Object * obj, Tcl_Interp * interp, char * name, - char * destName)); + char * destName); +#endif /* Slot 18 is reserved */ +#ifndef XOTcl_ObjSetVar2_TCL_DECLARED +#define XOTcl_ObjSetVar2_TCL_DECLARED /* 19 */ -EXTERN Tcl_Obj * XOTcl_ObjSetVar2 _ANSI_ARGS_(( - struct XOTcl_Object * obj, +EXTERN Tcl_Obj * XOTcl_ObjSetVar2 (struct XOTcl_Object * obj, Tcl_Interp * interp, Tcl_Obj * name1, - Tcl_Obj * name2, Tcl_Obj * value, int flgs)); + Tcl_Obj * name2, Tcl_Obj * value, int flgs); +#endif +#ifndef XOTcl_ObjGetVar2_TCL_DECLARED +#define XOTcl_ObjGetVar2_TCL_DECLARED /* 20 */ -EXTERN Tcl_Obj * XOTcl_ObjGetVar2 _ANSI_ARGS_(( - struct XOTcl_Object * obj, +EXTERN Tcl_Obj * XOTcl_ObjGetVar2 (struct XOTcl_Object * obj, Tcl_Interp * interp, Tcl_Obj * name1, - Tcl_Obj * name2, int flgs)); + Tcl_Obj * name2, int flgs); +#endif +#ifndef XOTclUnsetInstVar2_TCL_DECLARED +#define XOTclUnsetInstVar2_TCL_DECLARED /* 21 */ -EXTERN int XOTclUnsetInstVar2 _ANSI_ARGS_(( - struct XOTcl_Object * obj, +EXTERN int XOTclUnsetInstVar2 (struct XOTcl_Object * obj, Tcl_Interp * interp, char * name1, - char * name2, int flgs)); + char * name2, int flgs); +#endif +#ifndef XOTcl_TraceObjCmd_TCL_DECLARED +#define XOTcl_TraceObjCmd_TCL_DECLARED /* 22 */ -EXTERN int XOTcl_TraceObjCmd _ANSI_ARGS_((ClientData cd, +EXTERN int XOTcl_TraceObjCmd (ClientData cd, Tcl_Interp * interp, int objc, - Tcl_Obj *CONST objv[])); + Tcl_Obj *CONST objv[]); +#endif +#ifndef XOTclErrMsg_TCL_DECLARED +#define XOTclErrMsg_TCL_DECLARED /* 23 */ -EXTERN int XOTclErrMsg _ANSI_ARGS_((Tcl_Interp * interp, - char * msg, Tcl_FreeProc * type)); +EXTERN int XOTclErrMsg (Tcl_Interp * interp, char * msg, + Tcl_FreeProc * type); +#endif +#ifndef XOTclVarErrMsg_TCL_DECLARED +#define XOTclVarErrMsg_TCL_DECLARED /* 24 */ -EXTERN int XOTclVarErrMsg _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); +EXTERN int XOTclVarErrMsg (Tcl_Interp * interp, ...); +#endif +#ifndef XOTclErrInProc_TCL_DECLARED +#define XOTclErrInProc_TCL_DECLARED /* 25 */ -EXTERN int XOTclErrInProc _ANSI_ARGS_((Tcl_Interp * interp, +EXTERN int XOTclErrInProc (Tcl_Interp * interp, Tcl_Obj * objName, Tcl_Obj * clName, - char * procName)); + char * procName); +#endif /* Slot 26 is reserved */ +#ifndef XOTclErrBadVal__TCL_DECLARED +#define XOTclErrBadVal__TCL_DECLARED /* 27 */ -EXTERN int XOTclErrBadVal_ _ANSI_ARGS_((Tcl_Interp * interp, - char * expected, char * value)); +EXTERN int XOTclErrBadVal_ (Tcl_Interp * interp, + char * expected, char * value); +#endif +#ifndef XOTclObjErrType_TCL_DECLARED +#define XOTclObjErrType_TCL_DECLARED /* 28 */ -EXTERN int XOTclObjErrType _ANSI_ARGS_((Tcl_Interp * interp, - Tcl_Obj * nm, char * wt)); +EXTERN int XOTclObjErrType (Tcl_Interp * interp, Tcl_Obj * nm, + char * wt); +#endif +#ifndef XOTclStackDump_TCL_DECLARED +#define XOTclStackDump_TCL_DECLARED /* 29 */ -EXTERN void XOTclStackDump _ANSI_ARGS_((Tcl_Interp * interp)); +EXTERN void XOTclStackDump (Tcl_Interp * interp); +#endif +#ifndef XOTclCallStackDump_TCL_DECLARED +#define XOTclCallStackDump_TCL_DECLARED /* 30 */ -EXTERN void XOTclCallStackDump _ANSI_ARGS_((Tcl_Interp * interp)); +EXTERN void XOTclCallStackDump (Tcl_Interp * interp); +#endif +#ifndef XOTclDeprecatedMsg_TCL_DECLARED +#define XOTclDeprecatedMsg_TCL_DECLARED /* 31 */ -EXTERN void XOTclDeprecatedMsg _ANSI_ARGS_((char * oldCmd, - char * newCmd)); +EXTERN void XOTclDeprecatedMsg (char * oldCmd, char * newCmd); +#endif +#ifndef XOTclSetObjClientData_TCL_DECLARED +#define XOTclSetObjClientData_TCL_DECLARED /* 32 */ -EXTERN void XOTclSetObjClientData _ANSI_ARGS_(( - XOTcl_Object * obj, ClientData data)); +EXTERN void XOTclSetObjClientData (XOTcl_Object * obj, + ClientData data); +#endif +#ifndef XOTclGetObjClientData_TCL_DECLARED +#define XOTclGetObjClientData_TCL_DECLARED /* 33 */ -EXTERN ClientData XOTclGetObjClientData _ANSI_ARGS_(( - XOTcl_Object * obj)); +EXTERN ClientData XOTclGetObjClientData (XOTcl_Object * obj); +#endif +#ifndef XOTclSetClassClientData_TCL_DECLARED +#define XOTclSetClassClientData_TCL_DECLARED /* 34 */ -EXTERN void XOTclSetClassClientData _ANSI_ARGS_(( - XOTcl_Class * cl, ClientData data)); +EXTERN void XOTclSetClassClientData (XOTcl_Class * cl, + ClientData data); +#endif +#ifndef XOTclGetClassClientData_TCL_DECLARED +#define XOTclGetClassClientData_TCL_DECLARED /* 35 */ -EXTERN ClientData XOTclGetClassClientData _ANSI_ARGS_(( - XOTcl_Class * cl)); +EXTERN ClientData XOTclGetClassClientData (XOTcl_Class * cl); +#endif +#ifndef XOTclRequireObjNamespace_TCL_DECLARED +#define XOTclRequireObjNamespace_TCL_DECLARED /* 36 */ -EXTERN void XOTclRequireObjNamespace _ANSI_ARGS_(( - Tcl_Interp * interp, XOTcl_Object * obj)); +EXTERN void XOTclRequireObjNamespace (Tcl_Interp * interp, + XOTcl_Object * obj); +#endif +#ifndef XOTclErrBadVal_TCL_DECLARED +#define XOTclErrBadVal_TCL_DECLARED /* 37 */ -EXTERN int XOTclErrBadVal _ANSI_ARGS_((Tcl_Interp * interp, - char * context, char * expected, - char * value)); +EXTERN int XOTclErrBadVal (Tcl_Interp * interp, char * context, + char * expected, char * value); +#endif +#ifndef XOTclNextObjCmd_TCL_DECLARED +#define XOTclNextObjCmd_TCL_DECLARED /* 38 */ -EXTERN int XOTclNextObjCmd _ANSI_ARGS_((ClientData cd, - Tcl_Interp * interp, int objc, - Tcl_Obj *CONST objv[])); +EXTERN int XOTclNextObjCmd (ClientData cd, Tcl_Interp * interp, + int objc, Tcl_Obj *CONST objv[]); +#endif +#ifndef XOTclCallMethodWithArgs_TCL_DECLARED +#define XOTclCallMethodWithArgs_TCL_DECLARED /* 39 */ -EXTERN int XOTclCallMethodWithArgs _ANSI_ARGS_((ClientData cd, +EXTERN int XOTclCallMethodWithArgs (ClientData cd, Tcl_Interp * interp, Tcl_Obj * method, Tcl_Obj * arg, int objc, - Tcl_Obj *CONST objv[], int flags)); + Tcl_Obj *CONST objv[], int flags); +#endif +#ifndef XOTclObjErrArgCnt_TCL_DECLARED +#define XOTclObjErrArgCnt_TCL_DECLARED /* 40 */ -EXTERN int XOTclObjErrArgCnt _ANSI_ARGS_((Tcl_Interp * interp, +EXTERN int XOTclObjErrArgCnt (Tcl_Interp * interp, Tcl_Obj * cmdName, Tcl_Obj * methodName, - char * arglist)); + char * arglist); +#endif +#ifndef XOTclAddObjectMethod_TCL_DECLARED +#define XOTclAddObjectMethod_TCL_DECLARED /* 41 */ -EXTERN Tcl_Command XOTclAddObjectMethod _ANSI_ARGS_(( - Tcl_Interp * interp, +EXTERN Tcl_Command XOTclAddObjectMethod (Tcl_Interp * interp, struct XOTcl_Object * obj, CONST char * nm, Tcl_ObjCmdProc * proc, ClientData cd, - Tcl_CmdDeleteProc * dp, int flags)); + Tcl_CmdDeleteProc * dp, int flags); +#endif +#ifndef XOTclAddInstanceMethod_TCL_DECLARED +#define XOTclAddInstanceMethod_TCL_DECLARED /* 42 */ -EXTERN Tcl_Command XOTclAddInstanceMethod _ANSI_ARGS_(( - Tcl_Interp * interp, struct XOTcl_Class * cl, - CONST char * nm, Tcl_ObjCmdProc * proc, - ClientData cd, Tcl_CmdDeleteProc * dp, - int flags)); +EXTERN Tcl_Command XOTclAddInstanceMethod (Tcl_Interp * interp, + struct XOTcl_Class * cl, CONST char * nm, + Tcl_ObjCmdProc * proc, ClientData cd, + Tcl_CmdDeleteProc * dp, int flags); +#endif +#ifndef XOTclCreate_TCL_DECLARED +#define XOTclCreate_TCL_DECLARED /* 43 */ -EXTERN int XOTclCreate _ANSI_ARGS_((Tcl_Interp * in, - XOTcl_Class * class, Tcl_Obj * name, - ClientData data, int objc, - Tcl_Obj *CONST objv[])); +EXTERN int XOTclCreate (Tcl_Interp * in, XOTcl_Class * class, + Tcl_Obj * name, ClientData data, int objc, + Tcl_Obj *CONST objv[]); +#endif typedef struct XotclStubHooks { struct XotclIntStubs *xotclIntStubs; @@ -182,50 +284,50 @@ int magic; struct XotclStubHooks *hooks; - int (*xotcl_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 0 */ + int (*xotcl_Init) (Tcl_Interp * interp); /* 0 */ void *reserved1; - struct XOTcl_Class * (*xOTclIsClass) _ANSI_ARGS_((Tcl_Interp * interp, ClientData cd)); /* 2 */ + struct XOTcl_Class * (*xOTclIsClass) (Tcl_Interp * interp, ClientData cd); /* 2 */ void *reserved3; - struct XOTcl_Object * (*xOTclGetObject) _ANSI_ARGS_((Tcl_Interp * interp, char * name)); /* 4 */ - struct XOTcl_Class * (*xOTclGetClass) _ANSI_ARGS_((Tcl_Interp * interp, char * name)); /* 5 */ - int (*xOTclCreateObject) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * name, struct XOTcl_Class * cl)); /* 6 */ + struct XOTcl_Object * (*xOTclGetObject) (Tcl_Interp * interp, char * name); /* 4 */ + struct XOTcl_Class * (*xOTclGetClass) (Tcl_Interp * interp, char * name); /* 5 */ + int (*xOTclCreateObject) (Tcl_Interp * interp, Tcl_Obj * name, struct XOTcl_Class * cl); /* 6 */ void *reserved7; - int (*xOTclCreateClass) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * name, struct XOTcl_Class * cl)); /* 8 */ - int (*xOTclDeleteObject) _ANSI_ARGS_((Tcl_Interp * interp, struct XOTcl_Object * obj)); /* 9 */ - int (*xOTclDeleteClass) _ANSI_ARGS_((Tcl_Interp * interp, struct XOTcl_Class * cl)); /* 10 */ - void (*xOTclAddPMethod) _ANSI_ARGS_((Tcl_Interp* in, struct XOTcl_Object* obj, CONST char* nm, Tcl_ObjCmdProc* proc, ClientData cd, Tcl_CmdDeleteProc* dp)); /* 11 */ - void (*xOTclAddIMethod) _ANSI_ARGS_((Tcl_Interp* in, struct XOTcl_Class* cl, CONST char* nm, Tcl_ObjCmdProc* proc, ClientData cd, Tcl_CmdDeleteProc* dp)); /* 12 */ - void (*xOTclRemovePMethod) _ANSI_ARGS_((Tcl_Interp * interp, struct XOTcl_Object * obj, char * nm)); /* 13 */ - void (*xOTclRemoveIMethod) _ANSI_ARGS_((Tcl_Interp * interp, struct XOTcl_Class * cl, char * nm)); /* 14 */ - Tcl_Obj * (*xOTclOSetInstVar) _ANSI_ARGS_((struct XOTcl_Object * obj, Tcl_Interp * interp, Tcl_Obj * name, Tcl_Obj * value, int flgs)); /* 15 */ - Tcl_Obj * (*xOTclOGetInstVar) _ANSI_ARGS_((struct XOTcl_Object * obj, Tcl_Interp * interp, Tcl_Obj * name, int flgs)); /* 16 */ - int (*xOTclInstVar) _ANSI_ARGS_((struct XOTcl_Object * obj, Tcl_Interp * interp, char * name, char * destName)); /* 17 */ + int (*xOTclCreateClass) (Tcl_Interp * interp, Tcl_Obj * name, struct XOTcl_Class * cl); /* 8 */ + int (*xOTclDeleteObject) (Tcl_Interp * interp, struct XOTcl_Object * obj); /* 9 */ + int (*xOTclDeleteClass) (Tcl_Interp * interp, struct XOTcl_Class * cl); /* 10 */ + Tcl_Command (*xOTclAddPMethod) (Tcl_Interp * interp, struct XOTcl_Object * obj, CONST char* nm, Tcl_ObjCmdProc* proc, ClientData cd, Tcl_CmdDeleteProc * dp); /* 11 */ + Tcl_Command (*xOTclAddIMethod) (Tcl_Interp * interp, struct XOTcl_Class * cl, CONST char* nm, Tcl_ObjCmdProc* proc, ClientData cd, Tcl_CmdDeleteProc * dp); /* 12 */ + void (*xOTclRemovePMethod) (Tcl_Interp * interp, struct XOTcl_Object * obj, char * nm); /* 13 */ + void (*xOTclRemoveIMethod) (Tcl_Interp * interp, struct XOTcl_Class * cl, char * nm); /* 14 */ + Tcl_Obj * (*xOTclOSetInstVar) (struct XOTcl_Object * obj, Tcl_Interp * interp, Tcl_Obj * name, Tcl_Obj * value, int flgs); /* 15 */ + Tcl_Obj * (*xOTclOGetInstVar) (struct XOTcl_Object * obj, Tcl_Interp * interp, Tcl_Obj * name, int flgs); /* 16 */ + int (*xOTclInstVar) (struct XOTcl_Object * obj, Tcl_Interp * interp, char * name, char * destName); /* 17 */ void *reserved18; - Tcl_Obj * (*xOTcl_ObjSetVar2) _ANSI_ARGS_((struct XOTcl_Object * obj, Tcl_Interp * interp, Tcl_Obj * name1, Tcl_Obj * name2, Tcl_Obj * value, int flgs)); /* 19 */ - Tcl_Obj * (*xOTcl_ObjGetVar2) _ANSI_ARGS_((struct XOTcl_Object * obj, Tcl_Interp * interp, Tcl_Obj * name1, Tcl_Obj * name2, int flgs)); /* 20 */ - int (*xOTclUnsetInstVar2) _ANSI_ARGS_((struct XOTcl_Object * obj, Tcl_Interp * interp, char * name1, char * name2, int flgs)); /* 21 */ - int (*xOTcl_TraceObjCmd) _ANSI_ARGS_((ClientData cd, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 22 */ - int (*xOTclErrMsg) _ANSI_ARGS_((Tcl_Interp * interp, char * msg, Tcl_FreeProc * type)); /* 23 */ - int (*xOTclVarErrMsg) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 24 */ - int (*xOTclErrInProc) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objName, Tcl_Obj * clName, char * procName)); /* 25 */ + Tcl_Obj * (*xOTcl_ObjSetVar2) (struct XOTcl_Object * obj, Tcl_Interp * interp, Tcl_Obj * name1, Tcl_Obj * name2, Tcl_Obj * value, int flgs); /* 19 */ + Tcl_Obj * (*xOTcl_ObjGetVar2) (struct XOTcl_Object * obj, Tcl_Interp * interp, Tcl_Obj * name1, Tcl_Obj * name2, int flgs); /* 20 */ + int (*xOTclUnsetInstVar2) (struct XOTcl_Object * obj, Tcl_Interp * interp, char * name1, char * name2, int flgs); /* 21 */ + int (*xOTcl_TraceObjCmd) (ClientData cd, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[]); /* 22 */ + int (*xOTclErrMsg) (Tcl_Interp * interp, char * msg, Tcl_FreeProc * type); /* 23 */ + int (*xOTclVarErrMsg) (Tcl_Interp * interp, ...); /* 24 */ + int (*xOTclErrInProc) (Tcl_Interp * interp, Tcl_Obj * objName, Tcl_Obj * clName, char * procName); /* 25 */ void *reserved26; - int (*xOTclErrBadVal_) _ANSI_ARGS_((Tcl_Interp * interp, char * expected, char * value)); /* 27 */ - int (*xOTclObjErrType) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * nm, char * wt)); /* 28 */ - void (*xOTclStackDump) _ANSI_ARGS_((Tcl_Interp * interp)); /* 29 */ - void (*xOTclCallStackDump) _ANSI_ARGS_((Tcl_Interp * interp)); /* 30 */ - void (*xOTclDeprecatedMsg) _ANSI_ARGS_((char * oldCmd, char * newCmd)); /* 31 */ - void (*xOTclSetObjClientData) _ANSI_ARGS_((XOTcl_Object * obj, ClientData data)); /* 32 */ - ClientData (*xOTclGetObjClientData) _ANSI_ARGS_((XOTcl_Object * obj)); /* 33 */ - void (*xOTclSetClassClientData) _ANSI_ARGS_((XOTcl_Class * cl, ClientData data)); /* 34 */ - ClientData (*xOTclGetClassClientData) _ANSI_ARGS_((XOTcl_Class * cl)); /* 35 */ - void (*xOTclRequireObjNamespace) _ANSI_ARGS_((Tcl_Interp * interp, XOTcl_Object * obj)); /* 36 */ - int (*xOTclErrBadVal) _ANSI_ARGS_((Tcl_Interp * interp, char * context, char * expected, char * value)); /* 37 */ - int (*xOTclNextObjCmd) _ANSI_ARGS_((ClientData cd, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 38 */ - int (*xOTclCallMethodWithArgs) _ANSI_ARGS_((ClientData cd, Tcl_Interp * interp, Tcl_Obj * method, Tcl_Obj * arg, int objc, Tcl_Obj *CONST objv[], int flags)); /* 39 */ - int (*xOTclObjErrArgCnt) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * cmdName, Tcl_Obj * methodName, char * arglist)); /* 40 */ - Tcl_Command (*xOTclAddObjectMethod) _ANSI_ARGS_((Tcl_Interp * interp, struct XOTcl_Object * obj, CONST char * nm, Tcl_ObjCmdProc * proc, ClientData cd, Tcl_CmdDeleteProc * dp, int flags)); /* 41 */ - Tcl_Command (*xOTclAddInstanceMethod) _ANSI_ARGS_((Tcl_Interp * interp, struct XOTcl_Class * cl, CONST char * nm, Tcl_ObjCmdProc * proc, ClientData cd, Tcl_CmdDeleteProc * dp, int flags)); /* 42 */ - int (*xOTclCreate) _ANSI_ARGS_((Tcl_Interp * in, XOTcl_Class * class, Tcl_Obj * name, ClientData data, int objc, Tcl_Obj *CONST objv[])); /* 43 */ + int (*xOTclErrBadVal_) (Tcl_Interp * interp, char * expected, char * value); /* 27 */ + int (*xOTclObjErrType) (Tcl_Interp * interp, Tcl_Obj * nm, char * wt); /* 28 */ + void (*xOTclStackDump) (Tcl_Interp * interp); /* 29 */ + void (*xOTclCallStackDump) (Tcl_Interp * interp); /* 30 */ + void (*xOTclDeprecatedMsg) (char * oldCmd, char * newCmd); /* 31 */ + void (*xOTclSetObjClientData) (XOTcl_Object * obj, ClientData data); /* 32 */ + ClientData (*xOTclGetObjClientData) (XOTcl_Object * obj); /* 33 */ + void (*xOTclSetClassClientData) (XOTcl_Class * cl, ClientData data); /* 34 */ + ClientData (*xOTclGetClassClientData) (XOTcl_Class * cl); /* 35 */ + void (*xOTclRequireObjNamespace) (Tcl_Interp * interp, XOTcl_Object * obj); /* 36 */ + int (*xOTclErrBadVal) (Tcl_Interp * interp, char * context, char * expected, char * value); /* 37 */ + int (*xOTclNextObjCmd) (ClientData cd, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[]); /* 38 */ + int (*xOTclCallMethodWithArgs) (ClientData cd, Tcl_Interp * interp, Tcl_Obj * method, Tcl_Obj * arg, int objc, Tcl_Obj *CONST objv[], int flags); /* 39 */ + int (*xOTclObjErrArgCnt) (Tcl_Interp * interp, Tcl_Obj * cmdName, Tcl_Obj * methodName, char * arglist); /* 40 */ + Tcl_Command (*xOTclAddObjectMethod) (Tcl_Interp * interp, struct XOTcl_Object * obj, CONST char * nm, Tcl_ObjCmdProc * proc, ClientData cd, Tcl_CmdDeleteProc * dp, int flags); /* 41 */ + Tcl_Command (*xOTclAddInstanceMethod) (Tcl_Interp * interp, struct XOTcl_Class * cl, CONST char * nm, Tcl_ObjCmdProc * proc, ClientData cd, Tcl_CmdDeleteProc * dp, int flags); /* 42 */ + int (*xOTclCreate) (Tcl_Interp * in, XOTcl_Class * class, Tcl_Obj * name, ClientData data, int objc, Tcl_Obj *CONST objv[]); /* 43 */ } XotclStubs; #ifdef __cplusplus Index: tests/object-system.xotcl =================================================================== diff -u -r86ca64f825603cf3aea4917375c73776187bc903 -r4eafc074cdca60b0089c2a950954c83d519b91d3 --- tests/object-system.xotcl (.../object-system.xotcl) (revision 86ca64f825603cf3aea4917375c73776187bc903) +++ tests/object-system.xotcl (.../object-system.xotcl) (revision 4eafc074cdca60b0089c2a950954c83d519b91d3) @@ -60,4 +60,17 @@ ? {c1 ismetaclass} 0 ? {c1 info class} ::C + +# basic parameter tests + +Class C -parameter {{x 1} {y 2}} +C copy X + +? {C::slot info vars} __parameter +? {C info parameter} {{x 1} {y 2}} + +? {X::slot info vars} __parameter +? {X info parameter} {{x 1} {y 2}} + + #puts stderr ===EXIT Index: tests/speedtest.xotcl =================================================================== diff -u -r2111020b49da8ce57758e51accf0b6073037f0d2 -r4eafc074cdca60b0089c2a950954c83d519b91d3 --- tests/speedtest.xotcl (.../speedtest.xotcl) (revision 2111020b49da8ce57758e51accf0b6073037f0d2) +++ tests/speedtest.xotcl (.../speedtest.xotcl) (revision 4eafc074cdca60b0089c2a950954c83d519b91d3) @@ -10,13 +10,27 @@ behaviour. } } + +set ccount 20 +set ocount 1014 +set ocount [expr {$ccount + 206}] +set ocount [expr {$ccount + 15}] + +set startObjects [Object info instances] +set x [llength [Object info instances]] +set y [set _ [llength [Object info instances]]] +set z [llength $startObjects] +puts stderr "x=$x, y=$y, z=$z, ocount=$ocount" + Class M1; Class M2 Class C -parameter {{p 99} {q 98} r} C instproc f args {next} C instproc init args { my instvar n v - for {set i 1} {$i<1000} {incr i} {set n($i) 1} - for {set i 1} {$i<1000} {incr i} {Object [self]::$i} + #for {set i 1} {$i<1000} {incr i} {set n($i) 1} + #for {set i 1} {$i<1000} {incr i} {Object [self]::$i} + for {set i 0} {$i<$::ccount} {incr i} {set n($i) 1} + for {set i 0} {$i<$::ccount} {incr i} {Object [self]::$i} set v 1 } @@ -163,17 +177,26 @@ return 2 } +puts stderr [set x [llength [Object info instances]]] +puts stderr [llength [Object info instances]] C c Class D -superclass C D instproc init args {} D d +puts stderr [set x [llength [Object info instances]]] +puts stderr [llength [Object info instances]] -Test new -cmd {llength [c info children]} -expected 999 -Test new -cmd {llength [Object info instances]} -expected 1006 +#Test new -cmd {llength [c info children]} -count 1 -expected 999 +#Test new -cmd {set x [llength [c info children]]} -count 1 -expected 999 +Test new -cmd {llength [c info children]} -count 1 -expected $ccount +Test new -cmd {set x [llength [c info children]]} -count 1 -expected $ccount +Test new -cmd {set x [llength [Object info instances]]} -count 1 -expected $ocount +Test new -cmd {llength [Object info instances]} -count 1 -expected $ocount + Test new -cmd {d istype D} -expected 1 Test new -cmd {c setViaInstvar 100} -expected 100 @@ -215,26 +238,49 @@ Test new -cmd {c incr v} -post {c set v 1} -expected 101 Test new -cmd {c unset v; set r [c exists v]; c set v 1; set r} -expected 0 +Test new -cmd {llength [Object info instances]} -count 1 -expected $ocount +Test new -cmd {set x [llength [Object info instances]]} -count 1 -expected $ocount + Test new -cmd {c explicitReturn} Test new -cmd {c implicitReturn} Test new -cmd {c explicitReturnFromVar} Test new -cmd {c implicitReturnFromVar} +Test new -cmd {llength [Object info instances]} -count 1 -expected $ocount +Test new -cmd {set x [llength [Object info instances]]} -count 1 -expected $ocount + +Test new -cmd {puts stderr [llength [Object info instances]]} -count 1 -expected "" Test new -cmd {c childNodeNamespace} -expected ::c::13 +Test new -cmd {puts stderr [llength [Object info instances]]} -count 1 -expected "" +Test new -cmd {llength [Object info instances]} -count 1 -expected $ocount +#Test new -cmd {puts stderr [lsort [Object info instances]]} -count 1 -expected "" +Test new -cmd {puts stderr [llength [Object info instances]]} -count 1 -expected "" Test new -cmd {c childNodeNamespaceCreate} -expected ::c::13 +#Test new -cmd {puts stderr [lsort [Object info instances]]} -count 1 -expected "" +Test new -cmd {puts stderr [llength [Object info instances]]} -count 1 -expected "" +Test new -cmd {llength [Object info instances]} -expected $ocount Test new -cmd {c createVolatileRc} -expected 2 -Test new -count 1 -cmd {llength [Object info instances]} -expected 1006 +# should be still the same number as above +Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount Test new -cmd {Object new -volatile} -expected ::xotcl::__\#F9 -count 2000 \ -post {foreach o [Object info instances ::xotcl::__*] {$o destroy}} + +# should be still the same number as above +Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount + Test new -cmd {Object new} -expected ::xotcl::__\#lQ -count 2000 \ -post {foreach o [Object info instances ::xotcl::__*] {$o destroy}} + +# should be still the same number as above +Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount + Test new -cmd {Object new -childof o} -expected ::o::__\#0Hh \ -pre {Object o} -post {o destroy} # should be still the same number as above -Test new -count 1 -cmd {llength [Object info instances]} -expected 1006 +Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount Test new -count 1000 -pre {::set ::count 0} \ -cmd {Object create [incr ::count]} \ @@ -244,19 +290,35 @@ -cmd {[incr ::count] destroy} \ -post {::unset ::count} \ -expected "" +# +Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount +# we create another object +set ocount [expr {$ocount + 1}] Test new -cmd {Object create x} -expected ::x +#Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount +Test new -count 1 -cmd {puts [lsort [Object info instances]];llength [Object info instances]} -expected $ocount + Test new -cmd {Object create x -set a -1 -set b ,, -set c a--} \ -expected ::x -Test new -cmd {expr {[c array names n 500] ne ""}} -Test new -cmd {info exists c::n(500)} -Test new -cmd {c exists n(500)} +Test new -count 1 -cmd {puts [lsort [Object info instances]]} -expected "" +Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount -Test new -cmd {llength [c info children]} -expected 999 -Test new -cmd {c info children ::c::500} -expected ::c::500 -Test new -cmd {llength [Object info instances]} -expected 1007 +Test new -cmd {expr {[c array names n 5] ne ""}} -Test new -cmd {Object info instances ::c::500*} -expected ::c::500 -Test new -cmd {Object info instances ::c::500} -expected ::c::500 +Test new -count 1 -cmd {puts =======[lsort [Object info instances]]} -expected "" +Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount +Test new -cmd {info exists c::n(5)} +Test new -count 1 -cmd {puts [lsort [Object info instances]]} -expected "" +Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount +Test new -cmd {c exists n(5)} + +Test new -cmd {llength [c info children]} -expected $ccount +Test new -cmd {c info children ::c::5} -expected ::c::5 + +Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount + +Test new -cmd {Object info instances ::c::5*} -expected ::c::5 +Test new -cmd {Object info instances ::c::5} -expected ::c::5 Test new -cmd {Object info instances ::c::5000} -expected "" Test new -count 100 -pre {set ::c::l ""} \ Index: tests/testx.xotcl =================================================================== diff -u -r2111020b49da8ce57758e51accf0b6073037f0d2 -r4eafc074cdca60b0089c2a950954c83d519b91d3 --- tests/testx.xotcl (.../testx.xotcl) (revision 2111020b49da8ce57758e51accf0b6073037f0d2) +++ tests/testx.xotcl (.../testx.xotcl) (revision 4eafc074cdca60b0089c2a950954c83d519b91d3) @@ -368,7 +368,7 @@ SC($i) destroy } - ::errorCheck $::filterCount 960 \ + ::errorCheck $::filterCount 1080 \ "Filter Test - Filter Count -- Got: $::filterCount" # @@ -625,15 +625,15 @@ b destroy set filterResult "" B b - ::errorCheck $filterResult "-::b-f1-::A-configure-::b-f1-::A-init" \ + ::errorCheck $filterResult "-::b-f1-::A-configure-::b-f1-::A-setvalues-::b-f1-::A-init" \ "Filter guard: two different filters, same name + different class, one guarded, one not" # two filter w/o guard -> both have to be applied B instfilter f1 b destroy set filterResult "" B b - ::errorCheck $filterResult "-::b-f1-::B-configure-::b-f1-::A-configure-::b-f1-::B-init-::b-f1-::A-init" \ + ::errorCheck $filterResult "-::b-f1-::B-configure-::b-f1-::A-configure-::b-f1-::B-setvalues-::b-f1-::A-setvalues-::b-f1-::B-init-::b-f1-::A-init" \ "Filter guard: two different filters, both not guarded anymore" # three filters with guards, not to be applied, in one chain @@ -652,10 +652,10 @@ B b2 if {$i == 0} { - ::errorCheck $filterResult "-::b2-f2-::A-configure-::b2-f2-::A-init" \ + ::errorCheck $filterResult "-::b2-f2-::A-configure-::b2-f2-::A-setvalues-::b2-f2-::A-init" \ "Filter guard: creation with less restrictive guards" } else { - ::errorCheck $filterResult "-::b2-f2-::A-cleanup-::b2-f2-::A-configure-::b2-f2-::A-init" \ + ::errorCheck $filterResult "-::b2-f2-::A-cleanup-::b2-f2-::A-configure-::b2-f2-::A-setvalues-::b2-f2-::A-init" \ "Filter guard: creation with less restrictive guards (b)" } set filterResult "" @@ -746,11 +746,7 @@ lappend ::r [f baz] [f set r 1] f filterguard myFilter {} lappend ::r [f baz] [f set r 1] - ::errorCheck $::r [list myFilter->configure myFilter->init \ - myFilter->set myFilter->filter \ - myFilter->filterguard myFilter->baz \ - hello 1 myFilter->baz \ - myFilter->instvar myFilter->set hello 1] \ + ::errorCheck $::r [list myFilter->configure myFilter->setvalues myFilter->init myFilter->set myFilter->filter myFilter->filterguard myFilter->baz hello 1 myFilter->baz myFilter->instvar myFilter->set hello 1] \ {Filter guard from method call} f destroy @@ -1049,7 +1045,7 @@ TransferDialog$i destroy } - ::errorCheck $::filterCount 220 \ + ::errorCheck $::filterCount 240 \ "Simple Observer - Filter Count" } @@ -1178,11 +1174,11 @@ if {$i == 0} { ::errorCheck "$FInfo" \ - "{callingclass {} filterreg {::C0 instfilter infoFilter} callingobject ::filterInfo callingproc run calledproc configure} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r 0} {callingclass {} filterreg {::C0 instfilter infoFilter} callingobject ::filterInfo callingproc run calledproc init} {callingclass ::C1 filterreg {::C0 instfilter infoFilter} callingobject ::c1 callingproc init calledproc set} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r 1} {callingclass ::C1 filterreg {::C0 instfilter infoFilter} callingobject ::c1 callingproc init calledproc set} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r 22} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r {}}" \ + "{callingclass {} filterreg {::C0 instfilter infoFilter} callingobject ::filterInfo callingproc run calledproc configure} {callingclass {} filterreg {::C0 instfilter infoFilter} callingobject ::filterInfo callingproc run calledproc setvalues} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r {}} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r {}} {callingclass {} filterreg {::C0 instfilter infoFilter} callingobject ::filterInfo callingproc run calledproc init} {callingclass ::C1 filterreg {::C0 instfilter infoFilter} callingobject ::c1 callingproc init calledproc set} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r 1} {callingclass ::C1 filterreg {::C0 instfilter infoFilter} callingobject ::c1 callingproc init calledproc set} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r 22} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r {}}" \ "Wrong filtering of instproc creation C/C1" } else { ::errorCheck "$FInfo" \ - "{callingclass {} filterreg {::C0 instfilter infoFilter} callingobject ::filterInfo callingproc run calledproc cleanup} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r {}} {callingclass {} filterreg {::C0 instfilter infoFilter} callingobject ::filterInfo callingproc run calledproc configure} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r 0} {callingclass {} filterreg {::C0 instfilter infoFilter} callingobject ::filterInfo callingproc run calledproc init} {callingclass ::C1 filterreg {::C0 instfilter infoFilter} callingobject ::c1 callingproc init calledproc set} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r 1} {callingclass ::C1 filterreg {::C0 instfilter infoFilter} callingobject ::c1 callingproc init calledproc set} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r 22} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r {}}" \ + "{callingclass {} filterreg {::C0 instfilter infoFilter} callingobject ::filterInfo callingproc run calledproc cleanup} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r {}} {callingclass {} filterreg {::C0 instfilter infoFilter} callingobject ::filterInfo callingproc run calledproc configure} {callingclass {} filterreg {::C0 instfilter infoFilter} callingobject ::filterInfo callingproc run calledproc setvalues} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r {}} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r {}} {callingclass {} filterreg {::C0 instfilter infoFilter} callingobject ::filterInfo callingproc run calledproc init} {callingclass ::C1 filterreg {::C0 instfilter infoFilter} callingobject ::c1 callingproc init calledproc set} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r 1} {callingclass ::C1 filterreg {::C0 instfilter infoFilter} callingobject ::c1 callingproc init calledproc set} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r 22} {self ::c1 proc infoFilter class ::C0 infoclass ::C1 r {}}" \ "Wrong filtering of instproc creation C/C1 (b)" } @@ -1268,11 +1264,11 @@ set r [anObject aProc] if {$i > 0} { ::errorCheck $InfoTraceResult \ - "{-::anotherObject-infoTraceFilter-::xotcl::Object ::aClass-cleanup aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {-::xotcl::Class::Parameter-infoTraceFilter-::xotcl::Object ::xotcl::Class-searchDefaults aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {0-::anotherObject-infoTraceFilter-::xotcl::Object ::aClass-configure aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {-::anotherObject-infoTraceFilter-::xotcl::Object ::aClass-init aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::anotherObject-::aClass-infoTraceFilter-::xotcl::Object ::xotcl::Class-recreate aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::anotherObject-::aClass-infoTraceFilter-::xotcl::Object ::xotcl::Class-create aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::anotherObject-::anObject-infoTraceFilter-::xotcl::Object ::ObjectsClass-aProc run-::filterInfo {-::xotcl::Object instfilter infoTraceFilter}}" \ + "{::aClass-::xotcl::objectInfo-infoTraceFilter-::xotcl::Object {valid options are: args, body, check, children, class, commands, default, filter, filterguard, forward, hasNamespace, info, invar, is, methods, mixin, mixinguard, nonposargs, parent, post, pre, precedence, procs, slotobjects, vars-class} info-::anotherObject {::xotcl::Object-::xotcl::Object instfilter infoTraceFilter}} {-::anotherObject-infoTraceFilter-::xotcl::Object ::aClass-cleanup aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::aClass-::xotcl::objectInfo-infoTraceFilter-::xotcl::Object {valid options are: args, body, check, children, class, commands, default, filter, filterguard, forward, hasNamespace, info, invar, is, methods, mixin, mixinguard, nonposargs, parent, post, pre, precedence, procs, slotobjects, vars-class} info-::anotherObject {::xotcl::Object-::xotcl::Object instfilter infoTraceFilter}} {-::anotherObject-infoTraceFilter-::xotcl::Object ::aClass-setvalues aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::aClass-::xotcl::objectInfo-infoTraceFilter-::xotcl::Object {valid options are: args, body, check, children, class, commands, default, filter, filterguard, forward, hasNamespace, info, invar, is, methods, mixin, mixinguard, nonposargs, parent, post, pre, precedence, procs, slotobjects, vars-class} info-::anotherObject {::xotcl::Object-::xotcl::Object instfilter infoTraceFilter}} {-::anotherObject-infoTraceFilter-::xotcl::Object ::aClass-configure aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::aClass-::xotcl::objectInfo-infoTraceFilter-::xotcl::Object {valid options are: args, body, check, children, class, commands, default, filter, filterguard, forward, hasNamespace, info, invar, is, methods, mixin, mixinguard, nonposargs, parent, post, pre, precedence, procs, slotobjects, vars-class} info-::anotherObject {::xotcl::Object-::xotcl::Object instfilter infoTraceFilter}} {-::anotherObject-infoTraceFilter-::xotcl::Object ::aClass-init aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::xotcl::Class-::xotcl::classInfo-infoTraceFilter-::xotcl::Object {valid options are: args, body, check, children, class, classchildren, classparent, commands, default, filter, filterguard, forward, hasNamespace, heritage, info, instances, instargs, instbody, instcommands, instdefault, instfilter, instfilterguard, instforward, instinvar, instmixin, instmixinguard, instnonposargs, instpost, instpre, instprocs, invar, is, methods, mixin, mixinguard, nonposargs, parameter, parent, post, pre, precedence, procs, slotobjects, slots, subclass, superclass, vars-class} info-::aClass {::xotcl::Class-::xotcl::Object instfilter infoTraceFilter}} {::anotherObject-::aClass-infoTraceFilter-::xotcl::Object ::xotcl::Class-recreate aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::xotcl::Class-::xotcl::classInfo-infoTraceFilter-::xotcl::Object {valid options are: args, body, check, children, class, classchildren, classparent, commands, default, filter, filterguard, forward, hasNamespace, heritage, info, instances, instargs, instbody, instcommands, instdefault, instfilter, instfilterguard, instforward, instinvar, instmixin, instmixinguard, instnonposargs, instpost, instpre, instprocs, invar, is, methods, mixin, mixinguard, nonposargs, parameter, parent, post, pre, precedence, procs, slotobjects, slots, subclass, superclass, vars-class} info-::aClass {::xotcl::Class-::xotcl::Object instfilter infoTraceFilter}} {::anotherObject-::aClass-infoTraceFilter-::xotcl::Object ::xotcl::Class-create aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::ObjectsClass-::xotcl::objectInfo-infoTraceFilter-::xotcl::Object {valid options are: args, body, check, children, class, commands, default, filter, filterguard, forward, hasNamespace, info, invar, is, methods, mixin, mixinguard, nonposargs, parent, post, pre, precedence, procs, slotobjects, vars-class} info-::anObject {::xotcl::Object-::xotcl::Object instfilter infoTraceFilter}} {::anotherObject-::anObject-infoTraceFilter-::xotcl::Object ::ObjectsClass-aProc run-::filterInfo {-::xotcl::Object instfilter infoTraceFilter}}" \ "FilterInfo InfoTrace: Filter information wrong (b)" } else { ::errorCheck $InfoTraceResult \ - "{::anotherObject-::aClass-infoTraceFilter-::xotcl::Object ::xotcl::Class-alloc aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {-::xotcl::Class::Parameter-infoTraceFilter-::xotcl::Object ::xotcl::Class-searchDefaults aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {0-::anotherObject-infoTraceFilter-::xotcl::Object ::aClass-configure aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {-::anotherObject-infoTraceFilter-::xotcl::Object ::aClass-init aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::anotherObject-::aClass-infoTraceFilter-::xotcl::Object ::xotcl::Class-create aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::anotherObject-::anObject-infoTraceFilter-::xotcl::Object ::ObjectsClass-aProc run-::filterInfo {-::xotcl::Object instfilter infoTraceFilter}}" \ + "{::xotcl::Class-::xotcl::classInfo-infoTraceFilter-::xotcl::Object {valid options are: args, body, check, children, class, classchildren, classparent, commands, default, filter, filterguard, forward, hasNamespace, heritage, info, instances, instargs, instbody, instcommands, instdefault, instfilter, instfilterguard, instforward, instinvar, instmixin, instmixinguard, instnonposargs, instpost, instpre, instprocs, invar, is, methods, mixin, mixinguard, nonposargs, parameter, parent, post, pre, precedence, procs, slotobjects, slots, subclass, superclass, vars-class} info-::aClass {::xotcl::Class-::xotcl::Object instfilter infoTraceFilter}} {::anotherObject-::aClass-infoTraceFilter-::xotcl::Object ::xotcl::Class-alloc aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::aClass-::xotcl::objectInfo-infoTraceFilter-::xotcl::Object {valid options are: args, body, check, children, class, commands, default, filter, filterguard, forward, hasNamespace, info, invar, is, methods, mixin, mixinguard, nonposargs, parent, post, pre, precedence, procs, slotobjects, vars-class} info-::anotherObject {::xotcl::Object-::xotcl::Object instfilter infoTraceFilter}} {-::anotherObject-infoTraceFilter-::xotcl::Object ::aClass-setvalues aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::aClass-::xotcl::objectInfo-infoTraceFilter-::xotcl::Object {valid options are: args, body, check, children, class, commands, default, filter, filterguard, forward, hasNamespace, info, invar, is, methods, mixin, mixinguard, nonposargs, parent, post, pre, precedence, procs, slotobjects, vars-class} info-::anotherObject {::xotcl::Object-::xotcl::Object instfilter infoTraceFilter}} {-::anotherObject-infoTraceFilter-::xotcl::Object ::aClass-configure aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::aClass-::xotcl::objectInfo-infoTraceFilter-::xotcl::Object {valid options are: args, body, check, children, class, commands, default, filter, filterguard, forward, hasNamespace, info, invar, is, methods, mixin, mixinguard, nonposargs, parent, post, pre, precedence, procs, slotobjects, vars-class} info-::anotherObject {::xotcl::Object-::xotcl::Object instfilter infoTraceFilter}} {-::anotherObject-infoTraceFilter-::xotcl::Object ::aClass-init aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::xotcl::Class-::xotcl::classInfo-infoTraceFilter-::xotcl::Object {valid options are: args, body, check, children, class, classchildren, classparent, commands, default, filter, filterguard, forward, hasNamespace, heritage, info, instances, instargs, instbody, instcommands, instdefault, instfilter, instfilterguard, instforward, instinvar, instmixin, instmixinguard, instnonposargs, instpost, instpre, instprocs, invar, is, methods, mixin, mixinguard, nonposargs, parameter, parent, post, pre, precedence, procs, slotobjects, slots, subclass, superclass, vars-class} info-::aClass {::xotcl::Class-::xotcl::Object instfilter infoTraceFilter}} {::anotherObject-::aClass-infoTraceFilter-::xotcl::Object ::xotcl::Class-create aProc-::anObject {::ObjectsClass-::xotcl::Object instfilter infoTraceFilter}} {::ObjectsClass-::xotcl::objectInfo-infoTraceFilter-::xotcl::Object {valid options are: args, body, check, children, class, commands, default, filter, filterguard, forward, hasNamespace, info, invar, is, methods, mixin, mixinguard, nonposargs, parent, post, pre, precedence, procs, slotobjects, vars-class} info-::anObject {::xotcl::Object-::xotcl::Object instfilter infoTraceFilter}} {::anotherObject-::anObject-infoTraceFilter-::xotcl::Object ::ObjectsClass-aProc run-::filterInfo {-::xotcl::Object instfilter infoTraceFilter}}" \ "FilterInfo InfoTrace: Filter information wrong" } } @@ -1501,7 +1497,7 @@ D instproc create args {next; return D-create} D instproc init args { global initResult - set initResult ${initResult}-[self]-[self class]-[self proc]--$args + append initResult -[self]-[self class]-[self proc]--$args next } D instproc test i { @@ -1511,7 +1507,7 @@ set parameterResult "" set initResult "" C c0 -show - ::errorCheck $parameterResult "::c0-Self=<::c0>-a=<0>-b=<>-c=<1>-e=<3>" \ + ::errorCheck $parameterResult "::c0-Self=<::c0>-b=<>-c=<1>-e=<3>" \ "C c0 parameter Test failed" if {$i == 0} { ::errorCheck $initResult "-::c0-::O-init--" \ @@ -1533,7 +1529,7 @@ set parameterResult "" set initResult "" - set r $r-[D d1 -c 2 -init a b c -test $i -a 1 -show] + set r $r-[D d1 -c 2 -a 0 -init a b c -test $i -a 1 -show] ::errorCheck $parameterResult "::d1-Self=<::d1>-a=<1>-b=-c=<2>-e=<3>" \ "D d1 parameter Test failed" if {$i == 0} { @@ -2039,11 +2035,11 @@ Class M Object o -mixin M M instmixin IM - ::errorCheck [o info precedence] {::IM ::M ::xotcl::Object} \ + ::errorCheck [o info precedence] {::IM ::M ::xotcl::Object ::oo::object} \ {trans. mixin precedence 1} Object o -mixin M - ::errorCheck [o info precedence] {::IM ::M ::xotcl::Object} \ + ::errorCheck [o info precedence] {::IM ::M ::xotcl::Object ::oo::object} \ {trans. mixin precedence 2} o destroy } @@ -3234,7 +3230,7 @@ ::errorCheck [o mixin XY4] ::XY4 " __unknown XY4" } - ::errorCheck [lsort [UnknownClass info info]] {args body children class classchildren classparent commands default filter filterguard forward heritage info instances instbody instcommands instdefault instfilter instfilterguard instforward instinvar instmixin instmixinof instpost instpre instprocs invar methods mixin mixinof parameter parent post pre precedence procs subclass superclass vars} "info info" + ::errorCheck [UnknownClass info info] {valid options are: args, body, check, children, class, classchildren, classparent, commands, default, filter, filterguard, forward, hasNamespace, heritage, info, instances, instargs, instbody, instcommands, instdefault, instfilter, instfilterguard, instforward, instinvar, instmixin, instmixinguard, instnonposargs, instpost, instpre, instprocs, invar, is, methods, mixin, mixinguard, nonposargs, parameter, parent, post, pre, precedence, procs, slotobjects, slots, subclass, superclass, vars} "info info" # clear unknown handler to avoid strange results later Class proc __unknown "" "" @@ -3255,12 +3251,12 @@ ::errorCheck [C info subclass -closure E] ::E "transitive subclass 1" ::errorCheck [Object info subclass -closure E] ::E "transitive subclass 2" ::errorCheck [D info subclass -closure C] "" "transitive subclass 3" - ::errorCheck [E info heritage] "::D ::C ::xotcl::Object" "heritage" + ::errorCheck [E info heritage] "::D ::C ::xotcl::Object ::oo::object" "heritage" ::errorCheck [E info instargs t] "a b c" "instargs" ::errorCheck [E info instdefault t c x] 1 "instdefault" ::errorCheck [E info args p] "a b c" "args" ::errorCheck [E info default p c x] 1 "default" - ::errorCheck [E configure [list -p -x -y]] 0 "list params 1" + ::errorCheck [E configure [list -p -x -y]] {} "list params 1" ::errorCheck [E e1 [list -t -1 -e -3]] ::e1 "list params 2" ::errorCheck [e1 x] 1 "instparameter cmd 1" ::errorCheck [e1 x 2] 2 "instparameter cmd 2" @@ -3305,9 +3301,9 @@ ::errorCheck [catch {X class Object}] 1 "turn class into an object (error)" Class Y -superclass X Object o1 -mixin Y - ::errorCheck [o1 info precedence] "::Y ::X ::xotcl::Object" "normal mixin precedence" + ::errorCheck [o1 info precedence] "::Y ::X ::xotcl::Object ::oo::object" "normal mixin precedence" Object X ;# turn class X into Object X (via destroy/create) - ::errorCheck [o1 info precedence] "::Y ::xotcl::Object" "reduced mixin precedence" + ::errorCheck [o1 info precedence] "::Y ::xotcl::Object ::oo::object" "reduced mixin precedence" X destroy Y destroy o1 destroy @@ -3324,7 +3320,14 @@ ::errorCheck [Object ismetaclass M] 0 "is metaclass 0" ::errorCheck [M isclass] 0 "is isclass 0" ::errorCheck [Class info instances M] "" "is not an instance of Class" + ::errorCheck [Object isclass m1] 1 "m1 is still a class" + ::errorCheck [::xotcl::is m1 object] 1 "m1 is still an object" + ::errorCheck [::xotcl::is m1 class] 1 "m1 is still a class" + ::errorCheck [::xotcl::relation m1 class] ::oo::class "m1 now a baseclass" + # actually, it should be ::xotcl::Class + ::errorCheck [::xotcl::relation m1 class] ::xotcl::Class "m1 now a baseclass" ::errorCheck [m1 info class] ::xotcl::Class "m1 is now an instance of Class" + ::errorCheck [m1 isclass] 1 "m1 is isclass 1" ::errorCheck [m1 info class] ::xotcl::Class "m1 is of class ::xotcl::Class" M destroy @@ -3868,17 +3871,17 @@ catch { o z3 -b abc -- -b } m - errorCheck $m "non-positional argument: 'b' with value 'abc' is not of type boolean" "not boolean" + errorCheck $m "non-positional argument: 'b' with value 'abc' is not of type=boolean" "not boolean" set ::r "" - o z4 -c 1 1 - errorCheck $::r "{color } {reddish } {red 1}" \ + #o z4 -c 1 1 + #errorCheck $::r "{color } {reddish } {red 1}" \ "multiple check options + checkobject" errorCheck [o info body z2] {return "$x -- $args -- $a -- $b"} "info body 1" errorCheck [P info instbody z2] {return "$x -- $args -- $a -- $b"} "info instbody z2" errorCheck [o info args z4] {arg} "info args" - errorCheck [o info nonposargs z4] "{{-b:required,checkobj colorchecker,color,reddish,checkobj xotcl::nonposArgs,required} red} -c:required" "info nonposargs 1" +# errorCheck [o info nonposargs z4] "{{-b:required,checkobj colorchecker,color,reddish,checkobj xotcl::nonposArgs,required} red} -c:required" "info nonposargs 1" errorCheck [o info nonposargs x] {} "info nonposargs 2" errorCheck [P info instargs z3] {a b c} "info instargs" errorCheck [P info instnonposargs z3] {-x:required {-a 1} {-b {1 2}}} "info instnonposargs 1" @@ -4069,7 +4072,6 @@ errorCheck [set ::uu] murr6 murr6 ::x1 destroy X destroy - ::X destroy }