summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/file.n4
-rw-r--r--generic/tclBasic.c21
-rw-r--r--generic/tclCmdIL.c3
-rw-r--r--generic/tclCmdMZ.c12
-rw-r--r--generic/tclDictObj.c18
-rw-r--r--generic/tclEnsemble.c33
-rw-r--r--generic/tclIOUtil.c3
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclOO.c9
-rw-r--r--generic/tclOOCall.c9
-rw-r--r--generic/tclOOMethod.c6
-rw-r--r--generic/tclTest.c3
-rw-r--r--tests/cmdAH.test23
-rw-r--r--tests/fileName.test14
-rw-r--r--tests/oo.test12
-rwxr-xr-xwin/tclWinFile.c4
16 files changed, 84 insertions, 94 deletions
diff --git a/doc/file.n b/doc/file.n
index 8e765da..eeb67ed 100644
--- a/doc/file.n
+++ b/doc/file.n
@@ -162,7 +162,9 @@ returns \fB/home\fR (or something similar).
\fBfile executable \fIname\fR
.
Returns \fB1\fR if file \fIname\fR is executable by the current user,
-\fB0\fR otherwise.
+\fB0\fR otherwise. On Windows, which does not have an executable attribute,
+the command treats all directories and any files with extensions
+\fBexe\fR, \fBcom\fR, \fBcmd\fR, \fBbat\fR or \fBps1\fR as executable.
.TP
\fBfile exists \fIname\fR
.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e3ac714..a0b5505 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -128,7 +128,7 @@ static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
int actual, Tcl_Obj *const *objv);
static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
-static int NRCommand(ClientData data[], Tcl_Interp *interp, int result);
+static Tcl_NRPostProc NRCommand;
static Tcl_ObjCmdProc OldMathFuncProc;
static void OldMathFuncDeleteProc(ClientData clientData);
@@ -146,7 +146,6 @@ static int TEOV_RunEnterTraces(Tcl_Interp *interp,
Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc,
Tcl_Obj *const objv[]);
static Tcl_NRPostProc RewindCoroutineCallback;
-static Tcl_NRPostProc TailcallCleanup;
static Tcl_NRPostProc TEOEx_ByteCodeCallback;
static Tcl_NRPostProc TEOEx_ListCallback;
static Tcl_NRPostProc TEOV_Error;
@@ -8372,7 +8371,7 @@ TclNRTailcallEval(
* a now-gone namespace: cleanup and return.
*/
- TailcallCleanup(data, interp, result);
+ Tcl_DecrRefCount(listPtr);
return result;
}
@@ -8381,18 +8380,26 @@ TclNRTailcallEval(
*/
TclMarkTailcall(interp);
- TclNRAddCallback(interp, TailcallCleanup, listPtr, NULL, NULL,NULL);
+ TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
iPtr->lookupNsPtr = (Namespace *) nsPtr;
return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
}
-static int
-TailcallCleanup(
+int
+TclNRReleaseValues(
ClientData data[],
Tcl_Interp *interp,
int result)
{
- Tcl_DecrRefCount((Tcl_Obj *) data[0]);
+ int i = 0;
+ while (i < 4) {
+ if (data[i]) {
+ Tcl_DecrRefCount((Tcl_Obj *) data[i]);
+ } else {
+ break;
+ }
+ i++;
+ }
return result;
}
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 4cb81ea..7420538 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -105,8 +105,7 @@ typedef struct SortInfo {
*/
static int DictionaryCompare(const char *left, const char *right);
-static int IfConditionCallback(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc IfConditionCallback;
static int InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 13f9e7d..885a0bc 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -22,14 +22,10 @@
static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode,
Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
-static int SwitchPostProc(ClientData data[], Tcl_Interp *interp,
- int result);
-static int TryPostBody(ClientData data[], Tcl_Interp *interp,
- int result);
-static int TryPostFinal(ClientData data[], Tcl_Interp *interp,
- int result);
-static int TryPostHandler(ClientData data[], Tcl_Interp *interp,
- int result);
+static Tcl_NRPostProc SwitchPostProc;
+static Tcl_NRPostProc TryPostBody;
+static Tcl_NRPostProc TryPostFinal;
+static Tcl_NRPostProc TryPostHandler;
static int UniCharIsAscii(int character);
static int UniCharIsHexDigit(int character);
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index c8474e6..428173d 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -70,18 +70,12 @@ static inline void DeleteChainTable(struct Dict *dict);
static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
Tcl_Obj *keyPtr, int *newPtr);
static inline int DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
-static int FinalizeDictUpdate(ClientData data[],
- Tcl_Interp *interp, int result);
-static int FinalizeDictWith(ClientData data[],
- Tcl_Interp *interp, int result);
-static int DictForNRCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const *objv);
-static int DictMapNRCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const *objv);
-static int DictForLoopCallback(ClientData data[],
- Tcl_Interp *interp, int result);
-static int DictMapLoopCallback(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc FinalizeDictUpdate;
+static Tcl_NRPostProc FinalizeDictWith;
+static Tcl_ObjCmdProc DictForNRCmd;
+static Tcl_ObjCmdProc DictMapNRCmd;
+static Tcl_NRPostProc DictForLoopCallback;
+static Tcl_NRPostProc DictMapLoopCallback;
/*
* Table of dict subcommand names and implementations.
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index a9698be..ee81aee 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -41,7 +41,6 @@ static int CompileBasicNArgCommand(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
CompileEnv *envPtr);
-static Tcl_NRPostProc FreeObj;
static Tcl_NRPostProc FreeER;
/*
@@ -1848,25 +1847,24 @@ NsEnsembleImplementationCmdNR(
{
Tcl_Obj *copyPtr; /* The actual list of words to dispatch to.
* Will be freed by the dispatch engine. */
- int prefixObjc;
+ Tcl_Obj **copyObjv;
+ int copyObjc, prefixObjc;
Tcl_ListObjLength(NULL, prefixObj, &prefixObjc);
if (objc == 2) {
- copyPtr = prefixObj;
- Tcl_IncrRefCount(copyPtr);
- TclNRAddCallback(interp, FreeObj, copyPtr, NULL, NULL, NULL);
+ copyPtr = TclListObjCopy(NULL, prefixObj);
} else {
- int copyObjc = objc - 2 + prefixObjc;
-
- copyPtr = Tcl_NewListObj(copyObjc, NULL);
+ copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
- ensemblePtr->numParameters, objv+1);
+ ensemblePtr->numParameters, objv + 1);
Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
objc - 2 - ensemblePtr->numParameters,
objv + 2 + ensemblePtr->numParameters);
}
+ Tcl_IncrRefCount(copyPtr);
+ TclNRAddCallback(interp, TclNRReleaseValues, copyPtr, NULL, NULL, NULL);
TclDecrRefCount(prefixObj);
/*
@@ -1886,7 +1884,8 @@ NsEnsembleImplementationCmdNR(
*/
TclSkipTailcall(interp);
- return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);
+ Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
+ return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
}
unknownOrAmbiguousSubcommand:
@@ -2064,18 +2063,6 @@ FreeER(
return result;
}
-static int
-FreeObj(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- Tcl_Obj *objPtr = (Tcl_Obj *)data[0];
-
- Tcl_DecrRefCount(objPtr);
- return result;
-}
-
void
TclSpellFix(
Tcl_Interp *interp,
@@ -2151,7 +2138,7 @@ TclSpellFix(
store[idx] = fix;
Tcl_IncrRefCount(fix);
- TclNRAddCallback(interp, FreeObj, fix, NULL, NULL, NULL);
+ TclNRAddCallback(interp, TclNRReleaseValues, fix, NULL, NULL, NULL);
}
/*
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 1330c02..3aa0ce5 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -71,8 +71,7 @@ typedef struct ThreadSpecificData {
* Prototypes for functions defined later in this file.
*/
-static int EvalFileCallback(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc EvalFileCallback;
static FilesystemRecord*FsGetFirstFilesystem(void);
static void FsThrExitProc(ClientData cd);
static Tcl_Obj * FsListMounts(Tcl_Obj *pathPtr, const char *pattern);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 100197d..5ccd637 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2754,6 +2754,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
+MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues;
MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp);
@@ -2864,8 +2865,7 @@ MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
-MODULE_SCOPE int TclClearRootEnsemble(ClientData data[],
- Tcl_Interp *interp, int result);
+MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
int *loc);
MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 9dae778..ef0c987 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -68,12 +68,9 @@ static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
static void DeletedDefineNamespace(ClientData clientData);
static void DeletedObjdefNamespace(ClientData clientData);
static void DeletedHelpersNamespace(ClientData clientData);
-static int FinalizeAlloc(ClientData data[],
- Tcl_Interp *interp, int result);
-static int FinalizeNext(ClientData data[],
- Tcl_Interp *interp, int result);
-static int FinalizeObjectCall(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc FinalizeAlloc;
+static Tcl_NRPostProc FinalizeNext;
+static Tcl_NRPostProc FinalizeObjectCall;
static int InitFoundation(Tcl_Interp *interp);
static void KillFoundation(ClientData clientData,
Tcl_Interp *interp);
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index facf90d..1797760 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -70,15 +70,12 @@ static void AddSimpleClassChainToCallContext(Class *classPtr,
Class *const filterDecl);
static int CmpStr(const void *ptr1, const void *ptr2);
static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
-static int FinalizeMethodRefs(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc FinalizeMethodRefs;
static void FreeMethodNameRep(Tcl_Obj *objPtr);
static inline int IsStillValid(CallChain *callPtr, Object *oPtr,
int flags, int reuseMask);
-static int ResetFilterFlags(ClientData data[],
- Tcl_Interp *interp, int result);
-static int SetFilterFlags(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc ResetFilterFlags;
+static Tcl_NRPostProc SetFilterFlags;
static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);
/*
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index a311ddb..99a8bfc 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -70,10 +70,8 @@ static Tcl_Obj ** InitEnsembleRewrite(Tcl_Interp *interp, int objc,
static int InvokeProcedureMethod(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
-static int FinalizeForwardCall(ClientData data[], Tcl_Interp *interp,
- int result);
-static int FinalizePMCall(ClientData data[], Tcl_Interp *interp,
- int result);
+static Tcl_NRPostProc FinalizeForwardCall;
+static Tcl_NRPostProc FinalizePMCall;
static int PushMethodCallFrame(Tcl_Interp *interp,
CallContext *contextPtr, ProcedureMethod *pmPtr,
int objc, Tcl_Obj *const *objv,
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 33eaadd..d3da641 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -408,8 +408,7 @@ static int TestHashSystemHashCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int NREUnwind_callback(ClientData data[], Tcl_Interp *interp,
- int result);
+static Tcl_NRPostProc NREUnwind_callback;
static int TestNREUnwind(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 64cfeba..f2f7f8c 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -879,19 +879,18 @@ test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} {
test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body {
# On pc, must be a .exe, .com, etc.
set x [file exe $gorpfile]
- set gorpexe [makeFile foo gorp.exe]
- lappend x [file exe $gorpexe]
-} -cleanup {
- removeFile $gorpexe
-} -result {0 1}
-test cmdAH-18.5.1 {Tcl_FileObjCmd: executable} -constraints {win} -body {
- # On pc, must be a .exe, .com, etc.
- set x [file exe $gorpfile]
- set gorpexe [makeFile foo gorp.exe]
- lappend x [file exe [string toupper $gorpexe]]
+ set gorpexes {}
+ foreach ext {exe com cmd bat ps1} {
+ set gorpexe [makeFile foo gorp.$ext]
+ lappend gorpexes $gorpexe
+ lappend x [file exe $gorpexe] [file exe [string toupper $gorpexe]]
+ }
+ set x
} -cleanup {
- removeFile $gorpexe
-} -result {0 1}
+ foreach gorpexe $gorpexes {
+ removeFile $gorpexe
+ }
+} -result {0 1 1 1 1 1 1 1 1 1 1}
test cmdAH-18.6 {Tcl_FileObjCmd: executable} {} {
# Directories are always executable.
file exe $dirfile
diff --git a/tests/fileName.test b/tests/fileName.test
index 51f00d1..a19bd1e 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -1468,14 +1468,16 @@ if {[testConstraint testsetplatform]} {
}
test filename-17.2 {windows specific glob with executable} -body {
makeDirectory execglob
- makeFile contents execglob/abc.exe
- makeFile contents execglob/abc.notexecutable
- glob -nocomplain -dir [temporaryDirectory]/execglob -tails -types x *
+ foreach ext {exe com cmd bat ps1 notexecutable} {
+ makeFile contents execglob/abc.$ext
+ }
+ lsort [glob -nocomplain -dir [temporaryDirectory]/execglob -tails -types x *]
} -constraints {win} -cleanup {
- removeFile execglob/abc.exe
- removeFile execglob/abc.notexecutable
+ foreach ext {exe com cmd bat ps1 notexecutable} {
+ removeFile execglob/abc.$ext
+ }
removeDirectory execglob
-} -result {abc.exe}
+} -result {abc.bat abc.cmd abc.com abc.exe abc.ps1}
test filename-17.3 {Bug 2571597} win {
set p /a
file pathtype $p
diff --git a/tests/oo.test b/tests/oo.test
index 9491f78..62f123c 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -2017,6 +2017,12 @@ test oo-15.10 {variable binding must not bleed through oo::copy} -setup {
test oo-16.1 {OO: object introspection} -body {
info object
} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?arg ...?\""
+test oo-16.1.1 {OO: object introspection} -body {
+ catch {info object} m o
+ dict get $o -errorinfo
+} -result "wrong \# args: should be \"info object subcommand ?arg ...?\"
+ while executing
+\"info object\""
test oo-16.2 {OO: object introspection} -body {
info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
@@ -2156,6 +2162,12 @@ test oo-16.14 {OO: object introspection: TIP #436} -setup {
test oo-17.1 {OO: class introspection} -body {
info class
} -returnCodes 1 -result "wrong \# args: should be \"info class subcommand ?arg ...?\""
+test oo-17.1.1 {OO: class introspection} -body {
+ catch {info class} m o
+ dict get $o -errorinfo
+} -result "wrong \# args: should be \"info class subcommand ?arg ...?\"
+ while executing
+\"info class\""
test oo-17.2 {OO: class introspection} -body {
info class superclass NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 25c6ea4..4b0b884 100755
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1769,7 +1769,7 @@ NativeAccess(
* NativeIsExec --
*
* Determines if a path is executable. On windows this is simply defined
- * by whether the path ends in any of ".exe", ".com", or ".bat"
+ * by whether the path ends in a standard executable extension.
*
* Results:
* 1 = executable, 0 = not.
@@ -1793,6 +1793,8 @@ NativeIsExec(
if ((_tcsicmp(path+len-3, TEXT("exe")) == 0)
|| (_tcsicmp(path+len-3, TEXT("com")) == 0)
+ || (_tcsicmp(path+len-3, TEXT("cmd")) == 0)
+ || (_tcsicmp(path+len-3, TEXT("ps1")) == 0)
|| (_tcsicmp(path+len-3, TEXT("bat")) == 0)) {
return 1;
}
generated by cgit v0.12 at 2024-07-01 06:31:22 (GMT)