From 20830f1de990be20541f5a22ef27c99aeeb0174d Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 13 Jan 2004 17:26:42 +0000 Subject: * generic/tclFileName.c (Tcl_GlobObjCmd): Latest changes to management of the interp result by Tcl_GetIndexFromObj() exposed improper interp result management in the [glob] command procedure. Corrected by adopting the Tcl_SetObjResult(Tcl_NewStringObj) pattern. This stopped a segfault in test filename-11.36. --- ChangeLog | 8 ++++++++ generic/tclFileName.c | 40 ++++++++++++++++------------------------ 2 files changed, 24 insertions(+), 24 deletions(-) diff --git a/ChangeLog b/ChangeLog index e6d0be0..984d917 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2004-01-13 Don Porter + + * generic/tclFileName.c (Tcl_GlobObjCmd): Latest changes to + management of the interp result by Tcl_GetIndexFromObj() exposed + improper interp result management in the [glob] command procedure. + Corrected by adopting the Tcl_SetObjResult(Tcl_NewStringObj) pattern. + This stopped a segfault in test filename-11.36. + 2004-01-13 Donal K. Fellows * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct, Tcl_WrongNumArgs): diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 6d7a41c..bc314cf 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclFileName.c,v 1.40.2.5 2003/10/06 09:49:19 vincentdarley Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.40.2.6 2004/01/13 17:26:42 dgp Exp $ */ #include "tclInt.h" @@ -1585,7 +1585,6 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv) join = 0; dir = PATH_NONE; typePtr = NULL; - resultPtr = Tcl_GetObjResult(interp); for (i = 1; i < objc; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { @@ -1611,14 +1610,14 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv) break; case GLOB_DIR: /* -dir */ if (i == (objc-1)) { - Tcl_AppendToObj(resultPtr, - "missing argument to \"-directory\"", -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing argument to \"-directory\"", -1)); return TCL_ERROR; } if (dir != PATH_NONE) { - Tcl_AppendToObj(resultPtr, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-directory\" cannot be used with \"-path\"", - -1); + -1)); return TCL_ERROR; } dir = PATH_DIR; @@ -1634,14 +1633,14 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv) break; case GLOB_PATH: /* -path */ if (i == (objc-1)) { - Tcl_AppendToObj(resultPtr, - "missing argument to \"-path\"", -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing argument to \"-path\"", -1)); return TCL_ERROR; } if (dir != PATH_NONE) { - Tcl_AppendToObj(resultPtr, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-path\" cannot be used with \"-directory\"", - -1); + -1)); return TCL_ERROR; } dir = PATH_GENERAL; @@ -1650,8 +1649,8 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv) break; case GLOB_TYPE: /* -types */ if (i == (objc-1)) { - Tcl_AppendToObj(resultPtr, - "missing argument to \"-types\"", -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing argument to \"-types\"", -1)); return TCL_ERROR; } typePtr = objv[i+1]; @@ -1671,9 +1670,9 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) { - Tcl_AppendToObj(resultPtr, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-tails\" must be used with either \"-directory\" or \"-path\"", - -1); + -1)); return TCL_ERROR; } @@ -1832,8 +1831,7 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv) } } /* - * Error cases. We re-get the interpreter's result, - * just to be sure it hasn't changed, and we reset + * Error cases. We reset * the 'join' flag to zero, since we haven't yet * made use of it. */ @@ -1845,10 +1843,9 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv) join = 0; goto endOfGlob; badMacTypesArg: - resultPtr = Tcl_GetObjResult(interp); - Tcl_AppendToObj(resultPtr, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "only one MacOS type or creator argument" - " to \"-types\" allowed", -1); + " to \"-types\" allowed", -1)); result = TCL_ERROR; join = 0; goto endOfGlob; @@ -1864,11 +1861,6 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv) */ objc -= i; objv += i; - /* - * We re-retrieve this, in case it was changed in - * the Tcl_ResetResult above - */ - resultPtr = Tcl_GetObjResult(interp); result = TCL_OK; if (join) { if (dir != PATH_GENERAL) { -- cgit v0.12