Attachment "823329.diff" to
ticket [823329ffff]
added by
das
2006-03-20 21:38:53.
Index: generic/tclInt.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.decls,v
retrieving revision 1.95
diff -u -p -r1.95 tclInt.decls
--- generic/tclInt.decls 8 Feb 2006 21:41:27 -0000 1.95
+++ generic/tclInt.decls 20 Mar 2006 14:06:35 -0000
@@ -1097,3 +1097,9 @@ declare 17 macosx {
CONST Tcl_StatBuf *statBufPtr)
}
+declare 18 macosx {
+ int TclMacOSXMatchType(Tcl_Interp *interp, CONST char *pathName,
+ CONST char *fileName, Tcl_StatBuf *statBufPtr,
+ Tcl_GlobTypeData *types)
+}
+
Index: generic/tclIntPlatDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIntPlatDecls.h,v
retrieving revision 1.28
diff -u -p -r1.28 tclIntPlatDecls.h
--- generic/tclIntPlatDecls.h 13 Dec 2005 22:43:18 -0000 1.28
+++ generic/tclIntPlatDecls.h 20 Mar 2006 14:06:35 -0000
@@ -295,6 +295,14 @@ EXTERN int TclMacOSXCopyFileAttributes
CONST char * src, CONST char * dst,
CONST Tcl_StatBuf * statBufPtr));
#endif
+#ifndef TclMacOSXMatchType_TCL_DECLARED
+#define TclMacOSXMatchType_TCL_DECLARED
+/* 18 */
+EXTERN int TclMacOSXMatchType _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * pathName, CONST char * fileName,
+ Tcl_StatBuf * statBufPtr,
+ Tcl_GlobTypeData * types));
+#endif
#endif /* MAC_OSX_TCL */
typedef struct TclIntPlatStubs {
@@ -354,6 +362,7 @@ typedef struct TclIntPlatStubs {
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 */
+ int (*tclMacOSXMatchType) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pathName, CONST char * fileName, Tcl_StatBuf * statBufPtr, Tcl_GlobTypeData * types)); /* 18 */
#endif /* MAC_OSX_TCL */
} TclIntPlatStubs;
@@ -547,6 +556,10 @@ extern TclIntPlatStubs *tclIntPlatStubsP
#define TclMacOSXCopyFileAttributes \
(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
#endif
+#ifndef TclMacOSXMatchType
+#define TclMacOSXMatchType \
+ (tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
+#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.129
diff -u -p -r1.129 tclStubInit.c
--- generic/tclStubInit.c 8 Feb 2006 21:41:27 -0000 1.129
+++ generic/tclStubInit.c 20 Mar 2006 14:06:35 -0000
@@ -375,6 +375,7 @@ TclIntPlatStubs tclIntPlatStubs = {
TclMacOSXGetFileAttribute, /* 15 */
TclMacOSXSetFileAttribute, /* 16 */
TclMacOSXCopyFileAttributes, /* 17 */
+ TclMacOSXMatchType, /* 18 */
#endif /* MAC_OSX_TCL */
};
Index: macosx/tclMacOSXFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/macosx/tclMacOSXFCmd.c,v
retrieving revision 1.7
diff -u -p -r1.7 tclMacOSXFCmd.c
--- macosx/tclMacOSXFCmd.c 27 Nov 2005 06:09:10 -0000 1.7
+++ macosx/tclMacOSXFCmd.c 20 Mar 2006 14:06:35 -0000
@@ -5,7 +5,7 @@
* subcommands of the "file" command.
*
* Copyright (c) 2003 Tcl Core Team.
- * Copyright (c) 2003-2005 Daniel A. Steffen <[email protected]>
+ * Copyright (c) 2003-2006 Daniel A. Steffen <[email protected]>
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -57,9 +57,19 @@ enum {
typedef u_int32_t OSType;
-static int Tcl_GetOSTypeFromObj(Tcl_Interp *interp,
+static int GetOSTypeFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, OSType *osTypePtr);
-static Tcl_Obj * Tcl_NewOSTypeStringObj(CONST OSType newOSType);
+static Tcl_Obj * NewOSTypeObj(CONST OSType newOSType);
+static int SetOSTypeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void UpdateStringOfOSType(Tcl_Obj *objPtr);
+
+static Tcl_ObjType tclOSTypeType = {
+ "osType", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ UpdateStringOfOSType, /* updateStringProc */
+ SetOSTypeFromAny /* setFromAnyProc */
+};
enum {
kIsInvisible = 0x4000,
@@ -152,11 +162,11 @@ TclMacOSXGetFileAttribute(
switch (objIndex) {
case MACOSX_CREATOR_ATTRIBUTE:
- *attributePtrPtr = Tcl_NewOSTypeStringObj(
+ *attributePtrPtr = NewOSTypeObj(
OSSwapBigToHostInt32(finder->creator));
break;
case MACOSX_TYPE_ATTRIBUTE:
- *attributePtrPtr = Tcl_NewOSTypeStringObj(
+ *attributePtrPtr = NewOSTypeObj(
OSSwapBigToHostInt32(finder->type));
break;
case MACOSX_HIDDEN_ATTRIBUTE:
@@ -248,13 +258,13 @@ TclMacOSXSetFileAttribute(
switch (objIndex) {
case MACOSX_CREATOR_ATTRIBUTE:
- if (Tcl_GetOSTypeFromObj(interp, attributePtr, &t) != TCL_OK) {
+ if (GetOSTypeFromObj(interp, attributePtr, &t) != TCL_OK) {
return TCL_ERROR;
}
finder->creator = OSSwapHostToBigInt32(t);
break;
case MACOSX_TYPE_ATTRIBUTE:
- if (Tcl_GetOSTypeFromObj(interp, attributePtr, &t) != TCL_OK) {
+ if (GetOSTypeFromObj(interp, attributePtr, &t) != TCL_OK) {
return TCL_ERROR;
}
finder->type = OSSwapHostToBigInt32(t);
@@ -359,7 +369,7 @@ TclMacOSXCopyFileAttributes(
if (copyfile(src, dst, NULL, COPYFILE_XATTR |
(S_ISLNK(statBufPtr->st_mode) ? COPYFILE_NOFOLLOW_SRC :
COPYFILE_ACL)) < 0) {
- return TCL_ERROR;
+ return TCL_ERROR;
}
return TCL_OK;
#elif defined(HAVE_GETATTRLIST)
@@ -426,7 +436,74 @@ TclMacOSXCopyFileAttributes(
/*
*----------------------------------------------------------------------
*
- * Tcl_GetOSTypeFromObj --
+ * TclMacOSXMatchType --
+ *
+ * This routine is used by the globbing code to check if a file
+ * matches a given mac type and/or creator code.
+ *
+ * Results:
+ * The return value is 1, 0 or -1 indicating whether the file
+ * matches the given criteria, does not match them, or an error
+ * occurred (in wich case an error is left in interp).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMacOSXMatchType(
+ Tcl_Interp *interp, /* Interpreter to receive errors. */
+ CONST char *pathName, /* Native path to check. */
+ CONST char *fileName, /* Native filename to check. */
+ Tcl_StatBuf *statBufPtr, /* Stat info for file to check */
+ Tcl_GlobTypeData *types) /* Type description to match against. */
+{
+#ifdef HAVE_GETATTRLIST
+ struct attrlist alist;
+ fileinfobuf finfo;
+ finderinfo *finder = (finderinfo*)(&finfo.data);
+ OSType osType;
+
+ bzero(&alist, sizeof(struct attrlist));
+ alist.bitmapcount = ATTR_BIT_MAP_COUNT;
+ alist.commonattr = ATTR_CMN_FNDRINFO;
+ if (getattrlist(pathName, &alist, &finfo, sizeof(fileinfobuf), 0) != 0) {
+ return 0;
+ }
+ if ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
+ !((finder->fdFlags & kFinfoIsInvisible) || (*fileName == '.'))) {
+ return 0;
+ }
+ if (S_ISDIR(statBufPtr->st_mode) && (types->macType || types->macCreator)) {
+ /* Directories don't support types or creators */
+ return 0;
+ }
+ if (types->macType) {
+ if (GetOSTypeFromObj(interp, types->macType, &osType) != TCL_OK) {
+ return -1;
+ }
+ if (osType != OSSwapBigToHostInt32(finder->type)) {
+ return 0;
+ }
+ }
+ if (types->macCreator) {
+ if (GetOSTypeFromObj(interp, types->macCreator, &osType) != TCL_OK) {
+ return -1;
+ }
+ if (osType != OSSwapBigToHostInt32(finder->creator)) {
+ return 0;
+ }
+ }
+#endif
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetOSTypeFromObj --
*
* Attempt to return an OSType from the Tcl object "objPtr".
*
@@ -441,11 +518,70 @@ TclMacOSXCopyFileAttributes(
*/
static int
-Tcl_GetOSTypeFromObj(
+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. */
{
+ int result = TCL_OK;
+
+ if (objPtr->typePtr != &tclOSTypeType) {
+ result = tclOSTypeType.setFromAnyProc(interp, objPtr);
+ };
+ *osTypePtr = (OSType) objPtr->internalRep.longValue;
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewOSTypeObj --
+ *
+ * Create a new OSType object.
+ *
+ * Results:
+ * The newly created OSType object is returned, it has ref count 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+NewOSTypeObj(
+ CONST OSType osType) /* OSType used to initialize the new object. */
+{
+ Tcl_Obj *objPtr;
+
+ TclNewObj(objPtr);
+ Tcl_InvalidateStringRep(objPtr);
+ objPtr->internalRep.longValue = (long) osType;
+ objPtr->typePtr = &tclOSTypeType;
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetOSTypeFromAny --
+ *
+ * Attempts to force the internal representation for a Tcl object to
+ * tclOSTypeType, specifically.
+ *
+ * Results:
+ * The return value is a standard object Tcl result. If an error occurs
+ * during conversion, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetOSTypeFromAny(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_Obj *objPtr) /* Pointer to the object to convert */
+{
char *string;
int length, result = TCL_OK;
Tcl_DString ds;
@@ -459,13 +595,17 @@ Tcl_GetOSTypeFromObj(
string, "\": ", NULL);
result = TCL_ERROR;
} else {
+ OSType osType;
char string[4] = {'\0','\0','\0','\0'};
memcpy(string, Tcl_DStringValue(&ds),
(size_t) Tcl_DStringLength(&ds));
- *osTypePtr = (OSType) string[0] << 24 |
- (OSType) string[1] << 16 |
- (OSType) string[2] << 8 |
- (OSType) string[3];
+ osType = (OSType) string[0] << 24 |
+ (OSType) string[1] << 16 |
+ (OSType) string[2] << 8 |
+ (OSType) string[3];
+ TclFreeIntRep(objPtr);
+ objPtr->internalRep.longValue = (long) osType;
+ objPtr->typePtr = &tclOSTypeType;
}
Tcl_DStringFree(&ds);
Tcl_FreeEncoding(encoding);
@@ -475,39 +615,42 @@ Tcl_GetOSTypeFromObj(
/*
*----------------------------------------------------------------------
*
- * Tcl_NewOSTypeStringObj --
+ * UpdateStringOfOSType --
*
- * Create a new OSType string object.
+ * Update the string representation for an OSType object. Note: This
+ * function does not free an existing old string rep so storage will be
+ * lost if this has not already been done.
*
* Results:
- * The newly created string object is returned, it has ref count 0.
+ * None.
*
* Side effects:
- * None.
+ * The object's string is set to a valid string that results from the
+ * OSType-to-string conversion.
*
*----------------------------------------------------------------------
*/
-static Tcl_Obj *
-Tcl_NewOSTypeStringObj(
- CONST OSType newOSType) /* OSType used to initialize the new object. */
+static void
+UpdateStringOfOSType(
+ register Tcl_Obj *objPtr) /* OSType object whose string rep to update. */
{
char string[5];
- Tcl_Obj *resultPtr;
+ OSType osType = (OSType) objPtr->internalRep.longValue;
Tcl_DString ds;
Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
- string[0] = (char) (newOSType >> 24);
- string[1] = (char) (newOSType >> 16);
- string[2] = (char) (newOSType >> 8);
- string[3] = (char) (newOSType);
+ string[0] = (char) (osType >> 24);
+ string[1] = (char) (osType >> 16);
+ string[2] = (char) (osType >> 8);
+ string[3] = (char) (osType);
string[4] = '\0';
Tcl_ExternalToUtfDString(encoding, string, -1, &ds);
- resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds));
+ objPtr->bytes = ckalloc((unsigned) Tcl_DStringLength(&ds) + 1);
+ strcpy(objPtr->bytes, Tcl_DStringValue(&ds));
+ objPtr->length = Tcl_DStringLength(&ds);
Tcl_DStringFree(&ds);
Tcl_FreeEncoding(encoding);
- return resultPtr;
}
/*
Index: tests/macOSXFCmd.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/macOSXFCmd.test,v
retrieving revision 1.2
diff -u -p -r1.2 macOSXFCmd.test
--- tests/macOSXFCmd.test 19 May 2004 20:15:32 -0000 1.2
+++ tests/macOSXFCmd.test 20 Mar 2006 14:06:35 -0000
@@ -66,15 +66,15 @@ test macOSXFCmd-1.5 {MacOSXGetFileAttrib
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
+ list [catch {file attributes foo.test -creator FOOC} 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 \
+ list [catch {file attributes foo.test -creator FOOC} msg] $msg \
[catch {file attributes foo.test -creator} msg] $msg \
[file delete -force -- foo.test]
-} {0 {} 0 FOOO {}}
+} {0 {} 0 FOOC {}}
test macOSXFCmd-2.3 {MacOSXSetFileAttribute - empty creator} {macosxFileAttr notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
@@ -85,10 +85,10 @@ test macOSXFCmd-2.3 {MacOSXSetFileAttrib
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 \
+ list [catch {file attributes foo.test -type FOOT} msg] $msg \
[catch {file attributes foo.test -type} msg] $msg \
[file delete -force -- foo.test]
-} {0 {} 0 FOOO {}}
+} {0 {} 0 FOOT {}}
test macOSXFCmd-2.5 {MacOSXSetFileAttribute - empty type} {macosxFileAttr notRoot} {
catch {file delete -force -- foo.test}
close [open foo.test w]
@@ -123,7 +123,7 @@ test macOSXFCmd-3.1 {MacOSXCopyFileAttri
catch {file delete -force -- bar.test}
close [open foo.test w]
catch {
- file attributes foo.test -creator FOOO -type FOOO -hidden 1
+ file attributes foo.test -creator FOOC -type FOOT -hidden 1
set f [open foo.test/rsrc w]
fconfigure $f -translation lf -eofchar {}
puts -nonewline $f "foo"
@@ -135,7 +135,49 @@ test macOSXFCmd-3.1 {MacOSXCopyFileAttri
[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 {}}
+} {0 FOOC 0 FOOT 0 1 0 3 {}}
+
+test macOSXFCmd-4.1 {TclMacOSXMatchType} {macosxFileAttr notRoot} {
+ file mkdir globtest
+ cd globtest
+ foreach f {bar baz foo inv inw .nv reg} {
+ catch {file delete -force -- $f.test}
+ close [open $f.test w]
+ }
+ catch {file delete -force -- dir.test}
+ file mkdir dir.test
+ catch {
+ file attributes bar.test -type FOOT
+ file attributes baz.test -creator FOOC -type FOOT
+ file attributes foo.test -creator FOOC
+ file attributes inv.test -hidden 1
+ file attributes inw.test -hidden 1 -type FOOT
+ file attributes dir.test -hidden 1
+ }
+ set res [list \
+ [catch {glob *.test} msg] $msg \
+ [catch {glob -types FOOT *.test} msg] $msg \
+ [catch {glob -types {{macintosh type FOOT}} *.test} msg] $msg \
+ [catch {glob -types FOOTT *.test} msg] $msg \
+ [catch {glob -types {{macintosh type FOOTT}} *.test} msg] $msg \
+ [catch {glob -types {{macintosh type {}}} *.test} msg] $msg \
+ [catch {glob -types {{macintosh creator FOOC}} *.test} msg] $msg \
+ [catch {glob -types {{macintosh creator FOOC} {macintosh type FOOT}} *.test} msg] $msg \
+ [catch {glob -types hidden *.test} msg] $msg \
+ [catch {glob -types {hidden FOOT} *.test} msg] $msg \
+ ]
+ cd ..
+ file delete -force globtest
+ set res
+} [list \
+ 0 {bar.test baz.test dir.test foo.test inv.test inw.test reg.test} \
+ 0 {bar.test baz.test inw.test} 0 {bar.test baz.test inw.test} \
+ 1 {bad argument to "-types": FOOTT} \
+ 1 {expected Macintosh OS type but got "FOOTT": } \
+ 0 {foo.test inv.test reg.test} 0 {baz.test foo.test} \
+ 0 baz.test 0 {.nv.test dir.test inv.test inw.test} \
+ 0 inw.test
+]
# cleanup
cd $oldcwd
Index: unix/tclUnixFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFile.c,v
retrieving revision 1.47
diff -u -p -r1.47 tclUnixFile.c
--- unix/tclUnixFile.c 11 Nov 2005 23:46:36 -0000 1.47
+++ unix/tclUnixFile.c 20 Mar 2006 14:06:36 -0000
@@ -15,7 +15,8 @@
#include "tclInt.h"
#include "tclFileSystem.h"
-static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types);
+static int NativeMatchType(Tcl_Interp *interp, CONST char* nativeEntry,
+ CONST char* nativeName, Tcl_GlobTypeData *types);
/*
*---------------------------------------------------------------------------
@@ -208,6 +209,7 @@ TclpMatchInDirectory(
{
CONST char *native;
Tcl_Obj *fileNamePtr;
+ int matchResult = 0;
if (types != NULL && types->type == TCL_GLOB_TYPE_MOUNT) {
/*
@@ -226,19 +228,24 @@ TclpMatchInDirectory(
/*
* Match a file directly.
*/
+ Tcl_Obj *tailPtr;
+ CONST char *nativeTail;
native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
- if (NativeMatchType(native, types)) {
+ tailPtr = TclPathPart(interp, pathPtr, TCL_PATH_TAIL);
+ nativeTail = (CONST char*) Tcl_FSGetNativePath(tailPtr);
+ matchResult = NativeMatchType(interp, native, nativeTail, types);
+ if (matchResult == 1) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
}
+ Tcl_DecrRefCount(tailPtr);
Tcl_DecrRefCount(fileNamePtr);
- return TCL_OK;
} else {
DIR *d;
Tcl_DirEntry *entryPtr;
CONST char *dirName;
int dirLength;
- int matchHidden;
+ int matchHidden, matchHiddenPat;
int nativeDirLen;
Tcl_StatBuf statBuf;
Tcl_DString ds; /* native encoding of dir */
@@ -305,10 +312,10 @@ TclpMatchInDirectory(
* Check to see if -type or the pattern requests hidden files.
*/
- matchHidden = ((types && (types->perm & TCL_GLOB_PERM_HIDDEN))
- || ((pattern[0] == '.')
- || ((pattern[0] == '\\') && (pattern[1] == '.'))));
-
+ matchHiddenPat = (pattern[0] == '.')
+ || ((pattern[0] == '\\') && (pattern[1] == '.'));
+ matchHidden = matchHiddenPat
+ || (types && (types->perm & TCL_GLOB_PERM_HIDDEN));
while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */
Tcl_DString utfDs;
CONST char *utfname;
@@ -321,7 +328,12 @@ TclpMatchInDirectory(
if (*entryPtr->d_name == '.') {
if (!matchHidden) continue;
} else {
+#ifdef MAC_OSX_TCL
+ if (matchHiddenPat) continue;
+ /* Also need to check HFS hidden flag in TclMacOSXMatchType. */
+#else
if (matchHidden) continue;
+#endif
}
/*
@@ -337,7 +349,9 @@ TclpMatchInDirectory(
if (types != NULL) {
Tcl_DStringSetLength(&ds, nativeDirLen);
native = Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
- typeOk = NativeMatchType(native, types);
+ matchResult = NativeMatchType(interp, native,
+ entryPtr->d_name, types);
+ typeOk = (matchResult == 1);
}
if (typeOk) {
Tcl_ListObjAppendElement(interp, resultPtr,
@@ -346,19 +360,47 @@ TclpMatchInDirectory(
}
}
Tcl_DStringFree(&utfDs);
+ if (matchResult < 0) {
+ break;
+ }
}
closedir(d);
Tcl_DStringFree(&ds);
Tcl_DStringFree(&dsOrig);
Tcl_DecrRefCount(fileNamePtr);
+ }
+ if (matchResult < 0) {
+ return TCL_ERROR;
+ } else {
return TCL_OK;
}
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * NativeMatchType --
+ *
+ * This routine is used by the globbing code to check if a file
+ * matches a given type description.
+ *
+ * Results:
+ * The return value is 1, 0 or -1 indicating whether the file
+ * matches the given criteria, does not match them, or an error
+ * occurred (in wich case an error is left in interp).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
static int
NativeMatchType(
+ Tcl_Interp *interp, /* Interpreter to receive errors. */
CONST char *nativeEntry, /* Native path to check. */
+ CONST char *nativeName, /* Native filename to check. */
Tcl_GlobTypeData *types) /* Type description to match against. */
{
Tcl_StatBuf buf;
@@ -405,6 +447,10 @@ NativeMatchType(
(access(nativeEntry, W_OK) != 0)) ||
((types->perm & TCL_GLOB_PERM_X) &&
(access(nativeEntry, X_OK) != 0))
+#ifndef MAC_OSX_TCL
+ || ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
+ (*nativeName != '.'))
+#endif
) {
return 0;
}
@@ -454,7 +500,7 @@ NativeMatchType(
if (types->type & TCL_GLOB_TYPE_LINK) {
if (TclOSlstat(nativeEntry, &buf) == 0) {
if (S_ISLNK(buf.st_mode)) {
- return 1;
+ goto filetypeOK;
}
}
}
@@ -462,6 +508,29 @@ NativeMatchType(
return 0;
}
}
+ filetypeOK: ;
+#ifdef MAC_OSX_TCL
+ if (types->macType != NULL || types->macCreator != NULL ||
+ (types->perm & TCL_GLOB_PERM_HIDDEN)) {
+ int matchResult;
+
+ if (types->perm == 0 && types->type == 0) {
+ /*
+ * We haven't yet done a stat on the file.
+ */
+
+ if (TclOSstat(nativeEntry, &buf) != 0) {
+ return 0;
+ }
+ }
+
+ matchResult = TclMacOSXMatchType(interp, nativeEntry, nativeName,
+ &buf, types);
+ if (matchResult != 1) {
+ return matchResult;
+ }
+ }
+#endif
}
return 1;
}
