Tcl Source Code

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

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

Overview
Comment:merge 8.6 (segfault fix)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256:0a8630528a56bdf73be735d9905cc4f22f3d63578f2890db3588f68849119906
User & Date: sebres 2018-09-07 12:02:25
Context
2018-09-07
12:11
merge 8.6 check-in: e891020c32 user: dgp tags: core-8-branch
12:04
merge 8.7 (segfault fix) check-in: 04f3cf7430 user: sebres tags: trunk
12:02
merge 8.6 (segfault fix) check-in: 0a8630528a user: sebres tags: core-8-branch
11:55
amend to [e8ab4d85fa], proc.test: extended with new test-case to cover situation like [631b4c45df] check-in: c4fe2825ef user: sebres tags: core-8-6-branch
2018-09-05
12:11
Minor code cleanup. win/tclWinPipe.c: Eliminate some compiler warnings on mingw-w64 win/tclWinNotif... check-in: 35eb0692c1 user: jan.nijtmans tags: core-8-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclProc.c.

501
502
503
504
505
506
507

508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument with no name", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}


	nameLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[0]), fieldValues[0]->length);
	if (fieldCount == 2) {
	    valueLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[1]),
		fieldValues[1]->length);
	} else {
	    valueLength = 0;
	}

	/*
	 * Check that the formal parameter name is a scalar.
	 */

	argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
	argnamei = argname;
	argnamelast = argname[plen-1];
	while (plen--) {
	    if (argnamei[0] == '(') {
		if (argnamelast == ')') {	/* We have an array element. */
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "formal parameter \"%s\" is an array element",







>
|

|
|








<







501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520

521
522
523
524
525
526
527
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument with no name", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}

	argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
	nameLength = Tcl_NumUtfChars(argname, plen);
	if (fieldCount == 2) {
	    const char * value = TclGetString(fieldValues[1]);
	    valueLength = Tcl_NumUtfChars(value, fieldValues[1]->length);
	} else {
	    valueLength = 0;
	}

	/*
	 * Check that the formal parameter name is a scalar.
	 */


	argnamei = argname;
	argnamelast = argname[plen-1];
	while (plen--) {
	    if (argnamei[0] == '(') {
		if (argnamelast == ')') {	/* We have an array element. */
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "formal parameter \"%s\" is an array element",

Changes to tests/proc.test.

106
107
108
109
110
111
112








113
114
115
116
117
118
119
} -result {formal parameter "a(1)" is an array element}
test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup {
    catch {rename p ""}
} -body {
    proc p {b:a b::a} {
    }
} -returnCodes error -result {formal parameter "b::a" is not a simple name}









test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename p ""}
} -body {
    proc p {} {return "p in [namespace current]"}
    info body p







>
>
>
>
>
>
>
>







106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
} -result {formal parameter "a(1)" is an array element}
test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup {
    catch {rename p ""}
} -body {
    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_*]}
    catch {rename p ""}
} -body {
    proc p {} {return "p in [namespace current]"}
    info body p