Tcl Library Source Code

Check-in [b9ccb9de72]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:namespacex - Forward porting commit [ccd9433cb2abd51c] Part 2: Bug fix. Fixed the mishandling of relative namespace arguments if they are not refering to a child of the global namespace :: The bug fix is accepted as is from the original commit, with thanks to Pooryorick (Nathan Coulter).
Timelines: family | ancestors | descendants | both | gam-namespacex-improve
Files: files | file ages | folders
SHA3-256: b9ccb9de72184c7fc9ff12761f1da1c6b05a320ce944ef1ade2d2ca0ce3932a0
User & Date: aku 2019-03-01 07:14:01
Original Comment: namespacex - Forward porting commit [ccd9433cb2abd51c] Part 1: Bug fix. Fixed the mishandling of relative namespace arguments if they are not refering to a child of the global namespace :: The bug fix is accepted as is from the original commit, with thanks to Pooryorick (Nathan Coulter).
Context
2019-03-02
04:17
namespacex - Fill in Extended testsuite to cover new commands `normalize` and `strip`. Extended testsuite to cover wrong#args for `import`. Fixed typo in documentation of `strip`. Split `strip` into public and internal forms, with the public form performing argument normalization and checking not required by the internal form (*), and documented for the public. (*) The internal form has only a minimal check asserting that the prefix namespace is given as an FQN. Closed-Leaf check-in: e993dd5c68 user: aku tags: gam-namespacex-improve
2019-03-01
07:14
namespacex - Forward porting commit [ccd9433cb2abd51c] Part 2: Bug fix. Fixed the mishandling of relative namespace arguments if they are not refering to a child of the global namespace :: The bug fix is accepted as is from the original commit, with thanks to Pooryorick (Nathan Coulter). check-in: b9ccb9de72 user: aku tags: gam-namespacex-improve
07:09
namespacex - Forward porting commit [ccd9433cb2abd51c] Part 1: Tests. Extended the testsuite to demonstrate that the current command implementations mishandle relative namespace arguments if they are not refering to a child of the global namespace :: Note, the changes made here diverge totally from the changes made in the original commit. Explicitly added new tests to cover the mishandled cases, leaving the existing coverage intact. The original commit OTOH shifted the entire testsuite over to cover relative namespace names, retracting the coverage for fully-qualified namespace names. check-in: 022a85f807 user: aku tags: gam-namespacex-improve
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/namespacex/namespacex.tcl.

213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238

239
240
241
242
243
244
245
...
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
    } finally {
	namespace eval $from [list ::namespace export -clear {*}$orig]
    }
    return
}

proc ::namespacex::info::allvars {ns} {
    if {![string match {::*} $ns]} { set ns ::$ns }
    ::set result [::info vars ${ns}::*]
    foreach cns [allchildren $ns] {
	lappend result {*}[::info vars ${cns}::*]
    }
    return [::namespacex::strip $ns $result]
}

proc ::namespacex::info::allchildren {ns} {
    if {![string match {::*} $ns]} { set ns ::$ns }
    ::set result [list]
    foreach cns [::namespace children $ns] {
	lappend result {*}[allchildren $cns]
	lappend result $cns
    }
    return $result
}

proc ::namespacex::info::vars {ns {pattern *}} {

    return [::namespacex::strip $ns [::info vars ${ns}::$pattern]]
}

# this implementation avoids string operations
proc ::namespacex::normalize {ns} {
    if {[uplevel 1 [list ::namespace exists $ns]]} {
	return [uplevel 1 [list namespace eval $ns {::namespace current}]]
................................................................................
    return $result
}

# # ## ### ##### ######## ############# ######################
## Implementation :: State - Visible API

proc ::namespacex::state::drop {ns} {
    if {![string match {::*} $ns]} { ::set ns ::$ns }
    namespace eval $ns [list ::unset {*}[::namespacex info allvars $ns]]
    return
}

proc ::namespacex::state::get {ns} {
    if {![string match {::*} $ns]} { ::set ns ::$ns }
    ::set result {}
    foreach v [::namespacex info allvars $ns] {
	namespace upvar $ns $v value
	lappend result $v $value
    }
    return $result
}

proc ::namespacex::state::set {ns state} {
    if {![string match {::*} $ns]} { ::set ns ::$ns }
    # Inlined 'state drop'.
    namespace eval $ns [list ::unset  {*}[::namespacex info allvars $ns]]
    namespace eval $ns [list variable {*}$state]
    return
}

# # ## ### ##### ######## ############# ######################
## Ready

package provide namespacex 0.2






|








|









>







 







|





|









|










213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
...
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
    } finally {
	namespace eval $from [list ::namespace export -clear {*}$orig]
    }
    return
}

proc ::namespacex::info::allvars {ns} {
    set ns [uplevel 1 [list [namespace parent] normalize $ns]]
    ::set result [::info vars ${ns}::*]
    foreach cns [allchildren $ns] {
	lappend result {*}[::info vars ${cns}::*]
    }
    return [::namespacex::strip $ns $result]
}

proc ::namespacex::info::allchildren {ns} {
    set ns [uplevel 1 [list [namespace parent] normalize $ns]]
    ::set result [list]
    foreach cns [::namespace children $ns] {
	lappend result {*}[allchildren $cns]
	lappend result $cns
    }
    return $result
}

proc ::namespacex::info::vars {ns {pattern *}} {
    set ns [uplevel 1 [list [namespace parent] normalize $ns]]
    return [::namespacex::strip $ns [::info vars ${ns}::$pattern]]
}

# this implementation avoids string operations
proc ::namespacex::normalize {ns} {
    if {[uplevel 1 [list ::namespace exists $ns]]} {
	return [uplevel 1 [list namespace eval $ns {::namespace current}]]
................................................................................
    return $result
}

# # ## ### ##### ######## ############# ######################
## Implementation :: State - Visible API

proc ::namespacex::state::drop {ns} {
    ::set ns [uplevel 1 [list [namespace parent] normalize $ns]]
    namespace eval $ns [list ::unset {*}[::namespacex info allvars $ns]]
    return
}

proc ::namespacex::state::get {ns} {
    ::set ns [uplevel 1 [list [namespace parent] normalize $ns]]
    ::set result {}
    foreach v [::namespacex info allvars $ns] {
	namespace upvar $ns $v value
	lappend result $v $value
    }
    return $result
}

proc ::namespacex::state::set {ns state} {
    ::set ns [uplevel 1 [list [namespace parent] normalize $ns]]
    # Inlined 'state drop'.
    namespace eval $ns [list ::unset  {*}[::namespacex info allvars $ns]]
    namespace eval $ns [list variable {*}$state]
    return
}

# # ## ### ##### ######## ############# ######################
## Ready

package provide namespacex 0.2