Stop reliance on absolute attribute indexes with helper function [Bug 1100671]

4 files changed, 100 insertions, 10 deletions

diff --git a/ChangeLog b/ChangeLog
index 0b36609..48bd6ac 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2005-01-14  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
+
+	* generic/tclIOUtil.c (TclFSFileAttrIndex): New helper function so
+	that we don't need to hard-code attribute indexes. [Bug 1100671]
+
 2005-01-13  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
 	* doc/string.n: Removed the term 'set' from the documentation of
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index a74b6d6..9eb4685 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclFCmd.c,v 1.29 2004/10/19 21:54:07 dgp Exp $
+ * RCS: @(#) $Id: tclFCmd.c,v 1.30 2005/01/14 14:16:53 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -534,10 +534,13 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
 	 */
 #if !defined(__WIN32__)
 	{
-	Tcl_Obj* perm = Tcl_NewStringObj("u+w",-1);
-	Tcl_IncrRefCount(perm);
-	Tcl_FSFileAttrsSet(NULL, 2, target, perm);
-	Tcl_DecrRefCount(perm);
+	    Tcl_Obj* perm = Tcl_NewStringObj("u+w",-1);
+	    int index;
+	    Tcl_IncrRefCount(perm);
+	    if (TclFSFileAttrIndex(target, "-permissions", &index) == TCL_OK) {
+		Tcl_FSFileAttrsSet(NULL, index, target, perm);
+	    }
+	    Tcl_DecrRefCount(perm);
 	}
 #endif
     }
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 17fd376..e4ddcd4 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOUtil.c,v 1.113 2004/11/17 00:31:47 dgp Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.114 2005/01/14 14:16:51 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2292,6 +2292,83 @@ Tcl_FSFileAttrStrings(pathPtr, objPtrRef)
 /*
  *----------------------------------------------------------------------
  *
+ * TclFSFileAttrIndex --
+ *
+ *	Helper function for converting an attribute name to an index
+ *	into the attribute table.
+ *
+ * Results:
+ *	Tcl result code, index written to *indexPtr on result==TCL_OK
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFSFileAttrIndex(pathPtr, attributeName, indexPtr)
+    Tcl_Obj *pathPtr;			/* File whose attributes are to be
+					 * indexed into. */
+    CONST char *attributeName;		/* The attribute being looked for. */
+    int *indexPtr;			/* Where to write the found index. */
+{
+    Tcl_Obj *listObj = NULL;
+    CONST char **attrTable;
+
+    /*
+     * Get the attribute table for the file.
+     */
+
+    attrTable = Tcl_FSFileAttrStrings(pathPtr, &listObj);
+    if (listObj != NULL) {
+	Tcl_IncrRefCount(listObj);
+    }
+
+    if (attrTable != NULL) {
+	/*
+	 * It's a constant attribute table, so use T_GIFO.
+	 */
+
+	Tcl_Obj *tmpObj = Tcl_NewStringObj(attributeName, NULL);
+	int result;
+
+	result = Tcl_GetIndexFromObj(NULL, tmpObj, attrTable, NULL, TCL_EXACT,
+		indexPtr);
+	TclDecrRefCount(tmpObj);
+	if (listObj != NULL) {
+	    TclDecrRefCount(listObj);
+	}
+	return result;
+    } else if (listObj != NULL) {
+	/*
+	 * It's a non-constant attribute list, so do a literal search.
+	 */
+
+        int i, objc;
+	Tcl_Obj **objv;
+
+	if (Tcl_ListObjGetElements(NULL, listObj, &objc, &objv) != TCL_OK) {
+	    TclDecrRefCount(listObj);
+	    return TCL_ERROR;
+	}
+	for (i=0 ; i<objc ; i++) {
+	    if (!strcmp(attributeName, TclGetString(objv[i]))) {
+		TclDecrRefCount(listObj);
+		*indexPtr = i;
+		return TCL_OK;
+	    }
+	}
+	TclDecrRefCount(listObj);
+	return TCL_ERROR;
+    } else {
+	return TCL_ERROR;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_FSFileAttrsGet --
  *
  *	This procedure implements read access for the hookable 'file
@@ -2951,8 +3028,7 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
 	    return -1;
 	}
 	
-	if (TclCrossFilesystemCopy(interp, pathPtr, 
-				   copyToPtr) == TCL_OK) {
+	if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) == TCL_OK) {
 	    Tcl_LoadHandle newLoadHandle = NULL;
 	    ClientData newClientData = NULL;
 	    Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
@@ -2969,9 +3045,13 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
 	     * we just do this directly, like this:
 	     */
 	    
+	    int index;
 	    Tcl_Obj* perm = Tcl_NewStringObj("0700",-1);
 	    Tcl_IncrRefCount(perm);
-	    Tcl_FSFileAttrsSet(NULL, 2, copyToPtr, perm);
+	    if (TclFSFileAttrIndex(copyToPtr, "-permissions",
+		    &index) == TCL_OK) {
+		Tcl_FSFileAttrsSet(NULL, index, copyToPtr, perm);
+	    }
 	    Tcl_DecrRefCount(perm);
 #endif
 	    
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 0338e3f..0f88767 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.210 2005/01/05 10:31:02 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.211 2005/01/14 14:16:52 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -1843,6 +1843,8 @@ MODULE_SCOPE void	TclFinalizeAsync _ANSI_ARGS_((void));
 MODULE_SCOPE void	TclFinalizeSynchronization _ANSI_ARGS_((void));
 MODULE_SCOPE void	TclFinalizeLock _ANSI_ARGS_((void));
 MODULE_SCOPE void	TclFinalizeThreadData _ANSI_ARGS_((void));
+MODULE_SCOPE int	TclFSFileAttrIndex _ANSI_ARGS_((Tcl_Obj *pathPtr,
+			    CONST char *attributeName, int *indexPtr));
 MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler _ANSI_ARGS_((Tcl_Interp *interp));
 MODULE_SCOPE int        TclGetNamespaceFromObj _ANSI_ARGS_((
 			    Tcl_Interp *interp, Tcl_Obj *objPtr,