diff options
| -rw-r--r-- | generic/tclProc.c | 8 | ||||
| -rw-r--r-- | tests/proc.test | 16 |
2 files changed, 20 insertions, 4 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c index df927b8..48b482e 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -507,10 +507,11 @@ TclCreateProc( goto procError; } - nameLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[0]), fieldValues[0]->length); + argname = TclGetStringFromObj(fieldValues[0], &plen); + nameLength = Tcl_NumUtfChars(argname, plen); if (fieldCount == 2) { - valueLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[1]), - fieldValues[1]->length); + const char * value = TclGetString(fieldValues[1]); + valueLength = Tcl_NumUtfChars(value, fieldValues[1]->length); } else { valueLength = 0; } @@ -519,7 +520,6 @@ TclCreateProc( * Check that the formal parameter name is a scalar. */ - argname = TclGetStringFromObj(fieldValues[0], &plen); argnamei = argname; argnamelast = argname[plen-1]; while (plen--) { diff --git a/tests/proc.test b/tests/proc.test index bae5e15..1893d0f 100644 --- a/tests/proc.test +++ b/tests/proc.test @@ -110,6 +110,14 @@ test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple name proc p {b:a b::a} { } } -returnCodes error -result {formal parameter "b::a" is not a simple name} +test proc-1.9 {Tcl_ProcObjCmd, arguments via canonical list (string-representation bug [631b4c45df])} -body { + set v 2 + binary scan AB cc a b + proc p [list [list a $a] [list b $b] [list v [expr {$v + 2}]]] {expr {$a + $b + $v}} + p +} -result [expr {65+66+4}] -cleanup { + rename p {} +} test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} @@ -383,6 +391,14 @@ test proc-7.4 {Proc struct outlives its interp: Bug 3532959} { interp delete slave unset lambda } {} + +test proc-7.5 {[631b4c45df] Crash in argument processing} { + binary scan A c val + proc foo [list [list from $val]] {} + rename foo {} + unset -nocomplain val +} {} + # cleanup catch {rename p ""} |