diff options
| -rw-r--r-- | ChangeLog | 32 | ||||
| -rw-r--r-- | generic/tclInt.decls | 8 | ||||
| -rw-r--r-- | generic/tclIntPlatDecls.h | 15 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 3 | ||||
| -rw-r--r-- | macosx/tclMacOSXFCmd.c | 203 | ||||
| -rw-r--r-- | tests/macOSXFCmd.test | 58 | ||||
| -rw-r--r-- | unix/tclUnixFile.c | 91 |
7 files changed, 347 insertions, 63 deletions
@@ -1,17 +1,27 @@ +2006-03-21 Daniel Steffen <das@users.sourceforge.net> + + * generic/tclInt.decls: implement globbing for HFS creator & type + * macosx/tclMacOSXFCmd.c: codes and 'hidden' flag, as documented in + * tests/macOSXFCmd.test: glob.n; objectified OSType handling in [glob] + * unix/tclUnixFile.c: and [file attributes]; fix globbing for hidden + files with pattern==NULL arg. [Bug 823329] + * generic/tclIntPlatDecls.h: + * generic/tclStubInit.c: make genstubs + 2006-03-20 Andreas Kupries <andreask@activestate.com> * win/Makefile.in (install-libraries): Generate tcl8/8.4 directory - under Windows as well (cygwin Makefile). Related entry: - 2006-03-07, dgp. This moved the installation of http from 8.2 to - 8.4, partially. A fix of the required directory creation was - done for unix on Mar 10, without entry in the Changelog. This - entry is for the fix of the directory creation under Windows. - - * unix/installManPage: There is always one even more broken - "sed". Moved the # comment starting character in the sed script to - the beginning of their respective lines. The AIX sed will not - recognize them as comments otherwise :( The actual text stays - indented for better association with the commands they belong to. + under Windows as well (cygwin Makefile). Related entry: 2006-03-07, + dgp. This moved the installation of http from 8.2 to 8.4, partially. A + fix of the required directory creation was done for unix on Mar 10, + without entry in the Changelog. This entry is for the fix of the + directory creation under Windows. + + * unix/installManPage: There is always one even more broken "sed". + Moved the # comment starting character in the sed script to the + beginning of their respective lines. The AIX sed will not recognize + them as comments otherwise :( The actual text stays indented for better + association with the commands they belong to. 2006-03-20 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> diff --git a/generic/tclInt.decls b/generic/tclInt.decls index aef1260..47ce454 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -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.decls,v 1.95 2006/02/08 21:41:27 dgp Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.96 2006/03/21 11:06:22 das Exp $ library tcl @@ -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) +} + diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index c05b3a5..248a7e6 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -9,7 +9,7 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.28 2005/12/13 22:43:18 kennykb Exp $ + * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.29 2006/03/21 11:06:22 das Exp $ */ #ifndef _TCLINTPLATDECLS @@ -295,6 +295,14 @@ EXTERN int TclMacOSXCopyFileAttributes _ANSI_ARGS_(( 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 *tclIntPlatStubsPtr; #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) */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 45b947f..79130e2 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.129 2006/02/08 21:41:27 dgp Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.130 2006/03/21 11:06:22 das Exp $ */ #include "tclInt.h" @@ -375,6 +375,7 @@ TclIntPlatStubs tclIntPlatStubs = { TclMacOSXGetFileAttribute, /* 15 */ TclMacOSXSetFileAttribute, /* 16 */ TclMacOSXCopyFileAttributes, /* 17 */ + TclMacOSXMatchType, /* 18 */ #endif /* MAC_OSX_TCL */ }; diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index caa72a7..80e9785 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -5,12 +5,12 @@ * subcommands of the "file" command. * * Copyright (c) 2003 Tcl Core Team. - * Copyright (c) 2003-2005 Daniel A. Steffen <das@users.sourceforge.net> + * Copyright (c) 2003-2006 Daniel A. Steffen <das@users.sourceforge.net> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMacOSXFCmd.c,v 1.7 2005/11/27 06:09:10 das Exp $ + * RCS: @(#) $Id: tclMacOSXFCmd.c,v 1.8 2006/03/21 11:06:23 das Exp $ */ #include "tclInt.h" @@ -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; } /* diff --git a/tests/macOSXFCmd.test b/tests/macOSXFCmd.test index 2250435..b5f77c5 100644 --- a/tests/macOSXFCmd.test +++ b/tests/macOSXFCmd.test @@ -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: macOSXFCmd.test,v 1.2 2004/05/19 20:15:32 dkf Exp $ +# RCS: @(#) $Id: macOSXFCmd.test,v 1.3 2006/03/21 11:06:23 das Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -66,15 +66,15 @@ test macOSXFCmd-1.5 {MacOSXGetFileAttribute - rsrclength} {macosxFileAttr notRoo 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 {MacOSXSetFileAttribute - empty creator} {macosxFileAttr not 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 {MacOSXCopyFileAttributes} {macosxFileAttr notRoot} { 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 {MacOSXCopyFileAttributes} {macosxFileAttr notRoot} { [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 diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 9dbe08c..c1092e9 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -9,13 +9,14 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixFile.c,v 1.47 2005/11/11 23:46:36 dkf Exp $ + * RCS: @(#) $Id: tclUnixFile.c,v 1.48 2006/03/21 11:06:24 das Exp $ */ #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; } |