summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordas <das>2006-03-21 11:06:20 (GMT)
committerdas <das>2006-03-21 11:06:20 (GMT)
commitd4070e928ea23c067c492b5e594d206a76d9b3d5 (patch)
tree9b31284ec3cc00460868746481c7082902a886a4
parentd13045d5f4f8b28861b4c1af3c4ceaa21331c173 (diff)
downloadtcl-d4070e928ea23c067c492b5e594d206a76d9b3d5.zip
tcl-d4070e928ea23c067c492b5e594d206a76d9b3d5.tar.gz
tcl-d4070e928ea23c067c492b5e594d206a76d9b3d5.tar.bz2
* 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
-rw-r--r--ChangeLog32
-rw-r--r--generic/tclInt.decls8
-rw-r--r--generic/tclIntPlatDecls.h15
-rw-r--r--generic/tclStubInit.c3
-rw-r--r--macosx/tclMacOSXFCmd.c203
-rw-r--r--tests/macOSXFCmd.test58
-rw-r--r--unix/tclUnixFile.c91
7 files changed, 347 insertions, 63 deletions
diff --git a/ChangeLog b/ChangeLog
index a0830fd..c042079 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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;
}