Tcl Source Code

Check-in [bc5e7bdafc]
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:stability fix: try to avoid segfault using released object, in error case of Tcl_ObjSetVar2, if newValuePtr self-released during set (lookup, by rewriting of interpreter state with error, by trace call, etc.), see ticket [578155d5a19b348d]. TODO: this is minimalist version of fix, so check this can be sane rewritten using something like flag TCL_OWN_OBJREF as suggested in ticket [578155d5a19b348d].
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | fix-8-5-578155d5a19b348d
Files: files | file ages | folders
SHA1: bc5e7bdafc922baf58dd0c0b77b9817a73338490
User & Date: sebres 2017-07-14 14:21:43
References
2018-01-16
12:19 Ticket [578155d5a1] Very rare bug (segfault) if set variable (with error case) using self-releasable object as new value status still Open with 3 other changes artifact: e6e0566929 user: sebres
Context
2017-07-14
14:21
stability fix: try to avoid segfault using released object, in error case of Tcl_ObjSetVar2, if newV... Leaf check-in: bc5e7bdafc user: sebres tags: fix-8-5-578155d5a19b348d
2017-07-13
15:03
Fix [293344d4f3]: Regression in SQLite test-suite. Long-standing bug in implementation of TclUtfToUn... check-in: 66a24e0413 user: jan.nijtmans tags: core-8-5-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclVar.c.

1736
1737
1738
1739
1740
1741
1742

1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753









1754
1755
1756
1757
1758
1759
1760
....
1803
1804
1805
1806
1807
1808
1809

1810
1811
1812
1813
1814
1815
1816
....
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
....
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
    Tcl_Obj *newValuePtr,	/* New value for variable. */
    int flags)			/* Various flags that tell how to set value:
				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
				 * TCL_LEAVE_ERR_MSG. */
{
    Var *varPtr, *arrayPtr;


    /*
     * Filter to pass through only the flags this interface supports.
     */

    flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG
	    |TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "set",
	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {
	if (newValuePtr->refCount == 0) {









	    Tcl_DecrRefCount(newValuePtr);
	}
	return NULL;
    }

    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
	    newValuePtr, flags, -1);
................................................................................
				 * TCL_LEAVE_ERR_MSG bits. */
    int index)			/* Index of local var where part1 is to be
				 * found. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *oldValuePtr;
    Tcl_Obj *resultPtr = NULL;

    int result;

    /*
     * If the variable is in a hashtable and its hPtr field is NULL, then we
     * may have an upvar to an array element where the array was deleted or an
     * upvar to a namespace variable whose namespace was deleted. Generate an
     * error (allowing the variable to be reset would screw up our storage
................................................................................
		    TclContinuationsCopy (varPtr->value.objPtr, oldValuePtr);

		    TclDecrRefCount(oldValuePtr);
		    oldValuePtr = varPtr->value.objPtr;
		    Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
		}
		Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
		if (newValuePtr->refCount == 0) {
		    Tcl_DecrRefCount(newValuePtr);
		}
	    }
	}
    } else if (newValuePtr != oldValuePtr) {
	/*
	 * In this case we are replacing the value, so we don't need to do
................................................................................
  cleanup:
    if (TclIsVarUndefined(varPtr)) {
	TclCleanupVar(varPtr, arrayPtr);
    }
    return resultPtr;

  earlyError:
    if (newValuePtr->refCount == 0) {
	Tcl_DecrRefCount(newValuePtr);
    }
    goto cleanup;
}
 
/*
 *----------------------------------------------------------------------






>










<
>
>
>
>
>
>
>
>
>







 







>







 







|







 







|







1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753

1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
....
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
....
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
....
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
    Tcl_Obj *newValuePtr,	/* New value for variable. */
    int flags)			/* Various flags that tell how to set value:
				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
				 * TCL_LEAVE_ERR_MSG. */
{
    Var *varPtr, *arrayPtr;
    int newValRefCnt = newValuePtr->refCount; /* save original refCount */

    /*
     * Filter to pass through only the flags this interface supports.
     */

    flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG
	    |TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "set",
	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {

	/* 
	 * Free newValuePtr only if it had previously no references (otherwise
	 * the pointer newValRefCnt may be already released (during lookup, 
	 * by rewriting of interpreter state with error, by trace call, etc.)
	 *
	 * TODO: check this can be sane rewritten using something like flag
	 * TCL_OWN_OBJREF as suggested in ticket [578155d5a19b348d].
	 */
	if (newValRefCnt == 0) { /* not set and no other references */
	    Tcl_DecrRefCount(newValuePtr);
	}
	return NULL;
    }

    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
	    newValuePtr, flags, -1);
................................................................................
				 * TCL_LEAVE_ERR_MSG bits. */
    int index)			/* Index of local var where part1 is to be
				 * found. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *oldValuePtr;
    Tcl_Obj *resultPtr = NULL;
    int newValRefCnt = newValuePtr->refCount;  /* save original refCount */
    int result;

    /*
     * If the variable is in a hashtable and its hPtr field is NULL, then we
     * may have an upvar to an array element where the array was deleted or an
     * upvar to a namespace variable whose namespace was deleted. Generate an
     * error (allowing the variable to be reset would screw up our storage
................................................................................
		    TclContinuationsCopy (varPtr->value.objPtr, oldValuePtr);

		    TclDecrRefCount(oldValuePtr);
		    oldValuePtr = varPtr->value.objPtr;
		    Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
		}
		Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
		if (newValRefCnt == 0) { /* not set and no other references */
		    Tcl_DecrRefCount(newValuePtr);
		}
	    }
	}
    } else if (newValuePtr != oldValuePtr) {
	/*
	 * In this case we are replacing the value, so we don't need to do
................................................................................
  cleanup:
    if (TclIsVarUndefined(varPtr)) {
	TclCleanupVar(varPtr, arrayPtr);
    }
    return resultPtr;

  earlyError:
    if (newValRefCnt == 0) { /* not set and no other references */
	Tcl_DecrRefCount(newValuePtr);
    }
    goto cleanup;
}
 
/*
 *----------------------------------------------------------------------