Tcl Source Code

Check-in [ee78d5d0a9]
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:Handle global/namespace variables better.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | info-linkedname
Files: files | file ages | folders
SHA3-256: ee78d5d0a91c94452c8e76dbc794d3293f2575a60bc06aedb740d5e6ae2fc6ca
User & Date: dkf 2018-10-30 19:16:02
Context
2018-10-30
19:16
Handle global/namespace variables better. Leaf check-in: ee78d5d0a9 user: dkf tags: info-linkedname
18:57
Tidy up further (comments, helper macros). More tests check-in: e9b8f2dd62 user: dkf tags: info-linkedname
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to doc/info.n.

327
328
329
330
331
332
333
334
335




336








337
338
339
340
341
342
343
.
Returns the name of the library directory in which standard Tcl
scripts are stored.
This is actually the value of the \fBtcl_library\fR
variable and may be changed by setting \fBtcl_library\fR.
.TP
\fBinfo linkedname \fIvarname\fR
.
\fIVarname\fR must be a link variable.




Returns the name of the variable it is linked to.








.TP
\fBinfo loaded \fR?\fIinterp\fR? ?\fIpackage\fR?
.
Returns the filename loaded as part of \fIpackage\fR. If \fIpackage\fR
is not specified, returns a list describing all of the packages
that have been loaded into \fIinterp\fR with the \fBload\fR command.
Each list element is a sub-list with two elements consisting of the






|
|
>
>
>
>
|
>
>
>
>
>
>
>
>







327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
.
Returns the name of the library directory in which standard Tcl
scripts are stored.
This is actually the value of the \fBtcl_library\fR
variable and may be changed by setting \fBtcl_library\fR.
.TP
\fBinfo linkedname \fIvarname\fR
.VS TIP471
Returns the name of the variable that link variable \fIvarname\fR is
ultimately linked to. This will be a fully qualified name if the variable
ultimately linked to is in a namespace (including the global namespace). Array
elements will be indicated by having
.QW \fB(\fR ,
the name of the element, and
.QW \fB)\fR
appended.
.RS
.PP
Link variables are (usually) local variables created by \fBupvar\fR,
\fBglobal\fR, \fBnamespace upvar\fR, and \fBvariable\fR.
.RE
.VE TIP471
.TP
\fBinfo loaded \fR?\fIinterp\fR? ?\fIpackage\fR?
.
Returns the filename loaded as part of \fIpackage\fR. If \fIpackage\fR
is not specified, returns a list describing all of the packages
that have been loaded into \fIinterp\fR with the \fBload\fR command.
Each list element is a sub-list with two elements consisting of the

Changes to generic/tclInt.h.

231
232
233
234
235
236
237


238
239
240
241
242
243
244
typedef struct NamespacePathEntry NamespacePathEntry;

/*
 * Special hashtable for variables: this is just a Tcl_HashTable with an nsPtr
 * field added at the end: in this way variables can find their namespace
 * without having to copy a pointer in their struct: they can access it via
 * their hPtr->tablePtr.


 */

typedef struct TclVarHashTable {
    Tcl_HashTable table;
    struct Namespace *nsPtr;
} TclVarHashTable;







>
>







231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
typedef struct NamespacePathEntry NamespacePathEntry;

/*
 * Special hashtable for variables: this is just a Tcl_HashTable with an nsPtr
 * field added at the end: in this way variables can find their namespace
 * without having to copy a pointer in their struct: they can access it via
 * their hPtr->tablePtr.
 *
 * Note that arrays further extend this. See ArrayVarHashTable in tclVar.c
 */

typedef struct TclVarHashTable {
    Tcl_HashTable table;
    struct Namespace *nsPtr;
} TclVarHashTable;

Changes to generic/tclVar.c.

1164
1165
1166
1167
1168
1169
1170

1171
1172
1173
1174




1175




1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
	Var *arrayPtr;
	int result = TCL_OK;

	if (TclIsVarDeadHash(varPtr)) {
	    return TCL_ERROR;
	}


	arrayPtr = TclGetVarArrayPtr(varPtr);
	if (arrayPtr) {
	    result = TclGetVarName(interp, arrayPtr, objPtr);
	    Tcl_AppendToObj(objPtr, "(", 1);




	}





	objNamePtr = VarHashGetKey(varPtr);
	Tcl_AppendObjToObj(objPtr, objNamePtr);

	if (arrayPtr) {
	    Tcl_AppendToObj(objPtr, ")", 1);
	}
	return result;
    }

    /*
     * Find varPtr in compiled locals from current or upper call frames.
     */






>




>
>
>
>
|
>
>
>
>
|
<
<
|
<
|







1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185


1186

1187
1188
1189
1190
1191
1192
1193
1194
	Var *arrayPtr;
	int result = TCL_OK;

	if (TclIsVarDeadHash(varPtr)) {
	    return TCL_ERROR;
	}

	objNamePtr = VarHashGetKey(varPtr);
	arrayPtr = TclGetVarArrayPtr(varPtr);
	if (arrayPtr) {
	    result = TclGetVarName(interp, arrayPtr, objPtr);
	    Tcl_AppendToObj(objPtr, "(", 1);
	    Tcl_AppendObjToObj(objPtr, objNamePtr);
	    Tcl_AppendToObj(objPtr, ")", 1);
	} else {
	    Tcl_Namespace *nsPtr = (Tcl_Namespace*) TclGetVarNsPtr(varPtr);

	    if (nsPtr) {
		Tcl_AppendToObj(objPtr, nsPtr->fullName, -1);
		if (nsPtr != Tcl_GetGlobalNamespace(interp)) {
		    Tcl_AppendToObj(objPtr, "::", 2);
		}


	    }

	    Tcl_AppendObjToObj(objPtr, objNamePtr);
	}
	return result;
    }

    /*
     * Find varPtr in compiled locals from current or upper call frames.
     */

Changes to tests/info.test.

2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
....
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
....
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
    set i 1
    apply {var {
	upvar 1 $var up
	return [info linkedname up]
    }} i
} -cleanup {
    unset -nocomplain i
} -result {i}
test info-41.2 {info linkedname - valid} -body {
    proc getname {var} {
	upvar 1 $var up
	return [info linkedname up]
    }
    proc p {i} {
	return [getname i]
................................................................................
    array set a {1 one 2 two}
    apply {{var idx} {
	upvar 1 ${var}($idx) up
	return [info linkedname up]
    }} a 1
} -cleanup {
    unset -nocomplain a
} -result {a(1)}
test info-41.4 {info linkedname - no such variable} -body {
    info linkedname foo
} -returnCodes error -result {can't access "foo": no such variable}
test info-41.5 {info linkedname - not a varlink object} -setup {
    unset -nocomplain i
} -body {
    set i 5
................................................................................
    apply {{} {
	variable ok
	set other 123
	return [list [info linkedname ok] [catch {info linkedname other} msg] $msg]
    }}
} -cleanup {
    unset -nocomplain ok
} -result {ok 1 {can't access "other": variable isn't a link}}
test info-41.7 {info linkedname - chain of links} -setup {
    unset -nocomplain ok
} -body {
    apply {v {
	apply {v {
	    upvar ok foo
	    apply {v {
		upvar foo(yes) bar






|







 







|







 







|
|







2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
....
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
....
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
    set i 1
    apply {var {
	upvar 1 $var up
	return [info linkedname up]
    }} i
} -cleanup {
    unset -nocomplain i
} -result ::i
test info-41.2 {info linkedname - valid} -body {
    proc getname {var} {
	upvar 1 $var up
	return [info linkedname up]
    }
    proc p {i} {
	return [getname i]
................................................................................
    array set a {1 one 2 two}
    apply {{var idx} {
	upvar 1 ${var}($idx) up
	return [info linkedname up]
    }} a 1
} -cleanup {
    unset -nocomplain a
} -result {::a(1)}
test info-41.4 {info linkedname - no such variable} -body {
    info linkedname foo
} -returnCodes error -result {can't access "foo": no such variable}
test info-41.5 {info linkedname - not a varlink object} -setup {
    unset -nocomplain i
} -body {
    set i 5
................................................................................
    apply {{} {
	variable ok
	set other 123
	return [list [info linkedname ok] [catch {info linkedname other} msg] $msg]
    }}
} -cleanup {
    unset -nocomplain ok
} -result {::ok 1 {can't access "other": variable isn't a link}}
test info-41.8 {info linkedname - chain of links} -setup {
    unset -nocomplain ok
} -body {
    apply {v {
	apply {v {
	    upvar ok foo
	    apply {v {
		upvar foo(yes) bar