Index: TODO =================================================================== diff -u -r5577ecfb071377c5e04f81074e25e2707d2c1400 -r033c63d771af5253b0e94c2a9c1c6a94df40242e --- TODO (.../TODO) (revision 5577ecfb071377c5e04f81074e25e2707d2c1400) +++ TODO (.../TODO) (revision 033c63d771af5253b0e94c2a9c1c6a94df40242e) @@ -1000,6 +1000,27 @@ - moved all exports of nsf to predefined.tcl - made imports in xotcl2 and nx explicit +- adjusted path in documentation system for nx/nx.tcl + +- Implemented "interp alias" support for classes. + In some cases. interp-aliased classes worked already + without additional code, but e.g. in "... -superclass C ..." + it failed. Without this feature, one could not reuse a + class with a different namespace, unless it was explicitely + "namespace exported" in the source. The problem was the + implementation of "::nx::Attribute", which should not be + exported in nx (most people do a "namespace import ::nx::*") + because there is no need to do so, but ::xotcl::Attribute + should reuse it - without subclassing). .... However, + we still seem to have a problem, when the interp-aliased + Class is exported and imported to a different namespace. + +- TODO: info methods shows finally "slots" and "slot". Wanted? Actually no. +- removed definition of slots from nx, changed regression tests + examples to to ::attribute instead of -slots + + + TODO: - nameing * self/current: @@ -1128,14 +1149,9 @@ - copy decls for objectMethod and classMethod as comments to xotcl.c, fix and check order -- don't namespace export nx::Attribute (since it is not user-visible - in most cases) but define instead +- should we continue to work on the problem of the interp-aliased class, + exported from one ns, imported into another one? - interp alias {} ::xotcl::Attribute {} ::nx::Attribute - - However, if we do this, "::xotcl::Class create Role -superclass Attribute" will fail - => check symmetry between "interp alias" and "namespace import" for Objects - - should we extract parameter decls from pseudo-comments from the c source each time we change .decls, we have to change the c-code as well. /* *TCL* Index: generic/xotcl.c =================================================================== diff -u -r5577ecfb071377c5e04f81074e25e2707d2c1400 -r033c63d771af5253b0e94c2a9c1c6a94df40242e --- generic/xotcl.c (.../xotcl.c) (revision 5577ecfb071377c5e04f81074e25e2707d2c1400) +++ generic/xotcl.c (.../xotcl.c) (revision 033c63d771af5253b0e94c2a9c1c6a94df40242e) @@ -626,8 +626,42 @@ /*fprintf(stderr, "GetClassFromObj %s base %p\n", objName, baseClass);*/ cmd = Tcl_GetCommandFromObj(interp, objPtr); + if (cmd) { cls = XOTclGetClassFromCmdPtr(cmd); + if (cls == NULL) { + /* + * We have a cmd, but no class; namesspace-imported classes are + * already resolved, but we have to care, if a class is + * "imported" via "interp alias". + */ + Tcl_Interp *alias_interp; + const char *alias_cmd_name; + Tcl_Obj *nameObj = objPtr; + Tcl_Obj **alias_ov; + int alias_oc = 0; + + if (!isAbsolutePath(objName)) { + nameObj = NameInNamespaceObj(interp, objName, callingNameSpace(interp)); + objName = ObjStr(nameObj); + /* adjust path for documented nx.tcl */ + } + + result = Tcl_GetAliasObj(interp, objName, + &alias_interp, &alias_cmd_name, &alias_oc, &alias_ov); + /* we only want aliases with 0 args */ + if (result == TCL_OK && alias_oc == 0) { + cmd = NSFindCommand(interp, alias_cmd_name, NULL); + /*fprintf(stderr, "..... alias arg 0 '%s' cmd %p\n", alias_cmd_name, cmd);*/ + if (cmd) { + cls = XOTclGetClassFromCmdPtr(cmd); + } + } + /*fprintf(stderr, "..... final cmd %p, cls %p\n", cmd , cls);*/ + if (nameObj != objPtr) { + DECR_REF_COUNT(nameObj); + } + } if (cls) { if (cl) *cl = cls; return TCL_OK; @@ -646,7 +680,7 @@ } } - /*fprintf(stderr, "try unknown, result so far is %d\n", result);*/ + /*fprintf(stderr, "try unknown for %s, result so far is %d\n", objName, result);*/ if (baseClass) { Tcl_Obj *methodObj, *nameObj = isAbsolutePath(objName) ? objPtr : NameInNamespaceObj(interp, objName, callingNameSpace(interp)); @@ -655,7 +689,8 @@ methodObj = XOTclMethodObj(interp, &baseClass->object, XO_c_requireobject_idx); if (methodObj) { - /*fprintf(stderr, "+++ calling __unknown for %s name=%s\n", objectName(baseClass), ObjStr(nameObj));*/ + /*fprintf(stderr, "+++ calling __unknown for %s name=%s\n", + className(baseClass), ObjStr(nameObj));*/ result = callMethod((ClientData) baseClass, interp, methodObj, 3, &nameObj, XOTCL_CM_NO_PROTECT); if (result == TCL_OK) { Index: library/nx/nx.tcl =================================================================== diff -u -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92 -r033c63d771af5253b0e94c2a9c1c6a94df40242e --- library/nx/nx.tcl (.../nx.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92) +++ library/nx/nx.tcl (.../nx.tcl) (revision 033c63d771af5253b0e94c2a9c1c6a94df40242e) @@ -59,7 +59,6 @@ foreach cmd [list recreate] { ::nsf::methodproperty Class $cmd protected 1 } - # TODO: info methods shows finally "slots" and "slot". Wanted? # protect some methods against redefinition ::nsf::methodproperty Object destroy redefine-protected true @@ -1212,8 +1211,10 @@ } } - Class forward slots %self contains \ - -object {%::nsf::dispatch [::nsf::current object] -objscope ::subst [::nsf::current object]::slot} + # TODO: This is the slots method.... remove it for now. + # + #Class forward slots %self contains \ + # -object {%::nsf::dispatch [::nsf::current object] -objscope ::subst [::nsf::current object]::slot} ################################################################## # copy/move implementation @@ -1395,7 +1396,7 @@ namespace export Object Class next self current # TODO should not be necessary in the future - namespace export Attribute + #namespace export Attribute set ::nx::confdir ~/.nx set ::nx::logdir $::nx::confdir/log Index: library/serialize/serializer.tcl =================================================================== diff -u -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92 -r033c63d771af5253b0e94c2a9c1c6a94df40242e --- library/serialize/serializer.tcl (.../serializer.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92) +++ library/serialize/serializer.tcl (.../serializer.tcl) (revision 033c63d771af5253b0e94c2a9c1c6a94df40242e) @@ -288,7 +288,7 @@ return $pre_cmds$result${:post_cmds}$exports } - :method deepSerialize o { + :method deepSerialize {o} { # assumes $o to be fully qualified set instances [Serializer allChildren $o] foreach oss [ObjectSystemSerializer info instances] { Index: library/xotcl/library/xotcl2.tcl =================================================================== diff -u -r5577ecfb071377c5e04f81074e25e2707d2c1400 -r033c63d771af5253b0e94c2a9c1c6a94df40242e --- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 5577ecfb071377c5e04f81074e25e2707d2c1400) +++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 033c63d771af5253b0e94c2a9c1c6a94df40242e) @@ -46,7 +46,10 @@ namespace import ::nsf::configure ::nsf::my ::nsf::next ::nsf::finalize ::nsf::interp namespace import ::nsf::alias ::nsf::is ::nsf::relation - namespace import ::nx::Attribute + #namespace import ::nx::Attribute + # if we do this, "::xotcl::Class create Role -superclass Attribute" will fail. + #interp alias {} ::xotcl::Attribute {} ::nx::Attribute + ::nx::Class create ::xotcl::Attribute -superclass ::nx::Attribute proc ::xotcl::self {{arg "object"}} { switch $arg { @@ -820,9 +823,6 @@ set ::xotcl::logdir $::xotcl::confdir/log namespace import ::nsf::tmpdir - # if we do this, "::xotcl::Class create Role -superclass Attribute" will fail. - #interp alias {} ::xotcl::Attribute {} ::nx::Attribute - # finally, export contents defined for XOTcl namespace export Object Class Attribute myproc myvar my self next @ } Index: library/xotcl/tests/slottest.xotcl =================================================================== diff -u -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92 -r033c63d771af5253b0e94c2a9c1c6a94df40242e --- library/xotcl/tests/slottest.xotcl (.../slottest.xotcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92) +++ library/xotcl/tests/slottest.xotcl (.../slottest.xotcl) (revision 033c63d771af5253b0e94c2a9c1c6a94df40242e) @@ -1,3 +1,4 @@ +# -*- Tcl -*- package require XOTcl; namespace import ::xotcl::* package require nx::test @@ -251,7 +252,9 @@ # } # } -::xotcl::Attribute mixin delete ::nx::Attribute::Optimizer +# maybe work directly on ::xotcl::Attribute would be nicer, when +# ::xotcl::Attribute would be true alias for ::nx::Attribute ... +::nx::Attribute mixin delete ::nx::Attribute::Optimizer Class C1 -parameter {a {b 10} {c "Hello World"}} C1 c1 -a 1 @@ -277,7 +280,7 @@ ? {c2 a} 1 "new indirect parametercmd" ? {c2 a 1} 1 "new indirect parametercmd" -::xotcl::Attribute mixin add ::nx::Attribute::Optimizer +::nx::Attribute mixin add ::nx::Attribute::Optimizer Class C3 -slots { Attribute create a Index: tests/aliastest.tcl =================================================================== diff -u -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92 -r033c63d771af5253b0e94c2a9c1c6a94df40242e --- tests/aliastest.tcl (.../aliastest.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92) +++ tests/aliastest.tcl (.../aliastest.tcl) (revision 033c63d771af5253b0e94c2a9c1c6a94df40242e) @@ -379,3 +379,33 @@ ? {C info methods -methodtype alias} FOO ? {c FOO} ::c->foo2 ? {C info method definition FOO} "::C alias FOO ::foo"; # should be ::foo2 (!) + + +# +# Check resolving of namespace imported classes +# and when a class is aliased via "interp alias" +# +Test case class-resolve { + namespace eval ::ns1 { + nx::Class create A {:method foo {} {::nx::current class}} + nx::Class create B {:method foo {} {::nx::current class}} + namespace export A + } + + namespace eval ::ns2 { + # namespace import Class A from namespace ns1 + namespace import ::ns1::A + ? {A create a1} ::ns2::a1 + ? {nx::Class create C -superclass A} ::ns2::C + ? {C create c1} ::ns2::c1 + ? {c1 foo} ::ns1::A + + # "import" Class B from namespace ns1 via interp-alias + interp alias {} ::ns2::B {} ::ns1::B + ? {B create b1} ::ns2::b1 + ? {b1 foo} ::ns1::B + ? {nx::Class create D -superclass B} ::ns2::D + ? {D create d1} ::ns2::d1 + ? {d1 foo} ::ns1::B + } +} \ No newline at end of file Index: tests/parameters.tcl =================================================================== diff -u -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92 -r033c63d771af5253b0e94c2a9c1c6a94df40242e --- tests/parameters.tcl (.../parameters.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92) +++ tests/parameters.tcl (.../parameters.tcl) (revision 033c63d771af5253b0e94c2a9c1c6a94df40242e) @@ -822,8 +822,14 @@ {expected object but got "xxx" for parameter o} \ "value is not an object" - ParamTest slots { - ::nx::Attribute create os -type object -multivalued true + #ParamTest slots { + # ::nx::Attribute create os -type object -multivalued true + #} + ParamTest eval { + :attribute os { + :type object + :multivalued true + } } ? {p os o} \ @@ -899,11 +905,24 @@ # slot specific converter ####################################################### Test case slot-specfic-converter { - Class create Person - Person slots { - ::nx::Attribute create sex -type "sex" { + # Class create Person + # Person slots { + # ::nx::Attribute create sex -type "sex" { + # :method type=sex {name value} { + # #puts stderr "[current] slot specific converter" + # switch -glob $value { + # m* {return m} + # f* {return f} + # default {error "expected sex but got $value"} + # } + # } + # } + # } + Class create Person { + :attribute sex { + :type "sex" :method type=sex {name value} { - #puts stderr "[current] slot specific converter" + #puts stderr "[self] slot specific converter" switch -glob $value { m* {return m} f* {return f}