Attachment "alias-8.4.patch" to
ticket [1590483fff]
added by
msofer
2006-11-04 21:54:51.
Index: generic/tclInterp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInterp.c,v
retrieving revision 1.20.2.2
diff -u -r1.20.2.2 tclInterp.c
--- generic/tclInterp.c 12 May 2003 22:35:40 -0000 1.20.2.2
+++ generic/tclInterp.c 4 Nov 2006 14:51:19 -0000
@@ -1172,6 +1172,7 @@
Master *masterPtr;
Tcl_Obj **prefv;
int new, i;
+ char *target;
aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias)
+ objc * sizeof(Tcl_Obj *)));
@@ -1182,6 +1183,14 @@
aliasPtr->objc = objc + 1;
prefv = &aliasPtr->objPtr;
+ target = TclGetString(targetNamePtr);
+ if ((*target != ':') || (*(target+1) != ':')) {
+ Tcl_Obj *newPtr = Tcl_NewStringObj("::", 2);
+ Tcl_AppendObjToObj(newPtr, targetNamePtr);
+ Tcl_IncrRefCount(targetNamePtr);
+ Tcl_DecrRefCount(targetNamePtr);
+ targetNamePtr = newPtr;
+ }
*prefv = targetNamePtr;
Tcl_IncrRefCount(targetNamePtr);
for (i = 0; i < objc; i++) {
Index: tests/basic.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/basic.test,v
retrieving revision 1.25.2.7
diff -u -r1.25.2.7 basic.test
--- tests/basic.test 18 Mar 2005 16:33:43 -0000 1.25.2.7
+++ tests/basic.test 4 Nov 2006 14:51:20 -0000
@@ -116,7 +116,7 @@
[catch {localP} msg] $msg \
[interp delete test_interp] \
[catch {localP} msg] $msg
-} {27 27 {} 1 {invalid command name "p"} {} 1 {invalid command name "localP"}}
+} {27 27 {} 1 {invalid command name "::p"} {} 1 {invalid command name "localP"}}
# NB: More tests about hide/expose are found in interp.test
Index: tests/interp.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/interp.test,v
retrieving revision 1.19.2.6
diff -u -r1.19.2.6 interp.test
--- tests/interp.test 28 Oct 2004 00:01:07 -0000 1.19.2.6
+++ tests/interp.test 4 Nov 2006 14:51:20 -0000
@@ -256,10 +256,10 @@
# Test 6.3 has been deleted.
test interp-7.3 {testing basic alias creation} {
a alias foo
-} in_master
+} ::in_master
test interp-7.4 {testing basic alias creation} {
a alias bar
-} {in_master a1 a2 a3}
+} {::in_master a1 a2 a3}
test interp-7.5 {testing basic alias creation} {
lsort [a aliases]
} {bar foo}
@@ -288,7 +288,7 @@
catch {interp create a}
a alias zop nonexistent-command-in-master
list [catch {a eval zop} msg] $msg
-} {1 {invalid command name "nonexistent-command-in-master"}}
+} {1 {invalid command name "::nonexistent-command-in-master"}}
test interp-9.2 {testing aliases for non-existent targets} {
catch {interp create a}
a alias zop nonexistent-command-in-master
@@ -306,7 +306,7 @@
rename p {}
interp delete a
set res
- } {{0 ENTER_A} {1 {invalid command name "p"}}}
+ } {{0 ENTER_A} {1 {invalid command name "::p"}}}
test interp-9.4 {testing aliases and namespace commands} {
proc p {} {return GLOBAL}
namespace eval tst {
@@ -349,7 +349,7 @@
interp create b
interp alias a a_alias b b_alias 1 2 3
list [catch {a eval a_alias a b c} msg] $msg
-} {1 {invalid command name "b_alias"}}
+} {1 {invalid command name "::b_alias"}}
test interp-10.4 {testing aliasing between interpreters} {
catch {interp delete a}
interp create a
@@ -797,7 +797,7 @@
catch {interp eval a foo} msg
interp delete a
set msg
-} {invalid command name "zop"}
+} {invalid command name "::zop"}
test interp-19.4 {alias deletion} {
catch {interp delete a}
interp create a
@@ -2121,7 +2121,7 @@
} {msg
while executing
"MyError "some secret""
- (procedure "MyTestAlias" line 2)
+ (procedure "::MyTestAlias" line 2)
invoked from within
"test"}
Index: tests/trace.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/trace.test,v
retrieving revision 1.26.2.17
diff -u -r1.26.2.17 trace.test
--- tests/trace.test 4 Nov 2006 01:37:56 -0000 1.26.2.17
+++ tests/trace.test 4 Nov 2006 14:51:21 -0000
@@ -1967,7 +1967,7 @@
bar 2
trace remove execution foo enter [list traceExecute foo]
set info
-} {{foo {foo 1 2} enter}}
+} {{foo {::foo 1 2} enter}}
test trace-26.2 {trace targetCmd when invoked through an alias} {
proc foo {args} {
set b $args
@@ -1980,7 +1980,7 @@
interp delete child
trace remove execution foo enter [list traceExecute foo]
set info
-} {{foo {foo 1 2} enter}}
+} {{foo {::foo 1 2} enter}}
test trace-27.1 {memory leak in rename trace (604609)} {
catch {rename bar {}}
