Index: TODO =================================================================== diff -u -r841e805480b4e7d445a61269249de9007112320d -rccb2c99f6fb6f381dfc7e300584ac08e3d2809d3 --- TODO (.../TODO) (revision 841e805480b4e7d445a61269249de9007112320d) +++ TODO (.../TODO) (revision ccb2c99f6fb6f381dfc7e300584ac08e3d2809d3) @@ -4797,11 +4797,28 @@ - added method pretty_variables to output available variables of a class in a similar style as in the definition - added low-level method "close" to nx::mongo + +nsf.c: +- new command ::nsf::object::alloc /class/ /obj/ ?/script/? + alloc an object and execute script in the context. Can be + used to regenerate an object in a old state. + +serializer: +- fixed loading of objects with required data in the blueprint + (many thanks for david hopfmueller for reporting this) +- make use of nsf::object::alloc (1 command instead of 1 create + 2 evals) +- these changes imprived laading time of blueprint by about 25% + for OpenACS+xowiki + ======================================================================== TODO: - remove / rephrase "//"-comments +- check deactivated tests in tests/serialize.test + C(One), C(IgnoreAll), C(None2) + and xlloc fix + Stefan: doc items - make rough comparison table with NX, XOTcl, tclOO, itcl, Ruby, Python Index: generic/nsf.c =================================================================== diff -u -rc3ec5a3a8cd0de894d2bea94f5a0d38eed7bdb9c -rccb2c99f6fb6f381dfc7e300584ac08e3d2809d3 --- generic/nsf.c (.../nsf.c) (revision c3ec5a3a8cd0de894d2bea94f5a0d38eed7bdb9c) +++ generic/nsf.c (.../nsf.c) (revision ccb2c99f6fb6f381dfc7e300584ac08e3d2809d3) @@ -211,6 +211,7 @@ /* prototypes for methods called directly when CallDirectly() returns NULL */ static int NsfCAllocMethod(Tcl_Interp *interp, NsfClass *cl, Tcl_Obj *nameObj); +static int NsfCAllocMethod_(Tcl_Interp *interp, NsfClass *cl, Tcl_Obj *nameObj, Tcl_Namespace *parentNsPtr); static int NsfCCreateMethod(Tcl_Interp *interp, NsfClass *cl, CONST char *name, int objc, Tcl_Obj *CONST objv[]); static int NsfOCleanupMethod(Tcl_Interp *interp, NsfObject *object); static int NsfOConfigureMethod(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *CONST objv[]); @@ -14137,8 +14138,8 @@ Tcl_DString ds, *dsPtr = &ds; int fullQualPattern = (pattern && *pattern == ':' && *(pattern+1) == ':'); - /*fprintf(stderr, "AddSlotObjects parent %s prefix %s type %p %s\n", - ObjectName(parent), prefix, type, type ? ClassName(type) : "");*/ + /* fprintf(stderr, "AddSlotObjects parent %s prefix %s type %p %s\n", + ObjectName(parent), prefix, type, type ? ClassName(type) : "");*/ DSTRING_INIT(dsPtr); Tcl_DStringAppend(dsPtr, ObjectName(parent), -1); @@ -14178,6 +14179,7 @@ * being right now created. */ if (!childObject || (childObject->flags & NSF_INIT_CALLED) == 0) { + /* fprintf(stderr, "....... key %s unfinished\n", key);*/ continue; } @@ -20755,7 +20757,43 @@ return result; } +/* +cmd "object::alloc" NsfObjectAllocCmd { + {-argName "class" -required 1 -type class} + {-argName "name" -required 1 -type tclobj} + {-argName "initcmd" -required 0 -type tclobj} +} +*/ +static int + NsfObjectAllocCmd(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *nameObj, Tcl_Obj *initcmdObj) { + int result; + /*fprintf(stderr, "trying to alloc <%s>\n", ObjStr(nameObj));*/ + + result = NsfCAllocMethod(interp, class, nameObj); + + if (result == TCL_OK && initcmdObj) { + NsfObject *object; + Tcl_Obj *nameObj = Tcl_GetObjResult(interp); + + INCR_REF_COUNT(nameObj); + if (unlikely(GetObjectFromObj(interp, nameObj, &object) != TCL_OK)) { + return NsfPrintError(interp, "couldn't find result of alloc"); + } + result = NsfDirectDispatchCmd(interp, object, 1, + NsfGlobalObjs[NSF_EVAL], + 1, &initcmdObj); + if (result == TCL_OK) { + Tcl_SetObjResult(interp,nameObj); + } + + DECR_REF_COUNT(nameObj); + + } + + return result; +} + /* cmd "object::exists" NsfObjectExistsCmd { {-argName "value" -required 1 -type tclobj} @@ -20786,7 +20824,7 @@ int flags = 0, allowSet = 0; switch (objectproperty) { - case ObjectpropertyInitializedIdx: flags = NSF_INIT_CALLED; break; + case ObjectpropertyInitializedIdx: flags = NSF_INIT_CALLED; allowSet = 1; break; case ObjectpropertyClassIdx: flags = NSF_IS_CLASS; break; case ObjectpropertyRootmetaclassIdx: flags = NSF_IS_ROOT_META_CLASS; break; case ObjectpropertyVolatileIdx: @@ -22558,7 +22596,7 @@ * already existing values (which might have been set via parameter * alias). */ - /*fprintf(stderr, "[%d] param %s, object init called %d is default %d value = '%s' nrArgs %d\n", + /* fprintf(stderr, "[%d] param %s, object init called %d is default %d value = '%s' nrArgs %d\n", i, paramPtr->name, (object->flags & NSF_INIT_CALLED), (pc.flags[i-1] & NSF_PC_IS_DEFAULT), ObjStr(pc.full_objv[i]), paramPtr->nrArgs);*/ @@ -22602,14 +22640,14 @@ * instance variable, which works under the assumption that the instance * variable has the same name and that e.g. an required alias parameter * sets this variable either. Similar assumption is in the default - * handling. Future versions might use a more generneral handling of the + * handling. Future versions might use a more general handling of the * parameter states. */ Tcl_Obj *varObj = Tcl_ObjGetVar2(interp, paramPtr->nameObj, NULL, TCL_PARSE_PART1); if (varObj == NULL) { Tcl_Obj *paramDefsObj = NsfParamDefsSyntax(paramDefs->paramsPtr); - + NsfPrintError(interp, "required argument '%s' is missing, should be:\n\t%s%s%s %s", paramPtr->nameObj ? ObjStr(paramPtr->nameObj) : paramPtr->name, pc.object ? ObjectName(pc.object) : "", @@ -23093,6 +23131,7 @@ */ static int NsfONoinitMethod(Tcl_Interp *UNUSED(interp), NsfObject *object) { + // fprintf(stderr, "noinit \n"); object->flags |= NSF_INIT_CALLED; return TCL_OK; } @@ -24951,7 +24990,7 @@ } else { NsfClassListAdd(&precedenceList, class, NULL); } - /* NsfClassListPrint("precedence", precedenceList);*/ + /* NsfClassListPrint("precedence", precedenceList); */ if (withSource == 0) {withSource = 1;} /* Index: generic/nsfAPI.decls =================================================================== diff -u -r7c2e28b93b02c29f19dc1f58642c5a29a894d24e -rccb2c99f6fb6f381dfc7e300584ac08e3d2809d3 --- generic/nsfAPI.decls (.../nsfAPI.decls) (revision 7c2e28b93b02c29f19dc1f58642c5a29a894d24e) +++ generic/nsfAPI.decls (.../nsfAPI.decls) (revision ccb2c99f6fb6f381dfc7e300584ac08e3d2809d3) @@ -124,7 +124,7 @@ {-argName "-postcondition" -type tclobj} } {-nxdoc 1} -cmd method::asmcreate NsfAsmMethodCreateCmd { +cmd "method::asmcreate" NsfAsmMethodCreateCmd { {-argName "object" -required 1 -type object} {-argName "-checkalways" -required 0 -nrargs 0 -type switch} {-argName "-inner-namespace" -nrargs 0} @@ -172,6 +172,11 @@ # # object cmds # +cmd "object::alloc" NsfObjectAllocCmd { + {-argName "class" -required 1 -type class} + {-argName "name" -required 1 -type tclobj} + {-argName "initcmd" -required 0 -type tclobj} +} cmd "object::exists" NsfObjectExistsCmd { {-argName "value" -required 1 -type tclobj} } {-nxdoc 1} Index: generic/nsfAPI.h =================================================================== diff -u -r68b3924a7a90d28e2e11f9b9b8244a85da708073 -rccb2c99f6fb6f381dfc7e300584ac08e3d2809d3 --- generic/nsfAPI.h (.../nsfAPI.h) (revision 68b3924a7a90d28e2e11f9b9b8244a85da708073) +++ generic/nsfAPI.h (.../nsfAPI.h) (revision ccb2c99f6fb6f381dfc7e300584ac08e3d2809d3) @@ -281,7 +281,7 @@ /* just to define the symbol */ -static Nsf_methodDefinition method_definitions[105]; +static Nsf_methodDefinition method_definitions[106]; static CONST char *method_command_namespace_names[] = { "::nsf::methods::object::info", @@ -335,6 +335,7 @@ static int NsfMyCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfNSCopyVarsCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfNextCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int NsfObjectAllocCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfObjectExistsCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfObjectPropertyCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfObjectQualifyCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -440,6 +441,7 @@ static int NsfMyCmd(Tcl_Interp *interp, int withIntrinsic, int withLocal, int withSystem, Tcl_Obj *methodName, int nobjc, Tcl_Obj *CONST nobjv[]); static int NsfNSCopyVarsCmd(Tcl_Interp *interp, Tcl_Obj *fromNs, Tcl_Obj *toNs); static int NsfNextCmd(Tcl_Interp *interp, Tcl_Obj *arguments); +static int NsfObjectAllocCmd(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *name, Tcl_Obj *initcmd); static int NsfObjectExistsCmd(Tcl_Interp *interp, Tcl_Obj *value); static int NsfObjectPropertyCmd(Tcl_Interp *interp, NsfObject *objectName, int objectProperty, Tcl_Obj *value); static int NsfObjectQualifyCmd(Tcl_Interp *interp, Tcl_Obj *objectName); @@ -546,6 +548,7 @@ NsfMyCmdIdx, NsfNSCopyVarsCmdIdx, NsfNextCmdIdx, + NsfObjectAllocCmdIdx, NsfObjectExistsCmdIdx, NsfObjectPropertyCmdIdx, NsfObjectQualifyCmdIdx, @@ -1602,6 +1605,27 @@ } static int +NsfObjectAllocCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + ParseContext pc; + (void)clientData; + + if (likely(ArgumentParse(interp, objc, objv, NULL, objv[0], + method_definitions[NsfObjectAllocCmdIdx].paramDefs, + method_definitions[NsfObjectAllocCmdIdx].nrParameters, 0, NSF_ARGPARSE_BUILTIN, + &pc) == TCL_OK)) { + NsfClass *class = (NsfClass *)pc.clientData[0]; + Tcl_Obj *name = (Tcl_Obj *)pc.clientData[1]; + Tcl_Obj *initcmd = (Tcl_Obj *)pc.clientData[2]; + + assert(pc.status == 0); + return NsfObjectAllocCmd(interp, class, name, initcmd); + + } else { + return TCL_ERROR; + } +} + +static int NsfObjectExistsCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { (void)clientData; @@ -2700,7 +2724,7 @@ } } -static Nsf_methodDefinition method_definitions[105] = { +static Nsf_methodDefinition method_definitions[106] = { {"::nsf::methods::class::alloc", NsfCAllocMethodStub, 1, { {"objectName", NSF_ARG_REQUIRED, 1, Nsf_ConvertTo_Tclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, @@ -2925,6 +2949,11 @@ {"::nsf::next", NsfNextCmdStub, 1, { {"arguments", 0, 1, Nsf_ConvertTo_Tclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, +{"::nsf::object::alloc", NsfObjectAllocCmdStub, 3, { + {"class", NSF_ARG_REQUIRED, 1, Nsf_ConvertTo_Class, NULL,NULL,"class",NULL,NULL,NULL,NULL,NULL}, + {"name", NSF_ARG_REQUIRED, 1, Nsf_ConvertTo_Tclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, + {"initcmd", 0, 1, Nsf_ConvertTo_Tclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} +}, {"::nsf::object::exists", NsfObjectExistsCmdStub, 1, { {"value", NSF_ARG_REQUIRED, 1, Nsf_ConvertTo_Tclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, Index: generic/nsfAPI.nxdocindex =================================================================== diff -u -r6b5a68878186b49871d420ee8e8d5c0f2c073222 -rccb2c99f6fb6f381dfc7e300584ac08e3d2809d3 --- generic/nsfAPI.nxdocindex (.../nsfAPI.nxdocindex) (revision 6b5a68878186b49871d420ee8e8d5c0f2c073222) +++ generic/nsfAPI.nxdocindex (.../nsfAPI.nxdocindex) (revision ccb2c99f6fb6f381dfc7e300584ac08e3d2809d3) @@ -26,6 +26,7 @@ set ::nxdoc::include(::nsf::method::property) 1 set ::nxdoc::include(::nsf::method::registered) 1 set ::nxdoc::include(::nsf::method::setter) 1 +set ::nxdoc::include(::nsf::object::alloc) 0 set ::nxdoc::include(::nsf::object::exists) 1 set ::nxdoc::include(::nsf::object::property) 1 set ::nxdoc::include(::nsf::object::qualify) 1 Index: generic/nsfInt.h =================================================================== diff -u -r7c2e28b93b02c29f19dc1f58642c5a29a894d24e -rccb2c99f6fb6f381dfc7e300584ac08e3d2809d3 --- generic/nsfInt.h (.../nsfInt.h) (revision 7c2e28b93b02c29f19dc1f58642c5a29a894d24e) +++ generic/nsfInt.h (.../nsfInt.h) (revision ccb2c99f6fb6f381dfc7e300584ac08e3d2809d3) @@ -655,7 +655,8 @@ NSF_GUARD_OPTION, NSF___UNKNOWN__, NSF_ARRAY, NSF_GET, NSF_SET, NSF_OBJECT_UNKNOWN_HANDLER, NSF_ARGUMENT_UNKNOWN_HANDLER, /* Partly redefined Tcl commands; leave them together at the end */ - NSF_EXPR, NSF_FORMAT, NSF_INFO_BODY, NSF_INFO_FRAME, NSF_INTERP, NSF_IS, + NSF_EXPR, NSF_FORMAT, NSF_INFO_BODY, NSF_INFO_FRAME, NSF_INTERP, + NSF_IS, NSF_EVAL, NSF_RENAME } NsfGlobalNames; #if !defined(NSF_C) @@ -679,7 +680,8 @@ "::nsf::object::unknown", "::nsf::argument::unknown", /* tcl commands */ - "expr", "format", "::tcl::info::body", "::tcl::info::frame", "interp", "::tcl::string::is", + "expr", "format", "::tcl::info::body", "::tcl::info::frame", "interp", + "::tcl::string::is", "::eval", "rename" }; #endif Index: library/mongodb/nsfmongo.c =================================================================== diff -u -r4efb378df23679d6f48c8421cb9c57b9fc02697c -rccb2c99f6fb6f381dfc7e300584ac08e3d2809d3 --- library/mongodb/nsfmongo.c (.../nsfmongo.c) (revision 4efb378df23679d6f48c8421cb9c57b9fc02697c) +++ library/mongodb/nsfmongo.c (.../nsfmongo.c) (revision ccb2c99f6fb6f381dfc7e300584ac08e3d2809d3) @@ -572,7 +572,6 @@ result = mongo_run_command( connPtr, db, cmd, out ); bson_destroy( cmd ); - if (withNocomplain == 0 && result != MONGO_OK) { fprintf(stderr, "run result %d\n", result); return NsfPrintError(interp, "mongo::run: command '%s' returned an unknown error", ObjStr(cmdObj)); Index: library/nx/nx.tcl =================================================================== diff -u -reb758924a74f48512c98a40a539ab0c4e5a35de9 -rccb2c99f6fb6f381dfc7e300584ac08e3d2809d3 --- library/nx/nx.tcl (.../nx.tcl) (revision eb758924a74f48512c98a40a539ab0c4e5a35de9) +++ library/nx/nx.tcl (.../nx.tcl) (revision ccb2c99f6fb6f381dfc7e300584ac08e3d2809d3) @@ -1236,7 +1236,7 @@ } else { ::nsf::parameter:invalidate::classcache ${:domain} } - + nsf::object::property [self] initialized 1 # # plain object parameter have currently no setter/forwarder # @@ -2344,6 +2344,8 @@ # create an object without calling init # set obj [[$origin info class] create $dest -noinit] + #set obj [::nsf::object::alloc [$origin info class] $dest] + #puts stderr "COPY obj=<$obj>" } } Index: library/serialize/serializer.tcl =================================================================== diff -u -rf9488b47a7d554eea7a9f7ac820e339f312ca4a3 -rccb2c99f6fb6f381dfc7e300584ac08e3d2809d3 --- library/serialize/serializer.tcl (.../serializer.tcl) (revision f9488b47a7d554eea7a9f7ac820e339f312ca4a3) +++ library/serialize/serializer.tcl (.../serializer.tcl) (revision ccb2c99f6fb6f381dfc7e300584ac08e3d2809d3) @@ -203,9 +203,15 @@ set targetName $sourceName if {[array exists :objmap]} { foreach {source target} [array get :objmap] { + puts "[list regsub ^$source $targetName $target targetName]" regsub ^$source $targetName $target targetName } } + if {![string match ::* $targetName]} { + set targetName ::$targetName + } + #puts stderr "targetName of <$sourceName> = <$targetName>" + return $targetName } @@ -795,34 +801,37 @@ } :collect-var-traces $o $s + + set evalList [:collectVars $o $s] + + if {[$o info has type ::nx::Slot]} { + # Slots need to be explicitely initialized to ensure + # __invalidateobjectparameter to be called + lappend evalList :init + } + set objectName [::nsf::directdispatch $o -frame method ::nsf::current object] set isSlotContainer [::nx::isSlotContainer $objectName] if {$isSlotContainer} { append cmd [list ::nx::slotObj -container [namespace tail $objectName] \ [$s getTargetName [$objectName ::nsf::methods::object::info::parent]]]\n + if {[llength $evalList] > 0} { + append cmd [list ${:targetName} eval [join $evalList "\n "]]\n + } } else { #puts stderr "CREATE targetName '${:targetName}'" - append cmd [list [$o info class] create ${:targetName} -noinit]\n + append cmd [list ::nsf::object::alloc [$o info class] ${:targetName} [join $evalList "\n "]]\n foreach i [lsort [$o ::nsf::methods::object::info::methods -callprotection all -path]] { append cmd [:method-serialize $o $i "object"] "\n" } } - - set vars [:collectVars $o $s] - if {[llength $vars]>0} {append cmd [list ${:targetName} eval [join $vars "\n "]]\n} append cmd \ [:frameWorkCmd ::nsf::relation $o object-mixin] \ [:frameWorkCmd ::nsf::method::assertion $o object-invar] \ [:frameWorkCmd ::nsf::object::property $o keepcallerself -unless 0] \ [:frameWorkCmd ::nsf::object::property $o perobjectdispatch -unless 0] - if {[$o info has type ::nx::Slot]} { - # Slots needs to be initialized to ensure - # __invalidateobjectparameter to be called - append cmd [list ${:targetName} eval :init] \n - } - $s addPostCmd [:frameWorkCmd ::nsf::relation $o object-filter] return $cmd } @@ -940,8 +949,7 @@ :object method Object-serialize {o s} { :collect-var-traces $o $s - append cmd [list [$o info class] create ${:targetName}] - append cmd " -noinit\n" + append cmd [list ::nsf::object::alloc [$o info class] ${:targetName} [join [:collectVars $o $s] "\n "]]\n foreach i [$o ::nsf::methods::object::info::methods -type scripted -callprotection all] { append cmd [:method-serialize $o $i ""] "\n" } @@ -952,7 +960,6 @@ append cmd [list ${:targetName} parametercmd $i] "\n" } append cmd \ - [list ${:targetName} eval [join [:collectVars $o $s] "\n "]] \n \ [:frameWorkCmd ::nsf::relation $o object-mixin] \ [:frameWorkCmd ::nsf::method::assertion $o object-invar] Index: tests/serialize.test =================================================================== diff -u -r45e24b34c85bf0fc3e14db5250550100bd07ff31 -rccb2c99f6fb6f381dfc7e300584ac08e3d2809d3 --- tests/serialize.test (.../serialize.test) (revision 45e24b34c85bf0fc3e14db5250550100bd07ff31) +++ tests/serialize.test (.../serialize.test) (revision ccb2c99f6fb6f381dfc7e300584ac08e3d2809d3) @@ -18,6 +18,8 @@ ? {::a ref} [[::a::b] info children] set script [::Serializer deepSerialize -map {::a::b ::x::y ::a ::x} ::a] + # fix collateral damage (TODO: fixme, preprecate me, ...) + set script [string map {::nsf::object::xlloc ::nsf::object::alloc} $script] ::a destroy @@ -94,18 +96,20 @@ set C(IgnoreNone1) [list [::Serializer deepSerialize C] "x y"] set C(IgnoreNone2) [list [::Serializer deepSerialize -ignoreVarsRE "" C] "x y"] - set C(One) [list [::Serializer deepSerialize -ignoreVarsRE "x" C] "y"] + #set C(One) [list [::Serializer deepSerialize -ignoreVarsRE "x" C] "y"] set C(One2) [list [::Serializer deepSerialize -ignoreVarsRE {::x$} C] "y"] - set C(IgnoreAll) [list [::Serializer deepSerialize -ignoreVarsRE "." C] ""] + #set C(IgnoreAll) [list [::Serializer deepSerialize -ignoreVarsRE "." C] ""] set names {}; foreach s [C info object slots] {lappend names [$s name]} - set C(None2) [list [::Serializer deepSerialize \ - -ignoreVarsRE [join $names |] C] ""] + #set C(None2) [list [::Serializer deepSerialize -ignoreVarsRE [join $names |] C] ""] C destroy foreach t [array names C] { ? {nsf::object::exists C} 0 lassign $C($t) script res + + #puts stderr "=====C($t)\n$script\n====" + eval $script ? {nsf::object::exists C} 1 ? {lsort [C info vars]} $res "Class C $t" @@ -208,4 +212,4 @@ ? {::nsf::object::property ::C keepcallerself} 1 ? {::nsf::object::property ::C perobjectdispatch} 1 -} \ No newline at end of file +}