Tcl Source Code

Check-in [2bcfea1433]
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:merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-6-1 | rc2 | core-8-6-1-rc
Files: files | file ages | folders
SHA1: 2bcfea14339065f5bc3c9afe4d48f287608586ac
User & Date: dgp 2013-09-19 20:07:41
Context
2016-09-08
12:22
merge 8.6.1 check-in: 65981cfc14 user: dgp tags: dgp-literal-reform
2013-09-20
05:28
merge release check-in: 63009ab07c user: dgp tags: trunk
2013-09-19
20:07
merge trunk Closed-Leaf check-in: 2bcfea1433 user: dgp tags: core-8-6-1, rc2, core-8-6-1-rc
19:37
[3970f54c4e]: Corrected regression in argument order processing in [unset]. check-in: 836d61598d user: dkf tags: trunk
19:10
merge trunk; update changes check-in: c81d39a8aa user: dgp tags: core-8-6-1-rc
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclCompCmdsSZ.c.

2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824


















2825


2826
2827

2828
2829
2830


2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr;
    int isScalar, localIndex, flags, i;
    Tcl_Obj *leadingWord;
    DefineLineInformation;	/* TIP #280 */

    /* TODO: Consider support for compiling expanded args. */
    flags = 1;
    i = 1;


















    varTokenPtr = TokenAfter(parsePtr->tokenPtr);


    leadingWord = Tcl_NewObj();
    if (parsePtr->numWords > 1 && TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {

	int len;
	const char *bytes = Tcl_GetStringFromObj(leadingWord, &len);



	if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
	    flags = 0;
	    varTokenPtr = TokenAfter(varTokenPtr);
	    i++;
	} else if (len == 2 && !strncmp("--", bytes, 2)) {
	    varTokenPtr = TokenAfter(varTokenPtr);
	    i++;
	}
    } else {
	/*
	 * Cannot guarantee that the first word is not '-nocomplain' at
	 * evaluation with reasonable effort, so spill to interpreted version.
	 */

	TclDecrRefCount(leadingWord);
	return TCL_ERROR;
    }
    TclDecrRefCount(leadingWord);

    for ( ; i<parsePtr->numWords ; i++) {
	/*
	 * Decide if we can use a frame slot for the var/array name or if we
	 * need to emit code to compute and push the name at runtime. We use a
	 * frame slot (entry in the array of local vars) if we are compiling a
	 * procedure body and if the name is simple text that does not include






|
<



<
<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
|
<
>

<

>
>








<
<
<
<
<
<

<

<







2811
2812
2813
2814
2815
2816
2817
2818

2819
2820
2821


2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843

2844
2845

2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856






2857

2858

2859
2860
2861
2862
2863
2864
2865
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr;
    int isScalar, localIndex, flags = 1, i;

    DefineLineInformation;	/* TIP #280 */

    /* TODO: Consider support for compiling expanded args. */



    /*
     * Verify that all words are known at compile time so that we can handle
     * them without needing to do a nasty push/rotate. [Bug 3970f54c4e]
     */

    for (i=1,varTokenPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) {
	varTokenPtr = TokenAfter(varTokenPtr);
	if (!TclWordKnownAtCompileTime(varTokenPtr, NULL)) {
	    return TCL_ERROR;
	}
    }

    /*
     * Check for options; if they're present we'll know for sure because we
     * know we're all constant arguments.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    i = 1;
    if (parsePtr->numWords > 1) {
	Tcl_Obj *leadingWord = Tcl_NewObj();

	const char *bytes;
	int len;


	(void) TclWordKnownAtCompileTime(varTokenPtr, leadingWord);
	bytes = Tcl_GetStringFromObj(leadingWord, &len);
	if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
	    flags = 0;
	    varTokenPtr = TokenAfter(varTokenPtr);
	    i++;
	} else if (len == 2 && !strncmp("--", bytes, 2)) {
	    varTokenPtr = TokenAfter(varTokenPtr);
	    i++;
	}






	TclDecrRefCount(leadingWord);

    }


    for ( ; i<parsePtr->numWords ; i++) {
	/*
	 * Decide if we can use a frame slot for the var/array name or if we
	 * need to emit code to compute and push the name at runtime. We use a
	 * frame slot (entry in the array of local vars) if we are compiling a
	 * procedure body and if the name is simple text that does not include

Changes to tests/var.test.

744
745
746
747
748
749
750



751
752
753
754
755
756
757
    # Note that the variable name has to be 
    # unused previously for the segfault to
    # be triggered.
    #
    namespace eval test A useSomeUnlikelyNameHere
    namespace eval test unset useSomeUnlikelyNameHere
} {}




test var-16.1 {CallVarTraces: save/restore interp error state} {
    trace add variable ::errorCode write " ;#"
    catch {error foo bar baz}
    trace remove variable ::errorCode write " ;#"
    set ::errorInfo
} bar






>
>
>







744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
    # Note that the variable name has to be 
    # unused previously for the segfault to
    # be triggered.
    #
    namespace eval test A useSomeUnlikelyNameHere
    namespace eval test unset useSomeUnlikelyNameHere
} {}
test var-15.2 {compiled unset evaluation order, Bug 3970f54c4e} {
    apply {{} {unset foo [return ok]}}
} ok

test var-16.1 {CallVarTraces: save/restore interp error state} {
    trace add variable ::errorCode write " ;#"
    catch {error foo bar baz}
    trace remove variable ::errorCode write " ;#"
    set ::errorInfo
} bar