* generic/tclProc.c:

* generic/tclNamesp.c:
* generic/tclInt.h:
* generic/tclCmdIL.c:
* generic/tclBasic.c:
* generic/tclVar.c: Applied patch from Viktor Dukhovni to
rationalize TCL_LEAVE_ERR_MSG behavior when creating variables.

* generic/tclVar.c: Fixed bug in namespace tail computation.
Fixed bug where upvar could resurrect a namespace variable whose
namespace had been deleted.

* generic/tclCompile.c (TclCompileExprCmd): Eliminated yet another
bogus optimization in expression compilation.

* generic/tclCompile.c (CompileExprWord): Fixed exception stack
overflow bug caused by missing statement. [Bug: 928]

* generic/tclIOCmd.c:
* generic/tclBasic.c: Objectified the "open" command. [Bug: 1113]

1 files changed, 155 insertions, 39 deletions

diff --git a/tests/var.test b/tests/var.test
index 735b0ee..981c649 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: var.test,v 1.3 1998/09/14 18:40:15 stanton Exp $
+# RCS: @(#) $Id: var.test,v 1.4 1999/02/03 00:55:07 stanton Exp $
 #
 
 if {[string compare test [info procs test]] == 1} then {source defs}
@@ -113,6 +113,62 @@ test var-1.14 {TclLookupVar, namespace code ignores ":"s in middle and end of va
              [expr {[lsearch [info vars] x:y:] != -1}]
     }
 } {123 456 789 123 456 789 1 1 1}
+test var-1.15 {TclLookupVar, resurrect variable via upvar to deleted namespace: compiled code path} {
+    namespace eval test_ns_var {
+	variable foo 2
+    }
+    proc p {} {
+	variable ::test_ns_var::foo
+	lappend result [catch {set foo} msg] $msg
+	namespace delete ::test_ns_var
+	lappend result [catch {set foo 3} msg] $msg
+	lappend result [catch {set foo(3) 3} msg] $msg
+    }
+    p
+} {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}}
+test var-1.16 {TclLookupVar, resurrect variable via upvar to deleted namespace: uncompiled code path} {
+    namespace eval test_ns_var {
+	variable result
+	namespace eval subns {
+	    variable foo 2
+	}
+	upvar 0 subns::foo foo
+	lappend result [catch {set foo} msg] $msg
+	namespace delete subns
+	lappend result [catch {set foo 3} msg] $msg
+	lappend result [catch {set foo(3) 3} msg] $msg
+	namespace delete [namespace current]
+	set result
+    }
+} {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}}
+test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array: compiled code path} {
+    namespace eval test_ns_var {
+	variable result
+	proc p {} {
+	    array set x {1 2 3 4}
+	    upvar 0 x(1) foo
+	    lappend result [catch {set foo} msg] $msg
+	    unset x
+	    lappend result [catch {set foo 3} msg] $msg
+	}
+	set result [p]
+	namespace delete [namespace current]
+	set result
+    }
+} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
+test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} {
+    namespace eval test_ns_var {
+	variable result {}
+	variable x
+	array set x {1 2 3 4}
+	upvar 0 x(1) foo
+	lappend result [catch {set foo} msg] $msg
+	unset x
+	lappend result [catch {set foo 3} msg] $msg
+	namespace delete [namespace current]
+	set result
+    }
+} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
 
 test var-2.1 {Tcl_LappendObjCmd, create var if new} {
     catch {unset x}
@@ -389,6 +445,16 @@ test var-7.12 {Tcl_VariableObjCmd, variable cmd inside proc creates local link v
     }
     p
 } {{My name is empty} {{}}}
+test var-7.13 {Tcl_VariableObjCmd, variable named ":"} {
+    namespace eval test_ns_var {
+        variable : {My name is ":"}
+	proc p {} {
+	    variable :
+	    list [set :] [info vars]
+	}
+	p
+    }
+} {{My name is ":"} :}
 
 test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} {
     catch {namespace delete test_ns_var}
@@ -411,48 +477,98 @@ if {[info commands testsetnoerr] == {}} {
     puts "This application hasn't been compiled with the \"testsetnoerr\""
     puts "command, so I can't test TclSetVar etc."
 } else {
-test var-9.1 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
-	testsetnoerr v 1
-} 1
-test var-9.2 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
-	catch {unset v}
-	list [catch {testsetnoerr v} res] $res;
-} {1 {before get}}
-test var-9.3 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
-	catch {unset arr}
-	set arr(1) 1;
-	list [catch {testsetnoerr arr} res] $res;
-} {1 {before get}}
-test var-9.4 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
-	namespace eval ns {variable v nsv}
-	testsetnoerr ns::v;
-} nsv;
-test var-9.5 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
-	catch {namespace delete ns}
-	list [catch {testsetnoerr ns::v} res] $res;
-} {1 {before get}}
-test var-9.6 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
-	catch {unset arr}
-	set arr(1) 1;
-	list [catch {testsetnoerr arr 2} res] $res;
-} {1 {before set}}
-test var-9.7 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
-	catch {unset arr}
-	set arr(1) 1;
-	list [catch {testsetnoerr arr 2} res] $res;
-} {1 {before set}}
-test var-9.8 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
-    # this test currently fails, should not...
-    # (some namespace function resets the interp while it should not)
+test var-9.1 {behaviour of TclGet/SetVar simple get/set} {
+    catch {unset u}; catch {unset v}
+    list \
+       [set u a; testsetnoerr u] \
+       [testsetnoerr v b] \
+       [testseterr u] \
+       [unset v; testseterr v b]
+} [list {before get a} {before set b} {before get a} {before set b}]
+test var-9.2 {behaviour of TclGet/SetVar namespace get/set} {
+    catch {namespace delete ns}
+    namespace eval ns {variable u a; variable v}
+    list \
+       [testsetnoerr ns::u] \
+       [testsetnoerr ns::v b] \
+       [testseterr ns::u] \
+       [unset ns::v; testseterr ns::v b]
+} [list {before get a} {before set b} {before get a} {before set b}]
+test var-9.3 {behaviour of TclGetVar no variable} {
+    catch {unset u}
+    list \
+       [catch {testsetnoerr u} res] $res \
+       [catch {testseterr u} res] $res
+} {1 {before get} 1 {can't read "u": no such variable}}
+test var-9.4 {behaviour of TclGetVar no namespace variable} {
+    catch {namespace delete ns}
+    namespace eval ns {}
+    list \
+       [catch {testsetnoerr ns::w} res] $res \
+       [catch {testseterr ns::w} res] $res
+} {1 {before get} 1 {can't read "ns::w": no such variable}}
+test var-9.5 {behaviour of TclGetVar no namespace} {
     catch {namespace delete ns}
-    list [catch {testsetnoerr ns::v 1} res] $res;
-} {1 {before set}}
-test var-9.9 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
+    list \
+       [catch {testsetnoerr ns::u} res] $res \
+       [catch {testseterr ns::v} res] $res
+} {1 {before get} 1 {can't read "ns::v": no such variable}}
+test var-9.6 {behaviour of TclSetVar no namespace} {
+    catch {namespace delete ns}
+    list \
+       [catch {testsetnoerr ns::v 1} res] $res \
+       [catch {testseterr ns::v 1} res] $res
+} {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}}
+test var-9.7 {behaviour of TclGetVar array variable} {
+    catch {unset arr}
+    set arr(1) 1;
+    list \
+       [catch {testsetnoerr arr} res] $res \
+       [catch {testseterr arr} res] $res
+} {1 {before get} 1 {can't read "arr": variable is array}}
+test var-9.8 {behaviour of TclSetVar array variable} {
+    catch {unset arr}
+    set arr(1) 1
+    list \
+       [catch {testsetnoerr arr 2} res] $res \
+       [catch {testseterr arr 2} res] $res
+} {1 {before set} 1 {can't set "arr": variable is array}}
+test var-9.9 {behaviour of TclGetVar read trace success} {
+    proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
+    catch {unset u}; catch {unset v}
+    set u 10
+    trace var u r [list resetvar 1]
+    trace var v r [list resetvar 2]
+    list \
+       [testsetnoerr u] \
+       [testseterr v]
+} {{before get 1} {before get 2}}
+test var-9.10 {behaviour of TclGetVar read trace error} {
+    proc writeonly args {error "write-only"}
+    set v 456
+    trace var v r writeonly
+    list \
+       [catch {testsetnoerr v} msg] $msg \
+       [catch {testseterr v} msg] $msg
+} {1 {before get} 1 {can't read "v": write-only}}
+test var-9.11 {behaviour of TclSetVar write trace success} {
+    proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
+    catch {unset u}; catch {unset v}
+    set v 1
+    trace var v w doubleval
+    trace var u w doubleval
+    list \
+       [testsetnoerr u 2] \
+       [testseterr v 3]
+} {{before set 4} {before set 6}}
+test var-9.12 {behaviour of TclSetVar write trace error} {
     proc readonly args {error "read-only"}
     set v 456
     trace var v w readonly
-    list [catch {testsetnoerr v 2} msg] $msg
-} {1 {before set}}
+    list \
+       [catch {testsetnoerr v 2} msg] $msg $v \
+       [catch {testseterr v 3} msg] $msg $v
+} {1 {before set} 2 1 {can't set "v": read-only} 3}
 }
 
 catch {namespace delete ns}