Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | * generic/tclBinary.c: * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclDictObj.c: * generic/tclExecute.c: * generic/tclIOCmd.c: * generic/tclLink.c: * generic/tclTest.c: * generic/tclVar.c: fix for [Bug 1334947]. The functions TclPtrSetVar, Tcl_ObjSetVar2 and Tcl_SetVar2Ex now always consume the newValuePtr argument - i.e., they will free a 0-refCount object if they failed to set the variable. Fixed all callers in the core. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
510663a99e3a096bb7bab7314eb59fc8 |
User & Date: | msofer 2005-11-04 22:38:38.000 |
References
2023-03-30
| ||
19:01 | • Ticket [578155d5a1] Very rare bug (segfault) if set variable (with error case) using self-releasable object as new value status still Pending with 3 other changes artifact: 3228d41af0 user: pooryorick | |
2023-03-29
| ||
12:51 | • Ticket [578155d5a1]: 3 changes artifact: 2ec9fe372f user: sebres | |
2017-07-17
| ||
16:59 | • Ticket [578155d5a1]: 3 changes artifact: b39e14ba53 user: sebres | |
Context
2005-11-04
| ||
23:01 |
* win/tclWinPort.h: Applied patch #1267871 by Matt Newman for * win/tclWinPipe.c: extended error...check-in: e69a0476ef user: patthoyts tags: trunk | |
22:38 |
* generic/tclBinary.c: * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * gene...check-in: 510663a99e user: msofer tags: trunk | |
21:18 | RFE 1071992 check-in: d2c467e29a user: kennykb tags: trunk | |
Changes
Changes to ChangeLog.
1 2 3 4 5 6 7 | 2005-11-04 Kevin Kenny <[email protected]> * generic/tclGetDate.y: Added abbreviations for the Korean * library/clock.tcl: timezone. [Patch 1298737] * generic/tclDate.c: Regenerated. * tools/findBadExternals.tcl: Added this script, which locates | > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | 2005-11-04 Miguel Sofer <[email protected]> * generic/tclBinary.c: * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclDictObj.c: * generic/tclExecute.c: * generic/tclIOCmd.c: * generic/tclLink.c: * generic/tclTest.c: * generic/tclVar.c: fix for [Bug 1334947]. The functions TclPtrSetVar, Tcl_ObjSetVar2 and Tcl_SetVar2Ex now always consume the newValuePtr argument - i.e., they will free a 0-refCount object if they failed to set the variable. Fixed all callers in the core. 2005-11-04 Kevin Kenny <[email protected]> * generic/tclGetDate.y: Added abbreviations for the Korean * library/clock.tcl: timezone. [Patch 1298737] * generic/tclDate.c: Regenerated. * tools/findBadExternals.tcl: Added this script, which locates |
︙ | ︙ |
Changes to generic/tclBinary.c.
1 2 3 4 5 6 7 8 9 10 11 12 | /* * tclBinary.c -- * * This file contains the implementation of the "binary" Tcl built-in * command and the Tcl binary data object. * * Copyright (c) 1997 by Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | /* * tclBinary.c -- * * This file contains the implementation of the "binary" Tcl built-in * command and the Tcl binary data object. * * Copyright (c) 1997 by Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclBinary.c,v 1.27 2005/11/04 22:38:38 msofer Exp $ */ #include "tclInt.h" #include <math.h> /* |
︙ | ︙ | |||
1081 1082 1083 1084 1085 1086 1087 | #endif /* TCL_MEM_DEBUG */ resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); | < | 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 | #endif /* TCL_MEM_DEBUG */ resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); return TCL_ERROR; } offset += count; break; } case 'b': case 'B': { |
︙ | ︙ | |||
1136 1137 1138 1139 1140 1141 1142 | } resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); | < | 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 | } resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); return TCL_ERROR; } offset += (count + 7 ) / 8; break; } case 'h': case 'H': { |
︙ | ︙ | |||
1193 1194 1195 1196 1197 1198 1199 | } resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); | < | 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 | } resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); return TCL_ERROR; } offset += (count + 1) / 2; break; } case 'c': size = 1; |
︙ | ︙ | |||
1263 1264 1265 1266 1267 1268 1269 | } resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); | < | 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 | } resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, TCL_LEAVE_ERR_MSG); arg++; if (resultPtr == NULL) { DeleteScanNumberCache(numberCachePtr); return TCL_ERROR; } break; } case 'x': if (count == BINARY_NOCOUNT) { count = 1; |
︙ | ︙ |
Changes to generic/tclCmdAH.c.
1 2 3 4 5 6 7 8 9 10 11 12 | /* * tclCmdAH.c -- * * This file contains the top-level command routines for most of the Tcl * built-in commands whose names begin with the letters A to H. * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | /* * tclCmdAH.c -- * * This file contains the top-level command routines for most of the Tcl * built-in commands whose names begin with the letters A to H. * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclCmdAH.c,v 1.70 2005/11/04 22:38:38 msofer Exp $ */ #include "tclInt.h" #include <locale.h> #define NEW_FORMAT 1 |
︙ | ︙ | |||
263 264 265 266 267 268 269 | return TCL_ERROR; } } if (objc == 4) { Tcl_Obj *options = Tcl_GetReturnOptions(interp, result); if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL, options, 0)) { | < | 263 264 265 266 267 268 269 270 271 272 273 274 275 276 | return TCL_ERROR; } } if (objc == 4) { Tcl_Obj *options = Tcl_GetReturnOptions(interp, result); if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL, options, 0)) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't save return options in variable", NULL); return TCL_ERROR; } } |
︙ | ︙ | |||
1481 1482 1483 1484 1485 1486 1487 | */ #define STORE_ARY(fieldName, object) \ Tcl_SetStringObj(field, (fieldName), -1); \ value = (object); \ if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG)==NULL) { \ Tcl_DecrRefCount(field); \ | < | 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 | */ #define STORE_ARY(fieldName, object) \ Tcl_SetStringObj(field, (fieldName), -1); \ value = (object); \ if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG)==NULL) { \ Tcl_DecrRefCount(field); \ return TCL_ERROR; \ } Tcl_IncrRefCount(field); /* * Watch out porters; the inode is meant to be an *unsigned* value, so the |
︙ | ︙ | |||
1801 1802 1803 1804 1805 1806 1807 | if (result != TCL_OK) { Tcl_Panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i); } for (v=0 ; v<varcList[i] ; v++) { int k = index[i]++; Tcl_Obj *valuePtr, *varValuePtr; | < < < < < | 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 | if (result != TCL_OK) { Tcl_Panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i); } for (v=0 ; v<varcList[i] ; v++) { int k = index[i]++; Tcl_Obj *valuePtr, *varValuePtr; if (k < argcList[i]) { valuePtr = argvList[i][k]; } else { valuePtr = Tcl_NewObj(); /* empty string */ } varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v], NULL, valuePtr, 0); if (varValuePtr == NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't set loop variable: \"", TclGetString(varvList[i][v]), "\"", (char *) NULL); result = TCL_ERROR; goto done; } } |
︙ | ︙ |
Changes to generic/tclCmdIL.c.
︙ | ︙ | |||
12 13 14 15 16 17 18 | * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2005 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2005 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclCmdIL.c,v 1.84 2005/11/04 22:38:38 msofer Exp $ */ #include "tclInt.h" #include "tclRegexp.h" /* * During execution of the "lsort" command, structures of the following type |
︙ | ︙ | |||
1008 1009 1010 1011 1012 1013 1014 | } Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); } else { Tcl_Obj *nullObjPtr = Tcl_NewObj(); valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL, nullObjPtr, 0); if (valueObjPtr == NULL) { | < | 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 | } Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); } else { Tcl_Obj *nullObjPtr = Tcl_NewObj(); valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL, nullObjPtr, 0); if (valueObjPtr == NULL) { goto defStoreError; } Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); } return TCL_OK; } } |
︙ | ︙ | |||
2256 2257 2258 2259 2260 2261 2262 | * variable. */ Tcl_Obj *emptyObj = NULL; /* If non-NULL, an empty object created for * being assigned to variables once we have * run out of values from the list object. */ Tcl_Obj **listObjv; /* The contents of the list. */ int listObjc; /* The length of the list. */ int i; | > | | 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 | * variable. */ Tcl_Obj *emptyObj = NULL; /* If non-NULL, an empty object created for * being assigned to variables once we have * run out of values from the list object. */ Tcl_Obj **listObjv; /* The contents of the list. */ int listObjc; /* The length of the list. */ int i; Tcl_Obj *resPtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "list varname ?varname ...?"); return TCL_ERROR; } /* * First assign values out of the list to variables. |
︙ | ︙ | |||
2290 2291 2292 2293 2294 2295 2296 | /* * Make sure the reference count for the value being assigned is * greater than one (other reference minimally in the list) so we * can't get hammered by shimmering. */ Tcl_IncrRefCount(valueObj); | | | | > < | 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 | /* * Make sure the reference count for the value being assigned is * greater than one (other reference minimally in the list) so we * can't get hammered by shimmering. */ Tcl_IncrRefCount(valueObj); resPtr = Tcl_ObjSetVar2(interp, objv[i+2], NULL, valueObj, TCL_LEAVE_ERR_MSG); TclDecrRefCount(valueObj); if (resPtr == NULL) { if (emptyObj != NULL) { Tcl_DecrRefCount(emptyObj); } return TCL_ERROR; } } if (emptyObj != NULL) { Tcl_DecrRefCount(emptyObj); } /* * Now place a list of any values left over into the interpreter result. |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
11 12 13 14 15 16 17 | * Copyright (c) 1998-2000 Scriptics Corporation. * Copyright (c) 2002 ActiveState Corporation. * Copyright (c) 2003 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | * Copyright (c) 1998-2000 Scriptics Corporation. * Copyright (c) 2002 ActiveState Corporation. * Copyright (c) 2003 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclCmdMZ.c,v 1.133 2005/11/04 22:38:38 msofer Exp $ */ #include "tclInt.h" #include "tclRegexp.h" /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
363 364 365 366 367 368 369 | Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } } else { Tcl_Obj *valuePtr; valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0); if (valuePtr == NULL) { | < | 363 364 365 366 367 368 369 370 371 372 373 374 375 376 | Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } } else { Tcl_Obj *valuePtr; valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0); if (valuePtr == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", TclGetString(objv[i]), "\"", (char *) NULL); return TCL_ERROR; } } } |
︙ | ︙ | |||
2726 2727 2728 2729 2730 2731 2732 | * objects) in that case. */ if (indexVarObj != NULL) { TclNewObj(emptyObj); if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, emptyObj, TCL_LEAVE_ERR_MSG) == NULL) { | < < < < | 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 | * objects) in that case. */ if (indexVarObj != NULL) { TclNewObj(emptyObj); if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, emptyObj, TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } } if (matchVarObj != NULL) { if (emptyObj == NULL) { TclNewObj(emptyObj); } if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, emptyObj, TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } } goto matchFound; } else { switch (mode) { case OPT_EXACT: |
︙ | ︙ | |||
2825 2826 2827 2828 2829 2830 2831 | Tcl_ListObjAppendElement(NULL, matchesObj, substringObj); } } if (indexVarObj != NULL) { if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, indicesObj, TCL_LEAVE_ERR_MSG) == NULL) { | < < < < | 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 | Tcl_ListObjAppendElement(NULL, matchesObj, substringObj); } } if (indexVarObj != NULL) { if (Tcl_ObjSetVar2(interp, indexVarObj, NULL, indicesObj, TCL_LEAVE_ERR_MSG) == NULL) { /* * Careful! Check to see if we have allocated the list of * matched strings; if so (but there was an error assigning * the indices list) we have a potential memory leak because * the match list has not been written to a variable. Except * that we'll clean that up right now. */ if (matchesObj != NULL) { Tcl_DecrRefCount(matchesObj); } return TCL_ERROR; } } if (matchVarObj != NULL) { if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, matchesObj, TCL_LEAVE_ERR_MSG) == NULL) { /* * Unlike above, if indicesObj is non-NULL at this point, it * will have been written to a variable already and will hence * not be leaked. */ return TCL_ERROR; |
︙ | ︙ |
Changes to generic/tclDictObj.c.
1 2 3 4 5 6 7 8 9 10 11 | /* * tclDictObj.c -- * * This file contains functions that implement the Tcl dict object type * and its accessor command. * * Copyright (c) 2002 by Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | /* * tclDictObj.c -- * * This file contains functions that implement the Tcl dict object type * and its accessor command. * * Copyright (c) 2002 by Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclDictObj.c,v 1.39 2005/11/04 22:38:38 msofer Exp $ */ #include "tclInt.h" #include "tommath.h" /* * Forward declaration. |
︙ | ︙ | |||
1959 1960 1961 1962 1963 1964 1965 | } else { Tcl_Obj *incrPtr = Tcl_NewIntObj(1); Tcl_IncrRefCount(incrPtr); code = TclIncrObj(interp, valuePtr, incrPtr); Tcl_DecrRefCount(incrPtr); } } | < | > | > | < < | 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 | } else { Tcl_Obj *incrPtr = Tcl_NewIntObj(1); Tcl_IncrRefCount(incrPtr); code = TclIncrObj(interp, valuePtr, incrPtr); Tcl_DecrRefCount(incrPtr); } } if (code == TCL_OK) { Tcl_InvalidateStringRep(dictPtr); valuePtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (valuePtr == NULL) { code = TCL_ERROR; } else { Tcl_SetObjResult(interp, valuePtr); } } else if (dictPtr->refCount == 0) { Tcl_DecrRefCount(dictPtr); } return code; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
2052 2053 2054 2055 2056 2057 2058 | if (allocatedValue) { Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr); } else if (dictPtr->bytes != NULL) { Tcl_InvalidateStringRep(dictPtr); } | < < | 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 | if (allocatedValue) { Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr); } else if (dictPtr->bytes != NULL) { Tcl_InvalidateStringRep(dictPtr); } resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (resultPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } |
︙ | ︙ | |||
2125 2126 2127 2128 2129 2130 2131 | for (i=4 ; i<objc ; i++) { Tcl_AppendObjToObj(valuePtr, objv[i]); } Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr); | < < | 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 | for (i=4 ; i<objc ; i++) { Tcl_AppendObjToObj(valuePtr, objv[i]); } Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr); resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (resultPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } |
︙ | ︙ | |||
2305 2306 2307 2308 2309 2310 2311 | if (result != TCL_OK) { if (allocatedDict) { TclDecrRefCount(dictPtr); } return TCL_ERROR; } | < < | 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 | if (result != TCL_OK) { if (allocatedDict) { TclDecrRefCount(dictPtr); } return TCL_ERROR; } resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (resultPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } |
︙ | ︙ | |||
2365 2366 2367 2368 2369 2370 2371 | if (result != TCL_OK) { if (allocatedDict) { TclDecrRefCount(dictPtr); } return TCL_ERROR; } | < < | 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 | if (result != TCL_OK) { if (allocatedDict) { TclDecrRefCount(dictPtr); } return TCL_ERROR; } resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, TCL_LEAVE_ERR_MSG); if (resultPtr == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } |
︙ | ︙ | |||
2649 2650 2651 2652 2653 2654 2655 | static int DictUpdateCmd( Tcl_Interp *interp, int objc, Tcl_Obj *CONST *objv) { Tcl_Obj *dictPtr, *objPtr; | | | 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 | static int DictUpdateCmd( Tcl_Interp *interp, int objc, Tcl_Obj *CONST *objv) { Tcl_Obj *dictPtr, *objPtr; int i, result, dummy; Tcl_InterpState state; if (objc < 6 || objc & 1) { Tcl_WrongNumArgs(interp, 2, objv, "varName key varName ?key varName ...? script"); return TCL_ERROR; } |
︙ | ︙ | |||
2712 2713 2714 2715 2716 2717 2718 | if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) { Tcl_DiscardInterpState(state); return TCL_ERROR; } if (Tcl_IsShared(dictPtr)) { dictPtr = Tcl_DuplicateObj(dictPtr); | < | 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 | if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) { Tcl_DiscardInterpState(state); return TCL_ERROR; } if (Tcl_IsShared(dictPtr)) { dictPtr = Tcl_DuplicateObj(dictPtr); } /* * Write back the values from the variables, treating failure to read as * an instruction to remove the key. */ |
︙ | ︙ | |||
2737 2738 2739 2740 2741 2742 2743 | /* * Write the dictionary back to its variable. */ if (Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DiscardInterpState(state); | < < < | 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 | /* * Write the dictionary back to its variable. */ if (Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DiscardInterpState(state); return TCL_ERROR; } return Tcl_RestoreInterpState(interp, state); } /* |
︙ | ︙ | |||
2917 2918 2919 2920 2921 2922 2923 | /* * Write back the outermost dictionary to the variable. */ if (Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, TCL_LEAVE_ERR_MSG) == NULL) { | < < < | 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 | /* * Write back the outermost dictionary to the variable. */ if (Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DiscardInterpState(state); return TCL_ERROR; } return Tcl_RestoreInterpState(interp, state); } /* |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
8 9 10 11 12 13 14 | * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2002-2005 by Miguel Sofer. * Copyright (c) 2005 by Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2002-2005 by Miguel Sofer. * Copyright (c) 2005 by Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclExecute.c,v 1.220 2005/11/04 22:38:38 msofer Exp $ */ #include "tclInt.h" #include "tclCompile.h" #include "tommath.h" #include <math.h> |
︙ | ︙ | |||
5499 5500 5501 5502 5503 5504 5505 | listVarPtr = &(compiledLocals[listTmpIndex]); listPtr = listVarPtr->value.objPtr; Tcl_ListObjGetElements(interp, listPtr, &listLen, &elements); valIndex = (iterNum * numVars); for (j = 0; j < numVars; j++) { | < < < | 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 5509 5510 5511 5512 5513 | listVarPtr = &(compiledLocals[listTmpIndex]); listPtr = listVarPtr->value.objPtr; Tcl_ListObjGetElements(interp, listPtr, &listLen, &elements); valIndex = (iterNum * numVars); for (j = 0; j < numVars; j++) { if (valIndex >= listLen) { TclNewObj(valuePtr); } else { valuePtr = elements[valIndex]; } varIndex = varListPtr->varIndexes[j]; varPtr = &(compiledLocals[varIndex]); |
︙ | ︙ | |||
5534 5535 5536 5537 5538 5539 5540 | DECACHE_STACK_INFO(); value2Ptr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL, valuePtr, TCL_LEAVE_ERR_MSG); CACHE_STACK_INFO(); if (value2Ptr == NULL) { TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ", opnd, varIndex), Tcl_GetObjResult(interp)); | < < < | 5531 5532 5533 5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 | DECACHE_STACK_INFO(); value2Ptr = TclPtrSetVar(interp, varPtr, NULL, part1, NULL, valuePtr, TCL_LEAVE_ERR_MSG); CACHE_STACK_INFO(); if (value2Ptr == NULL) { TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ", opnd, varIndex), Tcl_GetObjResult(interp)); result = TCL_ERROR; goto checkForCatch; } } valIndex++; } listTmpIndex++; |
︙ | ︙ |
Changes to generic/tclIOCmd.c.
1 2 3 4 5 6 7 8 9 10 | /* * tclIOCmd.c -- * * Contains the definitions of most of the Tcl commands relating to IO. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | /* * tclIOCmd.c -- * * Contains the definitions of most of the Tcl commands relating to IO. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclIOCmd.c,v 1.33 2005/11/04 22:38:38 msofer Exp $ */ #include "tclInt.h" /* * Callback structure for accept callback in a TCP server. */ |
︙ | ︙ | |||
285 286 287 288 289 290 291 | return TCL_ERROR; } lineLen = -1; } if (objc == 3) { if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr, TCL_LEAVE_ERR_MSG) == NULL) { | < | 285 286 287 288 289 290 291 292 293 294 295 296 297 298 | return TCL_ERROR; } lineLen = -1; } if (objc == 3) { if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr, TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen)); return TCL_OK; } else { Tcl_SetObjResult(interp, linePtr); } |
︙ | ︙ |
Changes to generic/tclLink.c.
︙ | ︙ | |||
8 9 10 11 12 13 14 | * * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | * * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclLink.c,v 1.14 2005/11/04 22:38:38 msofer Exp $ */ #include "tclInt.h" /* * For each linked variable there is a data structure of the following type, * which describes the link and is the clientData for the trace set on the Tcl |
︙ | ︙ | |||
114 115 116 117 118 119 120 | } else { linkPtr->flags = 0; } objPtr = ObjValue(linkPtr); if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DecrRefCount(linkPtr->varName); | < | 114 115 116 117 118 119 120 121 122 123 124 125 126 127 | } else { linkPtr->flags = 0; } objPtr = ObjValue(linkPtr); if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DecrRefCount(linkPtr->varName); ckfree((char *) linkPtr); return TCL_ERROR; } code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr); if (code != TCL_OK) { |
︙ | ︙ |
Changes to generic/tclTest.c.
︙ | ︙ | |||
10 11 12 13 14 15 16 | * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Ajuba Solutions. * Copyright (c) 2003 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Ajuba Solutions. * Copyright (c) 2003 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclTest.c,v 1.99 2005/11/04 22:38:38 msofer Exp $ */ #define TCL_TEST #include "tclInt.h" /* * Required for Testregexp*Cmd |
︙ | ︙ | |||
3839 3840 3841 3842 3843 3844 3845 | } else { newPtr = Tcl_GetRange(objPtr, info.matches[ii].start, info.matches[ii].end - 1); } } valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, 0); if (valuePtr == NULL) { | < | 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 | } else { newPtr = Tcl_GetRange(objPtr, info.matches[ii].start, info.matches[ii].end - 1); } } valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, 0); if (valuePtr == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", Tcl_GetString(varPtr), "\"", NULL); return TCL_ERROR; } } /* |
︙ | ︙ |
Changes to generic/tclVar.c.
︙ | ︙ | |||
11 12 13 14 15 16 17 | * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclVar.c,v 1.115 2005/11/04 22:38:39 msofer Exp $ */ #include "tclInt.h" /* * The strings below are used to indicate what went wrong when a variable * access is denied. |
︙ | ︙ | |||
1386 1387 1388 1389 1390 1391 1392 | /* * Create an object holding the variable's new value and use Tcl_SetVar2Ex * to actually set the variable. */ valuePtr = Tcl_NewStringObj(newValue, -1); | < < < | 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 | /* * Create an object holding the variable's new value and use Tcl_SetVar2Ex * to actually set the variable. */ valuePtr = Tcl_NewStringObj(newValue, -1); varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, valuePtr, flags); if (varValuePtr == NULL) { return NULL; } return TclGetString(varValuePtr); } |
︙ | ︙ | |||
1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 | * TCL_LEAVE_ERR_MSG. */ { Var *varPtr, *arrayPtr; varPtr = TclLookupVar(interp, part1, part2, flags, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return NULL; } return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags); } | > > > | 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 | * TCL_LEAVE_ERR_MSG. */ { Var *varPtr, *arrayPtr; varPtr = TclLookupVar(interp, part1, part2, flags, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { if (newValuePtr->refCount == 0) { Tcl_DecrRefCount(newValuePtr); } return NULL; } return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags); } |
︙ | ︙ | |||
1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 | part1 = TclGetString(part1Ptr); part2 = ((part2Ptr == NULL) ? NULL : TclGetString(part2Ptr)); varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { return NULL; } return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags); } | > > > | 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 | part1 = TclGetString(part1Ptr); part2 = ((part2Ptr == NULL) ? NULL : TclGetString(part2Ptr)); varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr == NULL) { if (newValuePtr->refCount == 0) { Tcl_DecrRefCount(newValuePtr); } return NULL; } return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags); } |
︙ | ︙ | |||
1579 1580 1581 1582 1583 1584 1585 | if (flags & TCL_LEAVE_ERR_MSG) { if (TclIsVarArrayElement(varPtr)) { TclVarErrMsg(interp, part1, part2, "set", danglingElement); } else { TclVarErrMsg(interp, part1, part2, "set", danglingVar); } } | | | | | 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 | if (flags & TCL_LEAVE_ERR_MSG) { if (TclIsVarArrayElement(varPtr)) { TclVarErrMsg(interp, part1, part2, "set", danglingElement); } else { TclVarErrMsg(interp, part1, part2, "set", danglingVar); } } goto earlyError; } /* * It's an error to try to set an array variable itself. */ if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { TclVarErrMsg(interp, part1, part2, "set", isArray); } goto earlyError; } /* * Invoke any read traces that have been set for the variable if it is * requested; this is only done in the core when lappending. */ if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) { if (TCL_ERROR == TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { goto earlyError; } } /* * Set the variable's new value. If appending, append the new value to the * variable, either as a list element or as a string. Also, if appending, * then if the variable's old value is unshared we can modify it directly, |
︙ | ︙ | |||
1637 1638 1639 1640 1641 1642 1643 | TclDecrRefCount(oldValuePtr); oldValuePtr = varPtr->value.objPtr; Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */ } result = Tcl_ListObjAppendElement(interp, oldValuePtr, newValuePtr); if (result != TCL_OK) { | | | 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 | TclDecrRefCount(oldValuePtr); oldValuePtr = varPtr->value.objPtr; Tcl_IncrRefCount(oldValuePtr); /* since var is referenced */ } result = Tcl_ListObjAppendElement(interp, oldValuePtr, newValuePtr); if (result != TCL_OK) { goto earlyError; } } else { /* append string */ /* * We append newValuePtr's bytes but don't change its ref count. */ if (oldValuePtr == NULL) { |
︙ | ︙ | |||
1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 | */ cleanup: if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, arrayPtr); } return resultPtr; } /* *---------------------------------------------------------------------- * * TclIncrObjVar2 -- * | > > > > > > | 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 | */ cleanup: if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, arrayPtr); } return resultPtr; earlyError: if (newValuePtr->refCount == 0) { Tcl_DecrRefCount(newValuePtr); } goto cleanup; } /* *---------------------------------------------------------------------- * * TclIncrObjVar2 -- * |
︙ | ︙ | |||
1823 1824 1825 1826 1827 1828 1829 | /* TODO: Which of these flag values really make sense? */ CONST int flags) /* Various flags that tell how to incr value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ { register Tcl_Obj *varValuePtr, *newValuePtr = NULL; | | > > > < | | > | 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 | /* TODO: Which of these flag values really make sense? */ CONST int flags) /* Various flags that tell how to incr value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ { register Tcl_Obj *varValuePtr, *newValuePtr = NULL; int duplicated, code; varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags); if (varValuePtr == NULL) { Tcl_AddObjErrorInfo(interp, "\n (reading value of variable to increment)", -1); return NULL; } if (Tcl_IsShared(varValuePtr)) { duplicated = 1; varValuePtr = Tcl_DuplicateObj(varValuePtr); } else { duplicated = 0; } code = TclIncrObj(interp, varValuePtr, incrPtr); if (code == TCL_OK) { newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, varValuePtr, flags); } else if (duplicated) { Tcl_DecrRefCount(varValuePtr); } return newValuePtr; } /* *---------------------------------------------------------------------- * * Tcl_UnsetVar -- |
︙ | ︙ | |||
2327 2328 2329 2330 2331 2332 2333 | Tcl_LappendObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_Obj *varValuePtr, *newValuePtr; | | < < | 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 | Tcl_LappendObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_Obj *varValuePtr, *newValuePtr; int numElems, createdNewObj; Var *varPtr, *arrayPtr; char *part1; int result; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?"); return TCL_ERROR; } if (objc == 2) { newValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0); if (newValuePtr == NULL) { /* * The variable doesn't exist yet. Just create it with an empty * initial value. */ TclNewObj(varValuePtr); newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr, TCL_LEAVE_ERR_MSG); if (newValuePtr == NULL) { return TCL_ERROR; } } } else { /* * We have arguments to append. We used to call Tcl_SetVar2 to append * each argument one at a time to ensure that traces were run for each * append step. We now append the arguments all at once because it's * faster. Note that a read trace and a write trace for the variable * will now each only be called once. Also, if the variable's old * value is unshared we modify it directly, otherwise we create a new * copy to modify: this is "copy on write". */ createdNewObj = 0; /* * Use the TCL_TRACE_READS flag to ensure that if we have an array * with no elements set yet, but with a read trace on it, we will * create the variable and get read traces triggered. Note that you * have to protect the variable pointers around the TclPtrGetVar call * to insure that they remain valid even if the variable was undefined |
︙ | ︙ | |||
2399 2400 2401 2402 2403 2404 2405 | if (varValuePtr == NULL) { /* * We couldn't read the old value: either the var doesn't yet * exist or it's an array element. If it's new, we will try to * create it with Tcl_ObjSetVar2 below. */ | < | 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 | if (varValuePtr == NULL) { /* * We couldn't read the old value: either the var doesn't yet * exist or it's an array element. If it's new, we will try to * create it with Tcl_ObjSetVar2 below. */ TclNewObj(varValuePtr); createdNewObj = 1; } else if (Tcl_IsShared(varValuePtr)) { varValuePtr = Tcl_DuplicateObj(varValuePtr); createdNewObj = 1; } |
︙ | ︙ | |||
2428 2429 2430 2431 2432 2433 2434 | * error setting the new value, decrement its ref count if it was new * and we didn't create the variable. */ newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, varValuePtr, TCL_LEAVE_ERR_MSG); if (newValuePtr == NULL) { | < < < | 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 | * error setting the new value, decrement its ref count if it was new * and we didn't create the variable. */ newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, varValuePtr, TCL_LEAVE_ERR_MSG); if (newValuePtr == NULL) { return TCL_ERROR; } } /* * Set the interpreter's object result to refer to the variable's value * object. |
︙ | ︙ |