Index: library/nx/nx.tcl =================================================================== diff -u -r09b4bca7c8d5c44f6be0b2c04ebfcdb7a58fd5ae -rf177ffa3fb3583ff5e9879b1770f2cb23391b634 --- library/nx/nx.tcl (.../nx.tcl) (revision 09b4bca7c8d5c44f6be0b2c04ebfcdb7a58fd5ae) +++ library/nx/nx.tcl (.../nx.tcl) (revision f177ffa3fb3583ff5e9879b1770f2cb23391b634) @@ -1025,6 +1025,7 @@ MetaSlot public object method parseParameterSpec { {-class ""} {-defaultopts ""} + target spec default:optional } { @@ -1048,7 +1049,11 @@ } elseif {[string match type=* $property]} { set class [:requireClass ::nx::VariableSlot $class] set type [string range $property 5 end] - if {![string match ::* $type]} {set type ::$type} + if {$type eq ""} { + unset type + } elseif {![string match ::* $type]} { + set type [namespace qualifier $target]::$type + } } elseif {[string match arg=* $property]} { set argument [string range $property 4 end] lappend opts -arg $argument @@ -1088,7 +1093,7 @@ default:optional } { - lassign [:parseParameterSpec -class $class -defaultopts $defaultopts $spec] \ + lassign [:parseParameterSpec -class $class -defaultopts $defaultopts $target $spec] \ name parameterOptions class opts lappend opts -incremental $incremental @@ -2238,7 +2243,7 @@ #puts stderr "Object variable $spec accessor $accessor nocomplain $nocomplain incremental $incremental" # get name and list of parameter options - lassign [::nx::MetaSlot parseParameterSpec -class $class $spec] \ + lassign [::nx::MetaSlot parseParameterSpec -class $class [self] $spec] \ name parameterOptions class options array set opts $options Index: tests/parameters.test =================================================================== diff -u -r33d063a3296efd044652cba8668e25cef4797b66 -rf177ffa3fb3583ff5e9879b1770f2cb23391b634 --- tests/parameters.test (.../parameters.test) (revision 33d063a3296efd044652cba8668e25cef4797b66) +++ tests/parameters.test (.../parameters.test) (revision f177ffa3fb3583ff5e9879b1770f2cb23391b634) @@ -3367,9 +3367,61 @@ ? {set bar} 2 ? {set baz} hi + } + +# +# Testing name binding for type=/class/ converter +# + +nx::test case type-converter-binding { + # + # Binding strategy: Unqualified names are qualified by the namespace + # of the slot-owning object (domain). Resolution is lazy in the + # sense that a qualified name is produced but not resolved upon slot + # definition. + # + # set type [namespace qualifiers /obj/]::$type + # + # This has the same effect as (repeatedly) writing out + # type=[namespace current]::$type, or similar, as part of a property + # or variable spec. + # + + namespace eval :: { + namespace eval ns1 { + namespace eval ns2 { + nx::Class create A + } + nx::Class create A + nx::Class create B { + :property b1:object,type=A; # rewritten to ::ns1::A (not ::A as previously!). + ? [list [:info slots b1] cget -type] ::ns1::A + :property b2:object,type=ns2::A; # rewritten to ::ns1::ns2::A (not ::ns2::A as previously!). + ? [list [:info slots b2] cget -type] ::ns1::ns2::A + } + } + nx::Class create A { + :property a1:object,type=B; # rewritten to ::B + ? [list [:info slots a1] cget -type] ::B + :property a2:object,type=ns1::B; # rewritten to ::ns1::B + ? [list [:info slots a2] cget -type] ::ns1::B + :property a3:object,type=::B; # untouched + ? [list [:info slots a3] cget -type] ::B + :property a4:object,type=[expr {[namespace current] eq "::" ? "" : [namespace current]}]::B; # untouched, ::B + ? [list [:info slots a4] cget -type] ::B + :property a5:object,type=[namespace which B]; # untouched, "", will be dropped + ? [list [:info slots a5] cget -type] {can't read "type": no such variable} + } + nx::Class create B + } + + ? {catch {::ns1::B create b1 -b1 [::ns1::A new] -b2 [::ns1::ns2::A new]}} 0 + + } + # # Local variables: # mode: tcl