tip118.patché¡ºèÍºèÒmBINëAIndex: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.1573
diff -u -r1.1573 ChangeLog
--- ChangeLog	14 May 2003 06:19:51 -0000	1.1573
+++ ChangeLog	14 May 2003 19:13:31 -0000
@@ -1,3 +1,47 @@
+2003-05-15  Daniel Steffen  <das@users.sourceforge.net>
+
+	Implementation of TIP 118:
+	
+	* generic/tclFCmd.c (TclFileAttrsCmd): return the list of attributes
+	that can be retrieved without error for a given file, instead of
+	aborting the whole command when any error occurs.
+
+	* unix/tclUnixFCmd.c: added support for new file attributes and for
+	copying Mac OS X file attributes & resource fork during [file copy].
+
+	* generic/tclInt.decls: added declarations of new external commands
+	needed by new file attributes support in tclUnixFCmd.c.
+
+	* macosx/tclMacOSXFCmd.c (new): Mac OS X specific implementation of
+	new file attributes and of attribute & resource fork copying.
+
+	* mac/tclMacFCmd.c: added implementation of -rsrclength attribute &
+	fixes to other attributes for consistency with OSX implementation.
+
+	* mac/tclMacResource.c: fixes to OSType handling.
+
+	* doc/file.n: documentation of [file attributes] changes.
+
+	* unix/configure.in: check for APIs needed by new file attributes.
+
+	* unix/Makefile.in:
+	* unix/tcl.m4: added new platform specifc tclMacOSXFCmd.c source.
+
+	* unix/configure:
+	* generic/tclStubInit.c:
+	* generic/tclIntPlatDecls.h: regen.
+
+	* tools/genStubs.tcl: fixes to completely broken code trying to
+	prevent overlap of "aqua", "macosx", "x11" and "unix" stub entries.
+
+	* tests/unixFCmd.test: added tests of -readonly attribute.
+	
+	* tests/macOSXFCmd.test (new): tests of macosx file attributes and
+	of preservation of attributes & resource fork during [file copy].
+	
+	* tests/macFCmd.test: restore -readonly attribute of test dir, as
+	otherwise its removal can fail on unices supporting -readonly.
+
 2003-05-13  David Gravereaux <davygrvy@pobox.com>
 
 	* generic/tclEnv.c: Another putenv() copy behavior problem
Index: doc/file.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/file.n,v
retrieving revision 1.23
diff -u -r1.23 file.n
--- doc/file.n	28 Feb 2003 12:11:49 -0000	1.23
+++ doc/file.n	14 May 2003 19:13:32 -0000
@@ -59,6 +59,9 @@
 permissions for group and other).  A simplified \fBls\fR style string,
 of the form rwxrwxrwx (must be 9 characters), is also supported
 (example: \fBrwxr\-xr\-t\fR is equivalent to 01755).
+On versions of Unix supporting file flags, \fB-readonly\fR gives the
+value or sets or clears the readonly attribute of the file,
+i.e. the user immutable flag \fBuchg\fR to chflags(1).
 .PP
 On Windows, \fB-archive\fR gives the value or sets or clears the
 archive attribute of the file. \fB-hidden\fR gives the value or sets
@@ -70,12 +73,15 @@
 name. This attribute cannot be set. \fB-system\fR gives or sets or
 clears the value of the system attribute of the file.
 .PP
-On Macintosh, \fB-creator\fR gives or sets the Finder creator type of
-the file. \fB-hidden\fR gives or sets or clears the hidden attribute
-of the file. \fB-readonly\fR gives or sets or clears the readonly
-attribute of the file. Note that directories can only be locked if
-File Sharing is turned on. \fB-type\fR gives or sets the Finder file
-type for the file.
+On Mac OS 9, Mac OS X and Darwin, \fB-creator\fR gives or sets the
+Finder creator type of the file. \fB-hidden\fR gives or sets or clears
+the hidden attribute of the file. \fB-readonly\fR gives or sets or
+clears the readonly attribute of the file. Note that on Mac OS 9,
+directories can only be locked if File Sharing is turned on. \fB-type\fR
+gives or sets the Finder file type for the file. \fB-rsrclength\fR gives
+the length of the resource fork of the file, this attribute can only be
+set to the value 0, which results in the resource fork being stripped
+off the file.
 .RE
 .VS
 .TP
Index: generic/tclFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclFCmd.c,v
retrieving revision 1.20
diff -u -r1.20 tclFCmd.c
--- generic/tclFCmd.c	8 Aug 2002 10:41:22 -0000	1.20
+++ generic/tclFCmd.c	14 May 2003 19:13:32 -0000
@@ -918,21 +918,29 @@
 	 * Get all attributes.
 	 */
 
-	int index;
+	int index, res = TCL_OK, nbAtts = 0;
 	Tcl_Obj *listPtr;
 	 
 	listPtr = Tcl_NewListObj(0, NULL);
 	for (index = 0; attributeStrings[index] != NULL; index++) {
-	    Tcl_Obj *objPtr = Tcl_NewStringObj(attributeStrings[index], -1);
-	    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
-	    /* We now forget about objPtr, it is in the list */
-	    objPtr = NULL;
-	    if (Tcl_FSFileAttrsGet(interp, index, filePtr,
-		    &objPtr) != TCL_OK) {
-		Tcl_DecrRefCount(listPtr);
-		goto end;
+	    Tcl_Obj *objPtrAttr;
+	    
+	    if (res != TCL_OK) {
+	        /* Clear the error from the last iteration */
+	        Tcl_ResetResult(interp);
 	    }
-	    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+	    res = Tcl_FSFileAttrsGet(interp, index, filePtr, &objPtrAttr);
+	    if (res == TCL_OK) {
+	        Tcl_Obj *objPtr = Tcl_NewStringObj(attributeStrings[index], -1);
+	        Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+	        Tcl_ListObjAppendElement(interp, listPtr, objPtrAttr);
+	        nbAtts++;
+	    }
+	}
+	if (index > 0 && nbAtts == 0) {
+	    /* Error: no valid attributes found */
+	    Tcl_DecrRefCount(listPtr);
+	    goto end;
 	}
     	Tcl_SetObjResult(interp, listPtr);
     } else if (objc == 1) {
Index: generic/tclInt.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.decls,v
retrieving revision 1.60
diff -u -r1.60 tclInt.decls
--- generic/tclInt.decls	28 Apr 2003 12:34:27 -0000	1.60
+++ generic/tclInt.decls	14 May 2003 19:13:32 -0000
@@ -993,3 +993,26 @@
 declare 13 unix {
     char *TclpInetNtoa(struct in_addr addr)
 }
+
+# Added in 8.5:
+
+declare 14 unix {
+    int TclUnixCopyFile (CONST char *src, CONST char *dst,
+	    CONST Tcl_StatBuf *statBufPtr, int dontCopyAtts)
+}
+
+declare 15 macosx {
+    int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex,
+	    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
+}
+
+declare 16 macosx {
+    int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex,
+	    Tcl_Obj *fileName, Tcl_Obj *attributePtr)
+}
+
+declare 17 macosx {
+    int TclMacOSXCopyFileAttributes(CONST char *src, CONST char *dst,
+	    CONST Tcl_StatBuf *statBufPtr)
+}
+
Index: generic/tclIntPlatDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIntPlatDecls.h,v
retrieving revision 1.19
diff -u -r1.19 tclIntPlatDecls.h
--- generic/tclIntPlatDecls.h	6 Dec 2002 23:22:59 -0000	1.19
+++ generic/tclIntPlatDecls.h	14 May 2003 19:13:32 -0000
@@ -67,6 +67,11 @@
 EXTERN struct tm *	TclpGmtime _ANSI_ARGS_((time_t * clock));
 /* 13 */
 EXTERN char *		TclpInetNtoa _ANSI_ARGS_((struct in_addr addr));
+/* 14 */
+EXTERN int		TclUnixCopyFile _ANSI_ARGS_((CONST char * src, 
+				CONST char * dst, 
+				CONST Tcl_StatBuf * statBufPtr, 
+				int dontCopyAtts));
 #endif /* UNIX */
 #ifdef __WIN32__
 /* 0 */
@@ -212,6 +217,21 @@
 EXTERN int		FSpLLocationFromPath _ANSI_ARGS_((int length, 
 				CONST char * path, FSSpecPtr theSpec));
 #endif /* MAC_TCL */
+#ifdef MAC_OSX_TCL
+/* 15 */
+EXTERN int		TclMacOSXGetFileAttribute _ANSI_ARGS_((
+				Tcl_Interp * interp, int objIndex, 
+				Tcl_Obj * fileName, 
+				Tcl_Obj ** attributePtrPtr));
+/* 16 */
+EXTERN int		TclMacOSXSetFileAttribute _ANSI_ARGS_((
+				Tcl_Interp * interp, int objIndex, 
+				Tcl_Obj * fileName, Tcl_Obj * attributePtr));
+/* 17 */
+EXTERN int		TclMacOSXCopyFileAttributes _ANSI_ARGS_((
+				CONST char * src, CONST char * dst, 
+				CONST Tcl_StatBuf * statBufPtr));
+#endif /* MAC_OSX_TCL */
 
 typedef struct TclIntPlatStubs {
     int magic;
@@ -232,6 +252,7 @@
     struct tm * (*tclpLocaltime) _ANSI_ARGS_((time_t * clock)); /* 11 */
     struct tm * (*tclpGmtime) _ANSI_ARGS_((time_t * clock)); /* 12 */
     char * (*tclpInetNtoa) _ANSI_ARGS_((struct in_addr addr)); /* 13 */
+    int (*tclUnixCopyFile) _ANSI_ARGS_((CONST char * src, CONST char * dst, CONST Tcl_StatBuf * statBufPtr, int dontCopyAtts)); /* 14 */
 #endif /* UNIX */
 #ifdef __WIN32__
     void (*tclWinConvertError) _ANSI_ARGS_((DWORD errCode)); /* 0 */
@@ -293,6 +314,11 @@
     int (*tclMacChmod) _ANSI_ARGS_((CONST char * path, int mode)); /* 25 */
     int (*fSpLLocationFromPath) _ANSI_ARGS_((int length, CONST char * path, FSSpecPtr theSpec)); /* 26 */
 #endif /* MAC_TCL */
+#ifdef MAC_OSX_TCL
+    int (*tclMacOSXGetFileAttribute) _ANSI_ARGS_((Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj ** attributePtrPtr)); /* 15 */
+    int (*tclMacOSXSetFileAttribute) _ANSI_ARGS_((Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj * attributePtr)); /* 16 */
+    int (*tclMacOSXCopyFileAttributes) _ANSI_ARGS_((CONST char * src, CONST char * dst, CONST Tcl_StatBuf * statBufPtr)); /* 17 */
+#endif /* MAC_OSX_TCL */
 } TclIntPlatStubs;
 
 #ifdef __cplusplus
@@ -363,6 +389,10 @@
 #define TclpInetNtoa \
 	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
 #endif
+#ifndef TclUnixCopyFile
+#define TclUnixCopyFile \
+	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
+#endif
 #endif /* UNIX */
 #ifdef __WIN32__
 #ifndef TclWinConvertError
@@ -577,6 +607,20 @@
 	(tclIntPlatStubsPtr->fSpLLocationFromPath) /* 26 */
 #endif
 #endif /* MAC_TCL */
+#ifdef MAC_OSX_TCL
+#ifndef TclMacOSXGetFileAttribute
+#define TclMacOSXGetFileAttribute \
+	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
+#endif
+#ifndef TclMacOSXSetFileAttribute
+#define TclMacOSXSetFileAttribute \
+	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
+#endif
+#ifndef TclMacOSXCopyFileAttributes
+#define TclMacOSXCopyFileAttributes \
+	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
+#endif
+#endif /* MAC_OSX_TCL */
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.83
diff -u -r1.83 tclStubInit.c
--- generic/tclStubInit.c	13 May 2003 08:40:31 -0000	1.83
+++ generic/tclStubInit.c	14 May 2003 19:13:32 -0000
@@ -289,6 +289,7 @@
     TclpLocaltime, /* 11 */
     TclpGmtime, /* 12 */
     TclpInetNtoa, /* 13 */
+    TclUnixCopyFile, /* 14 */
 #endif /* UNIX */
 #ifdef __WIN32__
     TclWinConvertError, /* 0 */
@@ -350,6 +351,11 @@
     TclMacChmod, /* 25 */
     FSpLLocationFromPath, /* 26 */
 #endif /* MAC_TCL */
+#ifdef MAC_OSX_TCL
+    TclMacOSXGetFileAttribute, /* 15 */
+    TclMacOSXSetFileAttribute, /* 16 */
+    TclMacOSXCopyFileAttributes, /* 17 */
+#endif /* MAC_OSX_TCL */
 };
 
 TclPlatStubs tclPlatStubs = {
Index: mac/tclMacFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacFCmd.c,v
retrieving revision 1.19
diff -u -r1.19 tclMacFCmd.c
--- mac/tclMacFCmd.c	4 Feb 2003 17:06:51 -0000	1.19
+++ mac/tclMacFCmd.c	14 May 2003 19:13:32 -0000
@@ -26,6 +26,7 @@
 #include <string.h>
 #include <Finder.h>
 #include <Aliases.h>
+#include <Resources.h>
 
 /*
  * Callback for the file attributes code.
@@ -52,17 +53,19 @@
 #define MAC_HIDDEN_ATTRIBUTE	1
 #define MAC_READONLY_ATTRIBUTE	2
 #define MAC_TYPE_ATTRIBUTE	3
+#define MAC_RSRCLENGTH_ATTRIBUTE	4
 
 /*
  * Global variables for the file attributes code.
  */
 
 CONST char *tclpFileAttrStrings[] = {"-creator", "-hidden", "-readonly",
-	"-type", (char *) NULL};
+	"-type", "-rsrclength", (char *) NULL};
 CONST TclFileAttrProcs tclpFileAttrProcs[] = {
 	{GetFileFinderAttributes, SetFileFinderAttributes},
 	{GetFileFinderAttributes, SetFileFinderAttributes},
 	{GetFileReadOnly, SetFileReadOnly},
+	{GetFileFinderAttributes, SetFileFinderAttributes},
 	{GetFileFinderAttributes, SetFileFinderAttributes}};
 
 /*
@@ -1102,6 +1105,7 @@
     OSErr err;
     FSSpec fileSpec;
     FInfo finfo;
+    CInfoPBRec pb;
     CONST char *native;
 
     native=Tcl_FSGetNativePath(fileName);
@@ -1109,7 +1113,16 @@
 	    native, &fileSpec);
 
     if (err == noErr) {
-    	err = FSpGetFInfo(&fileSpec, &finfo);
+    	if (objIndex != MAC_RSRCLENGTH_ATTRIBUTE) {
+    	    err = FSpGetFInfo(&fileSpec, &finfo);
+    	} else {
+    	    pb.hFileInfo.ioCompletion = NULL;
+    	    pb.hFileInfo.ioNamePtr = fileSpec.name;
+    	    pb.hFileInfo.ioVRefNum = fileSpec.vRefNum;
+    	    pb.hFileInfo.ioFDirIndex = 0;
+    	    pb.hFileInfo.ioDirID = fileSpec.parID;
+    	    err = PBGetCatInfo(&pb, 0);
+    	}
     }
     
     if (err == noErr) {
@@ -1124,6 +1137,9 @@
     	    case MAC_TYPE_ATTRIBUTE:
     	    	*attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdType);
     	    	break;
+    	    case MAC_RSRCLENGTH_ATTRIBUTE:
+    	    	*attributePtrPtr = Tcl_NewLongObj(pb.hFileInfo.ioFlRLgLen);
+    	    	break;
     	}
     } else if (err == fnfErr) {
     	long dirID;
@@ -1134,7 +1150,11 @@
     	    if (objIndex == MAC_HIDDEN_ATTRIBUTE) {
     	    	*attributePtrPtr = Tcl_NewBooleanObj(0);
     	    } else {
-    	    	*attributePtrPtr = Tcl_NewOSTypeObj('Fldr');
+    	    	/* Directories only support attribute "-hidden" */
+    	    	errno = EISDIR;
+    	    	Tcl_AppendResult(interp, "invalid attribute: ", 
+    	    	        Tcl_PosixError(interp), (char *) NULL);
+    	    	return TCL_ERROR;
     	    }
     	}
     }
@@ -1244,6 +1264,7 @@
     OSErr err;
     FSSpec fileSpec;
     FInfo finfo;
+    CInfoPBRec pb;
     CONST char *native;
 
     native=Tcl_FSGetNativePath(fileName);
@@ -1251,7 +1272,16 @@
 	    native, &fileSpec);
     
     if (err == noErr) {
-    	err = FSpGetFInfo(&fileSpec, &finfo);
+    	if (objIndex != MAC_RSRCLENGTH_ATTRIBUTE) {
+    	    err = FSpGetFInfo(&fileSpec, &finfo);
+    	} else {
+    	    pb.hFileInfo.ioCompletion = NULL;
+    	    pb.hFileInfo.ioNamePtr = fileSpec.name;
+    	    pb.hFileInfo.ioVRefNum = fileSpec.vRefNum;
+    	    pb.hFileInfo.ioFDirIndex = 0;
+    	    pb.hFileInfo.ioDirID = fileSpec.parID;
+    	    err = PBGetCatInfo(&pb, 0);
+    	}
     }
     
     if (err == noErr) {
@@ -1282,8 +1312,47 @@
     	    	    return TCL_ERROR;
     	    	}
     	    	break;
+    	    case MAC_RSRCLENGTH_ATTRIBUTE:
+    	    {
+    	    	long newRsrcForkSize;
+    	    	
+    	    	if (Tcl_GetLongFromObj(interp, attributePtr,
+    	    		&newRsrcForkSize) != TCL_OK) {
+    	    	    return TCL_ERROR;
+    	    	}
+		if(newRsrcForkSize != pb.hFileInfo.ioFlRLgLen) {
+		    short rf;
+		    /*
+		     * Only setting rsrclength to 0 to strip
+		     * a file's resource fork is supported.
+		     */
+		    if(newRsrcForkSize != 0) {
+			Tcl_AppendResult(interp,
+				"setting nonzero rsrclength not supported", 
+				(char *) NULL);
+			return TCL_ERROR;
+		    }
+		    	
+		    if ((rf = FSpOpenResFile(&fileSpec, fsWrPerm)) >= 0) {
+			err = SetEOF(rf, 0);
+			CloseResFile(rf);
+		    }
+	
+		    if (err != noErr) {
+		    	errno = TclMacOSErrorToPosixError(err);
+			Tcl_AppendResult(interp, 
+				"could not truncate resource fork of \"",
+				Tcl_GetString(fileName), "\": ",
+				Tcl_PosixError(interp), (char *) NULL);
+			return TCL_ERROR;
+		    }
+		}
+    	    	break;
+    	    }
+    	}
+    	if (objIndex != MAC_RSRCLENGTH_ATTRIBUTE) {
+    	    err = FSpSetFInfo(&fileSpec, &finfo);
     	}
-    	err = FSpSetFInfo(&fileSpec, &finfo);
     } else if (err == fnfErr) {
     	long dirID;
     	Boolean isDirectory = 0;
Index: mac/tclMacResource.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacResource.c,v
retrieving revision 1.14
diff -u -r1.14 tclMacResource.c
--- mac/tclMacResource.c	5 Jun 2002 11:59:49 -0000	1.14
+++ mac/tclMacResource.c	14 May 2003 19:13:32 -0000
@@ -1711,24 +1711,29 @@
     Tcl_ObjType *oldTypePtr = objPtr->typePtr;
     char *string;
     int length;
-    long newOSType;
+    OSType newOSType = 0UL;
+    Tcl_DString ds;
 
     /*
      * Get the string representation. Make it up-to-date if necessary.
      */
 
     string = Tcl_GetStringFromObj(objPtr, &length);
+    Tcl_UtfToExternalDString(NULL, string, length, &ds);
 
-    if (length != 4) {
+    if (Tcl_DStringLength(&ds) > sizeof(OSType)) {
 	if (interp != NULL) {
 	    Tcl_ResetResult(interp);
 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		    "expected Macintosh OS type but got \"", string, "\"",
 		    (char *) NULL);
 	}
+	Tcl_DStringFree(&ds);
 	return TCL_ERROR;
     }
-    newOSType =  *((long *) string);
+    memcpy(&newOSType, Tcl_DStringValue(&ds),
+            (size_t) Tcl_DStringLength(&ds));
+    Tcl_DStringFree(&ds);
     
     /*
      * The conversion to resource type succeeded. Free the old internalRep 
@@ -1767,9 +1772,16 @@
 UpdateStringOfOSType(
     register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
 {
-    objPtr->bytes = ckalloc(5);
-    sprintf(objPtr->bytes, "%-4.4s", &(objPtr->internalRep.longValue));
-    objPtr->length = 4;
+    char string[sizeof(OSType)+1];
+    Tcl_DString ds;
+    
+    memcpy(string, &(objPtr->internalRep.longValue), sizeof(OSType));
+    string[sizeof(OSType)] = '\0';
+    Tcl_ExternalToUtfDString(NULL, string, -1, &ds);
+    objPtr->bytes = ckalloc(Tcl_DStringLength(&ds) + 1);
+    memcpy(objPtr->bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds) + 1);
+    objPtr->length = Tcl_DStringLength(&ds);
+    Tcl_DStringFree(&ds);
 }
 
 /*
Index: macosx/tclMacOSXFCmd.c
===================================================================
RCS file: macosx/tclMacOSXFCmd.c
diff -N macosx/tclMacOSXFCmd.c
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ macosx/tclMacOSXFCmd.c	14 May 2003 19:13:32 -0000
@@ -0,0 +1,462 @@
+/*
+ * tclMacOSXFCmd.c
+ *
+ *      This file implements the MacOSX specific portion of file manipulation 
+ *      subcommands of the "file" command.
+ *
+ * Copyright (c) 2003 Tcl Core Team.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+#ifdef HAVE_GETATTRLIST
+#include <sys/attr.h>
+#include <sys/paths.h>
+#endif
+
+/*
+ * Constants for file attributes subcommand.
+ * Need to be kept in sync with tclUnixFCmd.c !
+ */
+
+enum {
+    UNIX_GROUP_ATTRIBUTE,
+    UNIX_OWNER_ATTRIBUTE,
+    UNIX_PERMISSIONS_ATTRIBUTE,
+#ifdef HAVE_CHFLAGS
+    UNIX_READONLY_ATTRIBUTE,
+#endif
+#ifdef MAC_OSX_TCL
+    MACOSX_CREATOR_ATTRIBUTE,
+    MACOSX_TYPE_ATTRIBUTE,
+    MACOSX_HIDDEN_ATTRIBUTE,
+    MACOSX_RSRCLENGTH_ATTRIBUTE,
+#endif
+};
+
+typedef u_int32_t OSType;
+
+static int Tcl_GetOSTypeFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, 
+		OSType *osTypePtr);
+static Tcl_Obj *Tcl_NewOSTypeStringObj(CONST OSType newOSType);
+
+enum {
+   kFinfoIsInvisible = 0x4000,
+};
+
+typedef struct fileinfobuf {
+   u_int32_t info_length;
+   union {
+     struct {
+       u_int32_t type;
+       u_int32_t creator;
+       u_int16_t fdFlags;
+       u_int16_t location;
+       u_int32_t padding[4];
+     } finder;
+     off_t rsrcForkSize;
+   } data;
+} fileinfobuf;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacOSXGetFileAttribute
+ *
+ *      Gets a MacOSX attribute of a file.  Which attribute is
+ *      controlled by objIndex. The object will have ref count 0.
+ *
+ * Results:
+ *      Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr
+ *        if there is no error.
+ *
+ * Side effects:
+ *      A new object is allocated.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMacOSXGetFileAttribute(interp, objIndex, fileName, attributePtrPtr)
+    Tcl_Interp *interp;          /* The interp we are using for errors. */
+    int objIndex;                /* The index of the attribute. */
+    Tcl_Obj *fileName;           /* The name of the file (UTF-8). */
+    Tcl_Obj **attributePtrPtr;   /* A pointer to return the object with. */
+{
+#ifdef HAVE_GETATTRLIST
+    int result;
+    Tcl_StatBuf statBuf;
+    struct attrlist alist;
+    fileinfobuf finfo;
+    CONST char *native;
+    
+    result = TclpObjStat(fileName, &statBuf);
+    
+    if (result != 0) {
+	Tcl_AppendResult(interp, "could not read \"", 
+		Tcl_GetString(fileName), "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (S_ISDIR(statBuf.st_mode) && objIndex != MACOSX_HIDDEN_ATTRIBUTE) {
+        /* Directories only support attribute "-hidden" */
+        errno = EISDIR;
+        Tcl_AppendResult(interp, "invalid attribute: ", 
+                Tcl_PosixError(interp), (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    memset(&alist, 0, sizeof(struct attrlist));
+    alist.bitmapcount = ATTR_BIT_MAP_COUNT;
+    if(objIndex == MACOSX_RSRCLENGTH_ATTRIBUTE) {
+        alist.fileattr = ATTR_FILE_RSRCLENGTH;
+    } else {
+        alist.commonattr = ATTR_CMN_FNDRINFO;    
+    }
+    native = Tcl_FSGetNativePath(fileName);
+    result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0);
+
+    if (result != 0) {
+        Tcl_AppendResult(interp, "could not read attributes of \"", 
+                Tcl_GetString(fileName), "\": ",
+                Tcl_PosixError(interp), (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    switch (objIndex) {
+        case MACOSX_CREATOR_ATTRIBUTE:
+            *attributePtrPtr = Tcl_NewOSTypeStringObj(finfo.data.finder.creator);
+            break;
+        case MACOSX_TYPE_ATTRIBUTE:
+            *attributePtrPtr = Tcl_NewOSTypeStringObj(finfo.data.finder.type);
+            break;
+        case MACOSX_HIDDEN_ATTRIBUTE:
+            *attributePtrPtr = Tcl_NewBooleanObj( (finfo.data.finder.fdFlags
+                & kFinfoIsInvisible) != 0);
+            break;
+        case MACOSX_RSRCLENGTH_ATTRIBUTE:
+            *attributePtrPtr = Tcl_NewWideIntObj(finfo.data.rsrcForkSize);
+            break;
+    }
+    return TCL_OK;
+#else
+    Tcl_AppendResult(interp, "Mac OS X file attributes not supported",
+		(char *) NULL);
+    return TCL_ERROR;
+#endif
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclMacOSXSetFileAttribute --
+ *
+ *      Sets a MacOSX attribute of a file.  Which attribute is
+ *      controlled by objIndex.
+ *
+ * Results:
+ *      Standard TCL result.
+ *
+ * Side effects:
+ *      As above.
+ *      
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclMacOSXSetFileAttribute(interp, objIndex, fileName, attributePtr)
+    Tcl_Interp *interp;              /* The interp for error reporting. */
+    int objIndex;                    /* The index of the attribute. */
+    Tcl_Obj *fileName;               /* The name of the file (UTF-8). */
+    Tcl_Obj *attributePtr;           /* New owner for file. */
+{
+#ifdef HAVE_GETATTRLIST
+    int result;
+    Tcl_StatBuf statBuf;
+    struct attrlist alist;
+    fileinfobuf finfo;
+    CONST char *native;
+    
+    result = TclpObjStat(fileName, &statBuf);
+    
+    if (result != 0) {
+	Tcl_AppendResult(interp, "could not read \"", 
+		Tcl_GetString(fileName), "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (S_ISDIR(statBuf.st_mode) && objIndex != MACOSX_HIDDEN_ATTRIBUTE) {
+        /* Directories only support attribute "-hidden" */
+        errno = EISDIR;
+        Tcl_AppendResult(interp, "invalid attribute: ", 
+                Tcl_PosixError(interp), (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    memset(&alist, 0, sizeof(struct attrlist));
+    alist.bitmapcount = ATTR_BIT_MAP_COUNT;
+    if(objIndex == MACOSX_RSRCLENGTH_ATTRIBUTE) {
+        alist.fileattr = ATTR_FILE_RSRCLENGTH;
+    } else {
+        alist.commonattr = ATTR_CMN_FNDRINFO;    
+    }
+    native = Tcl_FSGetNativePath(fileName);
+    result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0);
+
+    if (result != 0) {
+        Tcl_AppendResult(interp, "could not read attributes of \"", 
+                Tcl_GetString(fileName), "\": ",
+                Tcl_PosixError(interp), (char *) NULL);
+        return TCL_ERROR;
+    }
+
+    if (objIndex != MACOSX_RSRCLENGTH_ATTRIBUTE) {
+        switch (objIndex) {
+            case MACOSX_CREATOR_ATTRIBUTE:
+                if (Tcl_GetOSTypeFromObj(interp, attributePtr,
+                        &finfo.data.finder.creator) != TCL_OK) {
+                    return TCL_ERROR;
+                }
+                break;
+            case MACOSX_TYPE_ATTRIBUTE:
+                if (Tcl_GetOSTypeFromObj(interp, attributePtr,
+                        &finfo.data.finder.type) != TCL_OK) {
+                    return TCL_ERROR;
+                }
+                break;
+            case MACOSX_HIDDEN_ATTRIBUTE:
+                {
+                    int hidden;
+                    if (Tcl_GetBooleanFromObj(interp, attributePtr, &hidden)
+                            != TCL_OK) {
+                        return TCL_ERROR;
+                    }
+                    if (hidden) {
+                        finfo.data.finder.fdFlags |= kFinfoIsInvisible;
+                    } else {
+                        finfo.data.finder.fdFlags &= ~kFinfoIsInvisible;
+                    }
+                }
+                break;
+        }
+        result = setattrlist(native, &alist, &finfo.data, sizeof(finfo.data), 0);
+    
+        if (result != 0) {
+            Tcl_AppendResult(interp, "could not set attributes of \"", 
+                    Tcl_GetString(fileName), "\": ",
+                    Tcl_PosixError(interp), (char *) NULL);
+            return TCL_ERROR;
+        }
+    } else {
+        off_t newRsrcForkSize;
+        
+        if (Tcl_GetWideIntFromObj(interp, attributePtr,
+                &newRsrcForkSize) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        
+        if(newRsrcForkSize != finfo.data.rsrcForkSize) {
+            Tcl_DString ds;
+            /*
+             * Only setting rsrclength to 0 to strip
+             * a file's resource fork is supported.
+             */
+            if(newRsrcForkSize != 0) {
+                Tcl_AppendResult(interp,
+                        "setting nonzero rsrclength not supported", 
+                        (char *) NULL);
+                return TCL_ERROR;
+            }
+            
+            /* construct path to resource fork */
+            Tcl_DStringInit(&ds);
+            Tcl_DStringAppend(&ds, native, -1);
+            Tcl_DStringAppend(&ds, _PATH_RSRCFORKSPEC, -1);
+
+            result = truncate(Tcl_DStringValue(&ds), (off_t)0);
+
+            Tcl_DStringFree(&ds);
+    
+            if (result != 0) {
+                Tcl_AppendResult(interp, 
+                        "could not truncate resource fork of \"",
+                        Tcl_GetString(fileName), "\": ",
+                        Tcl_PosixError(interp), (char *) NULL);
+                return TCL_ERROR;
+            }
+        }
+    }
+    return TCL_OK;
+#else
+    Tcl_AppendResult(interp, "Mac OS X file attributes not supported",
+		(char *) NULL);
+    return TCL_ERROR;
+#endif
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclMacOSXCopyFileAttributes --
+ *
+ *	Copy the MacOSX attributes and resource fork (if present) from one
+ *	file to another.
+ *
+ * Results:
+ *	Standard Tcl result.
+ *
+ * Side effects:
+ *	MacOSX attributes and resource fork are updated in the new file
+ *	to reflect the old file.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclMacOSXCopyFileAttributes(src, dst, statBufPtr) 
+    CONST char *src;		/* Path name of source file (native). */
+    CONST char *dst;		/* Path name of target file (native). */
+    CONST Tcl_StatBuf *statBufPtr;
+				/* Stat info for source file */
+{
+#ifdef HAVE_GETATTRLIST
+    struct attrlist alist;
+    fileinfobuf finfo;
+    
+    memset(&alist, 0, sizeof(struct attrlist));
+    alist.bitmapcount = ATTR_BIT_MAP_COUNT;
+    alist.commonattr = ATTR_CMN_FNDRINFO;    
+
+    if (getattrlist(src, &alist, &finfo, sizeof(fileinfobuf), 0)) {
+        return TCL_ERROR;
+    }
+
+    if (setattrlist(dst, &alist, &finfo.data, sizeof(finfo.data), 0)) {
+        return TCL_ERROR;
+    }
+
+    if (!S_ISDIR(statBufPtr->st_mode)) {
+        /* only copy non-empty resource fork */
+        alist.commonattr = 0;    
+        alist.fileattr = ATTR_FILE_RSRCLENGTH;
+        
+	if (getattrlist(src, &alist, &finfo, sizeof(fileinfobuf), 0)) {
+	    return TCL_ERROR;
+	}
+        
+        if(finfo.data.rsrcForkSize > 0) {
+	    int result;
+            Tcl_DString ds_src, ds_dst;
+                        
+            /* construct paths to resource forks */
+            Tcl_DStringInit(&ds_src);
+            Tcl_DStringAppend(&ds_src, src, -1);
+            Tcl_DStringAppend(&ds_src, _PATH_RSRCFORKSPEC, -1);
+            Tcl_DStringInit(&ds_dst);
+            Tcl_DStringAppend(&ds_dst, dst, -1);
+            Tcl_DStringAppend(&ds_dst, _PATH_RSRCFORKSPEC, -1);
+ 
+            result = TclUnixCopyFile(Tcl_DStringValue(&ds_src),
+                    Tcl_DStringValue(&ds_dst), statBufPtr, 1);
+
+            Tcl_DStringFree(&ds_src);
+            Tcl_DStringFree(&ds_dst);
+    
+	    if (result != 0) {
+		return TCL_ERROR;
+	    }
+        }
+    }
+    return TCL_OK;
+#else
+    return TCL_ERROR;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetOSTypeFromObj --
+ *
+ *	Attempt to return an OSType from the Tcl object "objPtr".
+ *
+ * Results:
+ *	Standard TCL result. If an error occurs during conversion,
+ *	an error message is left in interp->objResult.
+ *
+ * Side effects:
+ *	The string representation of objPtr will be updated if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Tcl_GetOSTypeFromObj(
+    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr,            /* The object from which to get an OSType. */
+    OSType *osTypePtr)          /* Place to store resulting OSType. */
+{
+    char *string;
+    int length, result = TCL_OK;
+    Tcl_DString ds;
+    Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
+
+    string = Tcl_GetStringFromObj(objPtr, &length);
+    Tcl_UtfToExternalDString(encoding, string, length, &ds);
+
+    if (Tcl_DStringLength(&ds) > sizeof(OSType)) {
+	Tcl_AppendResult(interp, 
+		"expected Macintosh OS type but got \"",
+		string, "\": ", (char *) NULL);
+        result = TCL_ERROR;
+    } else {
+	memset(osTypePtr, 0, sizeof(OSType));
+	memcpy(osTypePtr, Tcl_DStringValue(&ds),
+	        (size_t) Tcl_DStringLength(&ds));
+    }
+    Tcl_DStringFree(&ds);
+    Tcl_FreeEncoding(encoding);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewOSTypeStringObj --
+ *
+ *	Create a new OSType string object.
+ *
+ * Results:
+ *	The newly created string object is returned, it has ref count 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+Tcl_NewOSTypeStringObj(
+    CONST OSType newOSType)    /* OSType used to initialize the new object. */
+{
+    char string[sizeof(OSType)+1];
+    Tcl_Obj *resultPtr;
+    Tcl_DString ds;
+    Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
+
+    memcpy(string, &newOSType, sizeof(OSType));
+    string[sizeof(OSType)] = '\0';
+    Tcl_ExternalToUtfDString(encoding, string, -1, &ds);
+    resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
+    Tcl_DStringFree(&ds);
+    Tcl_FreeEncoding(encoding);
+    return resultPtr;
+}
Index: tests/macFCmd.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/macFCmd.test,v
retrieving revision 1.10
diff -u -r1.10 macFCmd.test
--- tests/macFCmd.test	5 Jul 2002 10:38:43 -0000	1.10
+++ tests/macFCmd.test	14 May 2003 19:13:32 -0000
@@ -31,6 +31,7 @@
 } else {
     set ::tcltest::testConstraints(fileSharing) 1
     set ::tcltest::testConstraints(notFileSharing) 0
+    file attributes foo.dir -readonly 0
 }
 file delete -force foo.dir
 
Index: tests/macOSXFCmd.test
===================================================================
RCS file: tests/macOSXFCmd.test
diff -N tests/macOSXFCmd.test
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/macOSXFCmd.test	14 May 2003 19:13:32 -0000
@@ -0,0 +1,143 @@
+# This file tests the tclMacOSXFCmd.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 2003 Tcl Core Team.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+#
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import -force ::tcltest::*
+}
+
+# These tests really need to be run from a writable directory, which
+# it is assumed [temporaryDirectory] is.
+set oldcwd [pwd]
+cd [temporaryDirectory]
+
+# check whether macosx file attributes are supported
+set ::tcltest::testConstraints(macosxFileAttr) 0
+if {$tcl_platform(platform) eq "unix" && \
+	$tcl_platform(os) eq "Darwin"} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    catch {
+	file attributes foo.test -creator
+	set ::tcltest::testConstraints(macosxFileAttr) 1
+    }
+    file delete -force -- foo.test
+}
+
+test macOSXFCmd-1.1 {MacOSXGetFileAttribute - file not found} {macosxFileAttr notRoot} {
+    catch {file delete -force -- foo.test}
+    list [catch {file attributes foo.test -creator} msg] $msg
+} {1 {could not read "foo.test": no such file or directory}}
+test macOSXFCmd-1.2 {MacOSXGetFileAttribute - creator} {macosxFileAttr notRoot} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -creator} msg] $msg \
+	    [file delete -force -- foo.test]
+} {0 {} {}}
+test macOSXFCmd-1.3 {MacOSXGetFileAttribute - type} {macosxFileAttr notRoot} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -type} msg] $msg \
+	    [file delete -force -- foo.test]
+} {0 {} {}}
+test macOSXFCmd-1.4 {MacOSXGetFileAttribute - hidden} {macosxFileAttr notRoot} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -hidden} msg] $msg \
+	    [file delete -force -- foo.test]
+} {0 0 {}}
+test macOSXFCmd-1.5 {MacOSXGetFileAttribute - rsrclength} {macosxFileAttr notRoot} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -rsrclength} msg] $msg \
+	    [file delete -force -- foo.test]
+} {0 0 {}}
+
+test macOSXFCmd-2.1 {MacOSXSetFileAttribute - file not found} {macosxFileAttr notRoot} {
+    catch {file delete -force -- foo.test}
+    list [catch {file attributes foo.test -creator FOOO} msg] $msg
+} {1 {could not read "foo.test": no such file or directory}}
+test macOSXFCmd-2.2 {MacOSXSetFileAttribute - creator} {macosxFileAttr notRoot} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -creator FOOO} msg] $msg \
+	    [catch {file attributes foo.test -creator} msg] $msg \
+	    [file delete -force -- foo.test]
+} {0 {} 0 FOOO {}}
+test macOSXFCmd-2.3 {MacOSXSetFileAttribute - empty creator} {macosxFileAttr notRoot} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -creator {}} msg] $msg \
+	    [catch {file attributes foo.test -creator} msg] $msg \
+	    [file delete -force -- foo.test]
+} {0 {} 0 {} {}}
+test macOSXFCmd-2.4 {MacOSXSetFileAttribute - type} {macosxFileAttr notRoot} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -type FOOO} msg] $msg \
+	    [catch {file attributes foo.test -type} msg] $msg \
+	    [file delete -force -- foo.test]
+} {0 {} 0 FOOO {}}
+test macOSXFCmd-2.5 {MacOSXSetFileAttribute - empty type} {macosxFileAttr notRoot} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -type {}} msg] $msg \
+	    [catch {file attributes foo.test -type} msg] $msg \
+	    [file delete -force -- foo.test]
+} {0 {} 0 {} {}}
+test macOSXFCmd-2.6 {MacOSXSetFileAttribute - hidden} {macosxFileAttr notRoot} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -hidden 1} msg] $msg \
+	    [catch {file attributes foo.test -hidden} msg] $msg \
+	    [file delete -force -- foo.test]
+} {0 {} 0 1 {}}
+test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    catch {
+	set f [open foo.test/rsrc w]
+	fconfigure $f -translation lf -eofchar {}
+	puts -nonewline $f "foo"
+	close $f
+    }
+    list [catch {file attributes foo.test -rsrclength} msg] $msg \
+	    [catch {file attributes foo.test -rsrclength 0} msg] $msg \
+	    [catch {file attributes foo.test -rsrclength} msg] $msg \
+	    [file delete -force -- foo.test]
+} {0 3 0 {} 0 0 {}}
+
+test macOSXFCmd-3.1 {MacOSXCopyFileAttributes} {macosxFileAttr notRoot} {
+    catch {file delete -force -- foo.test}
+    catch {file delete -force -- bar.test}
+    close [open foo.test w]
+    catch {
+	file attributes foo.test -creator FOOO -type FOOO -hidden 1
+	set f [open foo.test/rsrc w]
+	fconfigure $f -translation lf -eofchar {}
+	puts -nonewline $f "foo"
+	close $f
+	file copy foo.test bar.test
+    }
+    list [catch {file attributes bar.test -creator} msg] $msg \
+	    [catch {file attributes bar.test -type} msg] $msg \
+	    [catch {file attributes bar.test -hidden} msg] $msg \
+	    [catch {file attributes bar.test -rsrclength} msg] $msg \
+	    [file delete -force -- foo.test bar.test]
+} {0 FOOO 0 FOOO 0 1 0 3 {}}
+
+# cleanup
+cd $oldcwd
+::tcltest::cleanupTests
+return
Index: tests/unixFCmd.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/unixFCmd.test,v
retrieving revision 1.18
diff -u -r1.18 unixFCmd.test
--- tests/unixFCmd.test	11 Apr 2003 16:00:02 -0000	1.18
+++ tests/unixFCmd.test	14 May 2003 19:13:32 -0000
@@ -325,6 +325,44 @@
     set r
 } {1 {error getting working directory name:}}
 
+# check whether -readonly attribute is supported
+set ::tcltest::testConstraints(readonlyAttr) 0
+if {$tcl_platform(platform) == "unix"} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    catch {
+	file attributes foo.test -readonly
+	set ::tcltest::testConstraints(readonlyAttr) 1
+    }
+    file delete -force -- foo.test
+}
+
+test unixFCmd-19.1 {GetReadOnlyAttribute - file not found} {unixOnly notRoot readonlyAttr} {
+    catch {file delete -force -- foo.test}
+    list [catch {file attributes foo.test -readonly} msg] $msg
+} {1 {could not read "foo.test": no such file or directory}}
+test unixFCmd-19.2 {GetReadOnlyAttribute} {unixOnly notRoot readonlyAttr} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attribute foo.test -readonly} msg] $msg \
+	    [file delete -force -- foo.test]
+} {0 0 {}}
+
+test unixFCmd-20.1 {SetReadOnlyAttribute} {unixOnly notRoot readonlyAttr} {
+    catch {file delete -force -- foo.test}
+    close [open foo.test w]
+    list [catch {file attributes foo.test -readonly 1} msg] $msg \
+	    [catch {file attribute foo.test -readonly} msg] $msg \
+	    [catch {file delete -force -- foo.test}] \
+	    [catch {file attributes foo.test -readonly 0} msg] $msg \
+	    [catch {file attribute foo.test -readonly} msg] $msg \
+	    [file delete -force -- foo.test]
+} {0 {} 0 1 1 0 {} 0 0 {}}
+test unixFCmd-20.2 {SetReadOnlyAttribute} {unixOnly notRoot readonlyAttr} {
+    catch {file delete -force -- foo.test}
+    list [catch {file attributes foo.test -readonly 1} msg] $msg
+} {1 {could not read "foo.test": no such file or directory}}
+
 # cleanup
 cleanup
 cd $oldcwd
Index: tools/genStubs.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/tools/genStubs.tcl,v
retrieving revision 1.14
diff -u -r1.14 genStubs.tcl
--- tools/genStubs.tcl	19 Mar 2003 21:58:01 -0000	1.14
+++ tools/genStubs.tcl	14 May 2003 19:13:32 -0000
@@ -631,7 +631,8 @@
                 # emit duplicate stubs entries for the two.
                 #
 		if {[info exists stubs($name,aqua,$i)]
-                        && ![info exists stubs($name,macosx,$i)]} {
+                        && ![info exists stubs($name,macosx,$i)]
+                        && ![info exists stubs($name,unix,$i)]} {
 		    append text [addPlatformGuard aqua \
 			    [$slotProc $name $stubs($name,aqua,$i) $i]]
 		    set emit 1
@@ -670,48 +671,52 @@
 		append text [addPlatformGuard $plat $temp]
 	    }
 	}
-        # Again, make sure you don't duplicate entries for macosx & aqua.
-	if {[info exists stubs($name,aqua,lastNum)]
-                && ![info exists stubs($name,macosx,lastNum)]} {
+	if {[info exists stubs($name,unix,lastNum)]} {
+	    set afterUnixNum [expr $stubs($name,unix,lastNum) + 1]
+	} else {
+	    set afterUnixNum 0
+	}
+	if {[info exists stubs($name,aqua,lastNum)]} {
 	    set lastNum $stubs($name,aqua,lastNum)
 	    set temp {}
-	    for {set i 0} {$i <= $lastNum} {incr i} {
-		if {![info exists stubs($name,aqua,$i)]} {
-		    eval {append temp} $skipString
-		} else {
+	    # Again, make sure you don't duplicate entries for macosx & unix & aqua.
+	    for {set i $afterUnixNum} {$i <= $lastNum} {incr i} {
+		if {![info exists stubs($name,macosx,$i)]} {
+		    if {![info exists stubs($name,aqua,$i)]} {
+			eval {append temp} $skipString
+		    } else {
 			append temp [$slotProc $name $stubs($name,aqua,$i) $i]
 		    }
 		}
-		append text [addPlatformGuard aqua $temp]
 	    }
-        # Again, make sure you don't duplicate entries for macosx & unix.
-	if {[info exists stubs($name,macosx,lastNum)]
-                && ![info exists stubs($name,unix,lastNum)]} {
+	    append text [addPlatformGuard aqua $temp]
+	}
+	if {[info exists stubs($name,macosx,lastNum)]} {
 	    set lastNum $stubs($name,macosx,lastNum)
 	    set temp {}
-	    for {set i 0} {$i <= $lastNum} {incr i} {
+	    # Again, make sure you don't duplicate entries for macosx & unix.
+	    for {set i $afterUnixNum} {$i <= $lastNum} {incr i} {
 		if {![info exists stubs($name,macosx,$i)]} {
 		    eval {append temp} $skipString
 		} else {
-			append temp [$slotProc $name $stubs($name,macosx,$i) $i]
-		    }
+		    append temp [$slotProc $name $stubs($name,macosx,$i) $i]
 		}
-		append text [addPlatformGuard macosx $temp]
 	    }
-        # Again, make sure you don't duplicate entries for x11 & unix.
-	if {[info exists stubs($name,x11,lastNum)]
-                && ![info exists stubs($name,unix,lastNum)]} {
+	    append text [addPlatformGuard macosx $temp]
+	}
+	if {[info exists stubs($name,x11,lastNum)]} {
 	    set lastNum $stubs($name,x11,lastNum)
 	    set temp {}
-	    for {set i 0} {$i <= $lastNum} {incr i} {
+	    # Again, make sure you don't duplicate entries for x11 & unix.
+	    for {set i $afterUnixNum} {$i <= $lastNum} {incr i} {
 		if {![info exists stubs($name,x11,$i)]} {
 		    eval {append temp} $skipString
 		} else {
-			append temp [$slotProc $name $stubs($name,x11,$i) $i]
-		    }
+		    append temp [$slotProc $name $stubs($name,x11,$i) $i]
 		}
-		append text [addPlatformGuard x11 $temp]
 	    }
+	    append text [addPlatformGuard x11 $temp]
+	}
     }
 }
 
Index: unix/Makefile.in
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/Makefile.in,v
retrieving revision 1.124
diff -u -r1.124 Makefile.in
--- unix/Makefile.in	11 Apr 2003 16:09:51 -0000	1.124
+++ unix/Makefile.in	14 May 2003 19:13:32 -0000
@@ -435,7 +435,8 @@
 	$(UNIX_DIR)/tclLoadShl.c
 
 MAC_OSX_SRCS = \
-	$(MAC_OSX_DIR)/tclMacOSXBundle.c
+	$(MAC_OSX_DIR)/tclMacOSXBundle.c \
+	$(MAC_OSX_DIR)/tclMacOSXFCmd.c
 
 # Note: don't include DL_SRCS or MAC_OSX_SRCS in SRCS: most of those
 # files won't compile on the current machine, and they will cause
@@ -1053,6 +1054,9 @@
 # This is the CFBundle interface.  It is only used on Mac OS X.
 tclMacOSXBundle.o: $(MAC_OSX_DIR)/tclMacOSXBundle.c
 	$(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXBundle.c
+
+tclMacOSXFCmd.o: $(MAC_OSX_DIR)/tclMacOSXFCmd.c
+	$(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXFCmd.c
 
 # The following targets are not completely general.  They are provide
 # purely for documentation purposes so people who are interested in
Index: unix/configure
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/configure,v
retrieving revision 1.99
diff -u -r1.99 configure
--- unix/configure	4 Apr 2003 00:21:11 -0000	1.99
+++ unix/configure	14 May 2003 19:13:33 -0000
@@ -9562,6 +9562,184 @@
 
 
 #--------------------------------------------------------------------
+# Check for support of chflags function
+#--------------------------------------------------------------------
+
+
+for ac_func in chflags
+do
+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
+if eval "test \"\${$as_ac_var+set}\" = set"; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func (); below.
+    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+    <limits.h> exists even on freestanding compilers.  */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+/* Override any gcc2 internal prototype to avoid an error.  */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+   builtin and then its argument prototype would still apply.  */
+char $ac_func ();
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+char (*f) () = $ac_func;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != $ac_func;
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+  (eval $ac_link) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } &&
+         { ac_try='test -s conftest$ac_exeext'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  eval "$as_ac_var=yes"
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_var=no"
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+  cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+
+#--------------------------------------------------------------------
+# Check for support of getattrlist function (Darwin, HFS+)
+#--------------------------------------------------------------------
+
+
+for ac_func in getattrlist
+do
+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
+if eval "test \"\${$as_ac_var+set}\" = set"; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func (); below.
+    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+    <limits.h> exists even on freestanding compilers.  */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+/* Override any gcc2 internal prototype to avoid an error.  */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+   builtin and then its argument prototype would still apply.  */
+char $ac_func ();
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+char (*f) () = $ac_func;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != $ac_func;
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+  (eval $ac_link) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } &&
+         { ac_try='test -s conftest$ac_exeext'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  eval "$as_ac_var=yes"
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_var=no"
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+  cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+
+#--------------------------------------------------------------------
 # Look for libraries that we will need when compiling the Tcl shell
 #--------------------------------------------------------------------
 
@@ -11824,7 +12002,7 @@
 	    SHLIB_LD_LIBS='${LIBS}'
 	    SHLIB_SUFFIX=".dylib"
 	    DL_OBJS="tclLoadDyld.o"
-	    PLAT_OBJS="tclMacOSXBundle.o"
+	    PLAT_OBJS="tclMacOSXBundle.o tclMacOSXFCmd.o"
 	    DL_LIBS=""
 	    LDFLAGS="-prebind"
 	    CC_SEARCH_FLAGS=""
Index: unix/configure.in
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/configure.in,v
retrieving revision 1.108
diff -u -r1.108 configure.in
--- unix/configure.in	13 Mar 2003 10:39:58 -0000	1.108
+++ unix/configure.in	14 May 2003 19:13:33 -0000
@@ -417,6 +417,18 @@
 SC_ENABLE_LANGINFO
 
 #--------------------------------------------------------------------
+# Check for support of chflags function
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNCS(chflags)
+
+#--------------------------------------------------------------------
+# Check for support of getattrlist function (Darwin, HFS+)
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNCS(getattrlist)
+
+#--------------------------------------------------------------------
 # Look for libraries that we will need when compiling the Tcl shell
 #--------------------------------------------------------------------
 
Index: unix/tcl.m4
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tcl.m4,v
retrieving revision 1.102
diff -u -r1.102 tcl.m4
--- unix/tcl.m4	4 Apr 2003 00:21:12 -0000	1.102
+++ unix/tcl.m4	14 May 2003 19:13:33 -0000
@@ -1281,7 +1281,7 @@
 	    SHLIB_LD_LIBS='${LIBS}'
 	    SHLIB_SUFFIX=".dylib"
 	    DL_OBJS="tclLoadDyld.o"
-	    PLAT_OBJS="tclMacOSXBundle.o"
+	    PLAT_OBJS="tclMacOSXBundle.o tclMacOSXFCmd.o"
 	    DL_LIBS=""
 	    LDFLAGS="-prebind"
 	    CC_SEARCH_FLAGS=""
Index: unix/tclUnixFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFCmd.c,v
retrieving revision 1.28
diff -u -r1.28 tclUnixFCmd.c
--- unix/tclUnixFCmd.c	10 Feb 2003 12:50:31 -0000	1.28
+++ unix/tclUnixFCmd.c	14 May 2003 19:13:33 -0000
@@ -91,6 +91,14 @@
 static int		GetModeFromPermString _ANSI_ARGS_((
 			    Tcl_Interp *interp, char *modeStringPtr,
 			    mode_t *modePtr));
+#ifdef HAVE_CHFLAGS
+static int		GetReadOnlyAttribute _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, Tcl_Obj *fileName,
+			    Tcl_Obj **attributePtrPtr));
+static int		SetReadOnlyAttribute _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, Tcl_Obj *fileName,
+			    Tcl_Obj *attributePtr));
+#endif
 
 /*
  * Prototype for the TraverseUnixTree callback function.
@@ -107,28 +115,53 @@
 enum {
     UNIX_GROUP_ATTRIBUTE,
     UNIX_OWNER_ATTRIBUTE,
-    UNIX_PERMISSIONS_ATTRIBUTE
+    UNIX_PERMISSIONS_ATTRIBUTE,
+#ifdef HAVE_CHFLAGS
+    UNIX_READONLY_ATTRIBUTE,
+#endif
+#ifdef MAC_OSX_TCL
+    MACOSX_CREATOR_ATTRIBUTE,
+    MACOSX_TYPE_ATTRIBUTE,
+    MACOSX_HIDDEN_ATTRIBUTE,
+    MACOSX_RSRCLENGTH_ATTRIBUTE,
+#endif
 };
 
 CONST char *tclpFileAttrStrings[] = {
     "-group",
     "-owner",
     "-permissions",
+#ifdef HAVE_CHFLAGS
+    "-readonly",
+#endif
+#ifdef MAC_OSX_TCL
+    "-creator",
+    "-type",
+    "-hidden",
+    "-rsrclength",
+#endif
     (char *) NULL
 };
 
 CONST TclFileAttrProcs tclpFileAttrProcs[] = {
     {GetGroupAttribute,		SetGroupAttribute},
     {GetOwnerAttribute,		SetOwnerAttribute},
-    {GetPermissionsAttribute,	SetPermissionsAttribute}
+    {GetPermissionsAttribute,	SetPermissionsAttribute},
+#ifdef HAVE_CHFLAGS
+    {GetReadOnlyAttribute,	SetReadOnlyAttribute},
+#endif
+#ifdef MAC_OSX_TCL
+    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
+    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
+    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
+    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
+#endif
 };
 
 /*
  * Declarations for local procedures defined in this file:
  */
 
-static int		CopyFile _ANSI_ARGS_((CONST char *src,
-			    CONST char *dst, CONST Tcl_StatBuf *statBufPtr));
 static int		CopyFileAtts _ANSI_ARGS_((CONST char *src,
 			    CONST char *dst, CONST Tcl_StatBuf *statBufPtr));
 static int		DoCopyFile _ANSI_ARGS_((CONST char *srcPtr,
@@ -400,7 +433,7 @@
 	    return CopyFileAtts(src, dst, &srcStatBuf);
 	}
         default: {
-	    return CopyFile(src, dst, &srcStatBuf);
+	    return TclUnixCopyFile(src, dst, &srcStatBuf, 0);
 	}
     }
     return TCL_OK;
@@ -409,7 +442,7 @@
 /*
  *----------------------------------------------------------------------
  *
- * CopyFile - 
+ * TclUnixCopyFile - 
  *
  *      Helper function for TclpCopyFile.  Copies one regular file,
  *	using read() and write().
@@ -423,13 +456,14 @@
  *----------------------------------------------------------------------
  */
 
-static int 
-CopyFile(src, dst, statBufPtr) 
+int 
+TclUnixCopyFile(src, dst, statBufPtr, dontCopyAtts) 
     CONST char *src;		/* Pathname of file to copy (native). */
     CONST char *dst;		/* Pathname of file to create/overwrite
 				 * (native). */
     CONST Tcl_StatBuf *statBufPtr;
 				/* Used to determine mode and blocksize. */
+    int dontCopyAtts;		/* if flag set, don't copy attributes. */
 {
     int srcFd;
     int dstFd;
@@ -483,7 +517,7 @@
 	unlink(dst);					/* INTL: Native. */
 	return TCL_ERROR;
     }
-    if (CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) {
+    if (!dontCopyAtts && CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) {
 	/*
 	 * The copy succeeded, but setting the permissions failed, so be in
 	 * a consistent state, we remove the file that was created by the
@@ -1071,6 +1105,9 @@
     if (utime(dst, &tval)) {				/* INTL: Native. */
 	return TCL_ERROR;
     }
+#ifdef MAC_OSX_TCL
+    TclMacOSXCopyFileAttributes(src, dst, statBufPtr);
+#endif
     return TCL_OK;
 }
 
@@ -1781,6 +1818,105 @@
 
     return nextCheckpoint;
 }
+
+#ifdef HAVE_CHFLAGS
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetReadOnlyAttribute
+ *
+ *      Gets the readonly attribute (user immutable flag) of a file.
+ *
+ * Results:
+ *	Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr
+ *	if there is no error. The object will have ref count 0.
+ *
+ * Side effects:
+ *      A new object is allocated.
+ *      
+ *----------------------------------------------------------------------
+ */
 
+static int
+GetReadOnlyAttribute(interp, objIndex, fileName, attributePtrPtr)
+    Tcl_Interp *interp;		    /* The interp we are using for errors. */
+    int objIndex;		    /* The index of the attribute. */
+    Tcl_Obj *fileName;  	    /* The name of the file (UTF-8). */
+    Tcl_Obj **attributePtrPtr;	    /* A pointer to return the object with. */
+{
+    Tcl_StatBuf statBuf;
+    int result;
 
+    result = TclpObjStat(fileName, &statBuf);
+    
+    if (result != 0) {
+	Tcl_AppendResult(interp, "could not read \"", 
+		Tcl_GetString(fileName), "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }
 
+    *attributePtrPtr = Tcl_NewBooleanObj((statBuf.st_flags & UF_IMMUTABLE) != 0);
+    
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SetReadOnlyAttribute
+ *
+ *      Sets the readonly attribute (user immutable flag) of a file.
+ *
+ * Results:
+ *      Standard TCL result.
+ *
+ * Side effects:
+ *      The readonly attribute of the file is changed.
+ *      
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SetReadOnlyAttribute(interp, objIndex, fileName, attributePtr)
+    Tcl_Interp *interp;		    /* The interp we are using for errors. */
+    int objIndex;		    /* The index of the attribute. */
+    Tcl_Obj *fileName;  	    /* The name of the file (UTF-8). */
+    Tcl_Obj *attributePtr;	    /* The attribute to set. */
+{
+    Tcl_StatBuf statBuf;
+    int result;
+    int readonly;
+    CONST char *native;
+
+    if (Tcl_GetBooleanFromObj(interp, attributePtr, &readonly) != TCL_OK) {
+        return TCL_ERROR;
+    }
+
+    result = TclpObjStat(fileName, &statBuf);
+    
+    if (result != 0) {
+	Tcl_AppendResult(interp, "could not read \"", 
+		Tcl_GetString(fileName), "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (readonly) {
+        statBuf.st_flags |= UF_IMMUTABLE;
+    } else {
+        statBuf.st_flags &= ~UF_IMMUTABLE;
+    }
+
+    native = Tcl_FSGetNativePath(fileName);
+    result = chflags(native, statBuf.st_flags);		/* INTL: Native. */
+    if (result != 0) {
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"could not set flags for file \"", 
+		Tcl_GetString(fileName), "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+#endif /* HAVE_CHFLAGS */
