From 20830f1de990be20541f5a22ef27c99aeeb0174d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
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 <dgp@users.sourceforge.net>
+
+ * 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 <donal.k.fellows@man.ac.uk>
* 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