summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog30
-rw-r--r--doc/Ensemble.32
-rw-r--r--doc/dde.n4
-rw-r--r--doc/expr.n15
-rw-r--r--doc/mathop.n16
-rw-r--r--doc/namespace.n5
-rw-r--r--doc/safe.n2
-rw-r--r--generic/tclDecls.h24
-rw-r--r--generic/tclInt.decls4
-rw-r--r--generic/tclIntPlatDecls.h13
-rw-r--r--generic/tclStubInit.c22
-rw-r--r--tests/fCmd.test135
-rw-r--r--tests/safe.test46
-rw-r--r--tools/genStubs.tcl40
-rwxr-xr-xtools/tcltk-man2html.tcl5
-rw-r--r--win/Makefile.in22
-rw-r--r--win/tclWinDde.c68
17 files changed, 305 insertions, 148 deletions
diff --git a/ChangeLog b/ChangeLog
index b47f008..c70acbb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,33 @@
+2012-05-31 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/safe.n: [Bug 1997845]: Corrected formatting so that generated
+ * tools/tcltk-man2html.tcl (cross-reference): HTML can link properly.
+
+2012-05-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/expr.n, doc/mathop.n: [Bug 2931407]: Clarified semantics of
+ division and remainder operators.
+
+2012-05-25 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/namespace.n, doc/Ensemble.3: [Bug 3528418]: Document what is
+ going on with respect to qualification of command prefixes in ensemble
+ subcommand maps.
+
+2012-05-25 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinDde.c: [Bug 473946]: special characters not correctly sent,
+ now for XTYP_EXECUTE as well as XTYP_REQUEST.
+ * win/Makefile.in: Fix "make genstubs" when cross-compiling on UNIX
+
+2012-05-24 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tools/genStubs.tcl: Take cygwin handling of X11 into account.
+ * generic/tcl*Decls.h: re-generated
+ * generic/tclStubInit.c: Implement TclpIsAtty, Cygwin only.
+ * doc/dde.n: Doc fix: "dde execute iexplore" doesn't work
+ without -async, because iexplore doesn't return a value
+
2012-05-22 Jan Nijtmans <nijtmans@users.sf.net>
* tools/genStubs.tcl: Let cygwin share stub table with win32
diff --git a/doc/Ensemble.3 b/doc/Ensemble.3
index 5a5842d..bc743c2 100644
--- a/doc/Ensemble.3
+++ b/doc/Ensemble.3
@@ -148,6 +148,8 @@ code (TCL_OK, or TCL_ERROR if the token does not refer to an
ensemble) and the dictionary obtained from
\fBTcl_GetEnsembleMappingDict\fR should always be treated as immutable
even if it is unshared.
+All command names in prefixes set via \fBTcl_SetEnsembleMappingDict\fR
+must be fully qualified.
.TP
\fBsubcommand list\fR (read-write)
A list of all the subcommand names for the ensemble, or NULL if this
diff --git a/doc/dde.n b/doc/dde.n
index ce00aee..2e3c883 100644
--- a/doc/dde.n
+++ b/doc/dde.n
@@ -144,7 +144,7 @@ unpredictable results.
.PP
An external application which wishes to run a script in Tcl should have
that script store its result in a variable, run the \fBdde execute\fR
-command, and the run \fBdde request\fR to get the value of the
+command, and then run \fBdde request\fR to get the value of the
variable.
.PP
When using DDE, be careful to ensure that the event queue is flushed
@@ -159,7 +159,7 @@ This asks Internet Explorer (which must already be running) to go to a
particularly important website:
.CS
package require dde
-\fBdde execute\fR iexplore WWW_OpenURL http://www.tcl.tk/
+\fBdde execute\fR -async iexplore WWW_OpenURL http://www.tcl.tk/
.CE
.SH "SEE ALSO"
tk(n), winfo(n), send(n)
diff --git a/doc/expr.n b/doc/expr.n
index 177e127..dbc9026 100644
--- a/doc/expr.n
+++ b/doc/expr.n
@@ -131,7 +131,20 @@ Multiply, divide, remainder. None of these operators may be
applied to string operands, and remainder may be applied only
to integers.
The remainder will always have the same sign as the divisor and
-an absolute value smaller than the divisor.
+an absolute value smaller than the absolute value of the divisor.
+.RS
+.PP
+When applied to integers, the division and remainder operators can be
+considered to partition the number line into a sequence of equal-sized
+adjacent non-overlapping pieces where each piece is the size of the divisor;
+the division result identifies which piece the divisor lay within, and the
+remainder result identifies where within that piece the divisor lay. A
+consequence of this is that the result of
+.QW "-57 \fB/\fR 10"
+is always -6, and the result of
+.QW "-57 \fB%\fR 10"
+is always 3.
+.RE
.TP 20
\fB+\0\0\-\fR
Add and subtract. Valid for any numeric operands.
diff --git a/doc/mathop.n b/doc/mathop.n
index 5a6ba4e..5757f87 100644
--- a/doc/mathop.n
+++ b/doc/mathop.n
@@ -126,13 +126,19 @@ will be an integer.
.TP
\fB%\fR \fInumber number\fR
.
-Returns the integral modulus of the first argument with respect to the second.
-Each \fInumber\fR must have an integral value. Note that Tcl defines this
-operation exactly even for negative numbers, so that the following equality
-holds true:
+Returns the integral modulus (i.e., remainder) of the first argument
+with respect to the second.
+Each \fInumber\fR must have an integral value.
+Also, the sign of the result will be the same as the sign of the second
+\fInumber\fR, which must not be zero.
.RS
+.PP
+Note that Tcl defines this operation exactly even for negative numbers, so
+that the following command returns a true value (omitting the namespace for
+clarity):
+.PP
.CS
-(\fIx \fB/ \fIy\fR) \fB* \fIy \fB== \fIx \fB-\fR (\fIx \fB% \fIy\fR)
+\fB==\fR [\fB*\fR [\fB/\fI x y\fR] \fIy\fR] [\fB-\fI x\fR [\fB%\fI x y\fR]]
.CE
.RE
.TP
diff --git a/doc/namespace.n b/doc/namespace.n
index ddf7b51..8b26786 100644
--- a/doc/namespace.n
+++ b/doc/namespace.n
@@ -714,7 +714,10 @@ When non-empty, this option supplies a dictionary that provides a
mapping from subcommand names to a list of prefix words to substitute
in place of the ensemble command and subcommand words (in a manner
similar to an alias created with \fBinterp alias\fR; the words are not
-reparsed after substitution). When this option is empty, the mapping
+reparsed after substitution); if the first word of any target is not
+fully qualified when set, it is assumed to be relative to the
+\fIcurrent\fR namespace and changed to be exactly that (that is, it is
+always fully qualified when read). When this option is empty, the mapping
will be from the local name of the subcommand to its fully-qualified
name. Note that when this option is non-empty and the
\fB\-subcommands\fR option is empty, the ensemble subcommand names
diff --git a/doc/safe.n b/doc/safe.n
index 78fa6ad..590f2c6 100644
--- a/doc/safe.n
+++ b/doc/safe.n
@@ -67,7 +67,7 @@ The following commands are provided in the master interpreter:
\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
Creates a safe interpreter, installs the aliases described in the section
\fBALIASES\fR and initializes the auto-loading and package mechanism as
-specified by the supplied \fBoptions\fR.
+specified by the supplied \fIoptions\fR.
See the \fBOPTIONS\fR section below for a description of the
optional arguments.
If the \fIslave\fR argument is omitted, a name will be generated.
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 424024d..4225c96 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -86,7 +86,7 @@ EXTERN void Tcl_DbCkfree(char *ptr, CONST char *file, int line);
EXTERN char * Tcl_DbCkrealloc(char *ptr, unsigned int size,
CONST char *file, int line);
#endif
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef Tcl_CreateFileHandler_TCL_DECLARED
#define Tcl_CreateFileHandler_TCL_DECLARED
/* 9 */
@@ -102,7 +102,7 @@ EXTERN void Tcl_CreateFileHandler(int fd, int mask,
Tcl_FileProc *proc, ClientData clientData);
#endif
#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef Tcl_DeleteFileHandler_TCL_DECLARED
#define Tcl_DeleteFileHandler_TCL_DECLARED
/* 10 */
@@ -1013,7 +1013,7 @@ EXTERN CONST char * Tcl_GetNameOfExecutable(void);
/* 166 */
EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp);
#endif
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef Tcl_GetOpenFile_TCL_DECLARED
#define Tcl_GetOpenFile_TCL_DECLARED
/* 167 */
@@ -3428,19 +3428,19 @@ typedef struct TclStubs {
char * (*tcl_DbCkalloc) (unsigned int size, CONST char *file, int line); /* 6 */
void (*tcl_DbCkfree) (char *ptr, CONST char *file, int line); /* 7 */
char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, CONST char *file, int line); /* 8 */
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
#endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(__WIN32__) /* WIN */
VOID *reserved9;
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(__WIN32__) /* WIN */
VOID *reserved10;
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -3602,10 +3602,10 @@ typedef struct TclStubs {
Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
CONST char * (*tcl_GetNameOfExecutable) (void); /* 165 */
Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
int (*tcl_GetOpenFile) (Tcl_Interp *interp, CONST char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
#endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(__WIN32__) /* WIN */
VOID *reserved167;
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -4075,7 +4075,7 @@ extern TclStubs *tclStubsPtr;
#define Tcl_DbCkrealloc \
(tclStubsPtr->tcl_DbCkrealloc) /* 8 */
#endif
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef Tcl_CreateFileHandler
#define Tcl_CreateFileHandler \
(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
@@ -4087,7 +4087,7 @@ extern TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
#endif
#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef Tcl_DeleteFileHandler
#define Tcl_DeleteFileHandler \
(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
@@ -4723,7 +4723,7 @@ extern TclStubs *tclStubsPtr;
#define Tcl_GetObjResult \
(tclStubsPtr->tcl_GetObjResult) /* 166 */
#endif
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef Tcl_GetOpenFile
#define Tcl_GetOpenFile \
(tclStubsPtr->tcl_GetOpenFile) /* 167 */
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 694d271..0459e8c 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -1023,6 +1023,10 @@ declare 15 win {
const char **argv, TclFile inputFile, TclFile outputFile,
TclFile errorFile, Tcl_Pid *pidPtr)
}
+# new for 8.4.20+/8.5.12+ Cygwin only
+declare 16 win {
+ int TclpIsAtty(int fd)
+}
# Signature changed in 8.1:
# declare 16 win {
# TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr)
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index b5783f8..5c610fa 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -231,7 +231,11 @@ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
TclFile outputFile, TclFile errorFile,
Tcl_Pid *pidPtr);
#endif
-/* Slot 16 is reserved */
+#ifndef TclpIsAtty_TCL_DECLARED
+#define TclpIsAtty_TCL_DECLARED
+/* 16 */
+EXTERN int TclpIsAtty(int fd);
+#endif
/* Slot 17 is reserved */
#ifndef TclpMakeFile_TCL_DECLARED
#define TclpMakeFile_TCL_DECLARED
@@ -474,7 +478,7 @@ typedef struct TclIntPlatStubs {
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
- VOID *reserved16;
+ int (*tclpIsAtty) (int fd); /* 16 */
VOID *reserved17;
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 19 */
@@ -679,7 +683,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
#define TclpCreateProcess \
(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#endif
-/* Slot 16 is reserved */
+#ifndef TclpIsAtty
+#define TclpIsAtty \
+ (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
+#endif
/* Slot 17 is reserved */
#ifndef TclpMakeFile
#define TclpMakeFile \
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 418e42f..ca21efb 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -78,7 +78,9 @@ MODULE_SCOPE TclTomMathStubs tclTomMathStubs;
#ifdef __WIN32__
# define TclUnixWaitForFile 0
# define TclpReaddir 0
+# define TclpIsAtty 0
#elif defined(__CYGWIN__)
+# define TclpIsAtty TclPlatIsAtty
# define TclWinSetInterfaces (void (*) (int)) doNothing
# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
# define TclWinFlushDirtyChannels doNothing
@@ -87,6 +89,12 @@ MODULE_SCOPE TclTomMathStubs tclTomMathStubs;
static Tcl_Encoding winTCharEncoding;
+static int
+TclpIsAtty(int fd)
+{
+ return isatty(fd);
+}
+
int
TclWinGetPlatformId()
{
@@ -500,7 +508,7 @@ TclIntPlatStubs tclIntPlatStubs = {
TclpCreateCommandChannel, /* 13 */
TclpCreatePipe, /* 14 */
TclpCreateProcess, /* 15 */
- NULL, /* 16 */
+ TclpIsAtty, /* 16 */
NULL, /* 17 */
TclpMakeFile, /* 18 */
TclpOpenFile, /* 19 */
@@ -649,19 +657,19 @@ TclStubs tclStubs = {
Tcl_DbCkalloc, /* 6 */
Tcl_DbCkfree, /* 7 */
Tcl_DbCkrealloc, /* 8 */
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_CreateFileHandler, /* 9 */
#endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(__WIN32__) /* WIN */
NULL, /* 9 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
Tcl_CreateFileHandler, /* 9 */
#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_DeleteFileHandler, /* 10 */
#endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(__WIN32__) /* WIN */
NULL, /* 10 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -823,10 +831,10 @@ TclStubs tclStubs = {
Tcl_GetMaster, /* 164 */
Tcl_GetNameOfExecutable, /* 165 */
Tcl_GetObjResult, /* 166 */
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
Tcl_GetOpenFile, /* 167 */
#endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(__WIN32__) /* WIN */
NULL, /* 167 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 6c73dee..00147bb 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -15,6 +15,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
+cd [temporaryDirectory]
+
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint winVista 0
@@ -34,6 +36,15 @@ if {[testConstraint unix]} {
set group [lindex $groupList 0]
testConstraint foundGroup 1
}
+
+ proc dev dir {
+ file stat $dir stat
+ return $stat(dev)
+ }
+
+ if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} {
+ testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]
+ }
}
# Also used in winFCmd...
@@ -138,13 +149,6 @@ proc contents {file} {
return $r
}
-cd [temporaryDirectory]
-
-proc dev dir {
- file stat $dir stat
- return $stat(dev)
-}
-testConstraint xdev [expr {[testConstraint unix] && ([dev .] != [dev /tmp])}]
set root [lindex [file split [pwd]] 0]
@@ -550,12 +554,12 @@ test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
file rename -force td2 td1
} -returnCodes error -match glob -result \
[subst {error renaming "td2" to "[file join td1 td2]": file *}]
-test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unix notRoot} {
- file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest
+test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {xdev notRoot} {
+ cleanup $tmpspace
createfile tf1
- file rename tf1 /tmp/tcltmptest
- glob -nocomplain tf* /tmp/tcltmptest/tf1
-} {/tmp/tcltmptest/tf1}
+ file rename tf1 $tmpspace
+ glob -nocomplain tf* [file join $tmpspace tf1]
+} [file join $tmpspace tf1]
test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
catch {file delete -force c:/tcl8975@ d:/tcl8975@}
} -body {
@@ -569,28 +573,29 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
catch {file delete -force d:/tcl8975@}
} -result {d:/tcl8975@}
test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \
- {unix notRoot} {
- file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest
+ {xdev notRoot} {
+ cleanup $tmpspace
file mkdir td1
- file rename td1 /tmp/tcltmptest
- glob -nocomplain td* /tmp/tcltmptest/td*
-} {/tmp/tcltmptest/td1}
+ file rename td1 $tmpspace
+ glob -nocomplain td* [file join $tmpspace td*]
+} [file join $tmpspace td1]
test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \
- {unix notRoot} {
- file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest
+ {xdev notRoot} {
+ cleanup $tmpspace
createfile tf1
- file rename tf1 /tmp/tcltmptest
- glob -nocomplain tf* /tmp/tcltmptest/tf*
-} {/tmp/tcltmptest/tf1}
+ file rename tf1 $tmpspace
+ glob -nocomplain tf* [file join $tmpspace tf*]
+} [file join $tmpspace tf1]
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
- file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest
-} -constraints {unix notRoot xdev} -body {
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -body {
file mkdir td1/td2/td3
file attributes td1 -permissions 0000
- file rename td1 /tmp/tcltmptest
+ file rename td1 $tmpspace
} -returnCodes error -cleanup {
file attributes td1 -permissions 0755
-} -match regexp -result {^error renaming "td1"( to "/tmp/tcltmptest/td1")?: permission denied$}
+ cleanup
+} -match regexp -result {^error renaming "td1"( to "/tmp/tcl\d+/td1")?: permission denied$}
test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup {
cleanup
} -constraints {unix notRoot} -body {
@@ -626,55 +631,54 @@ test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup {
file delete -force ~/td1
} -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied"
test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
- file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest
-} -constraints {unix notRoot xdev} -returnCodes error -body {
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -returnCodes error -body {
file mkdir td1/td2/td3
- file mkdir /tmp/tcltmptest/td1
- createfile /tmp/tcltmptest/td1/tf1
- file rename -force td1 /tmp/tcltmptest
-} -result {error renaming "td1" to "/tmp/tcltmptest/td1": file already exists}
+ file mkdir [file join $tmpspace td1]
+ createfile [file join $tmpspace td1 tf1]
+ file rename -force td1 $tmpspace
+} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": file already exists}
test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
- file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest
-} -constraints {unix notRoot xdev} -body {
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -body {
file mkdir td1/td2/td3
file attributes td1/td2/td3 -permissions 0000
- file rename td1 /tmp/tcltmptest
+ file rename td1 $tmpspace
} -returnCodes error -cleanup {
file attributes td1/td2/td3 -permissions 0755
-} -result {error renaming "td1" to "/tmp/tcltmptest/td1": "td1/td2/td3": permission denied}
+ cleanup $tmpspace
+} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": "td1/td2/td3": permission denied}
test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup {
- file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest
-} -constraints {unix notRoot xdev} -body {
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -body {
file mkdir td1/td2/td3
- file rename td1 /tmp/tcltmptest
- glob td* /tmp/tcltmptest/td1/t*
-} -result {/tmp/tcltmptest/td1/td2}
+ file rename td1 $tmpspace
+ glob td* [file join $tmpspace td1 t*]
+} -result [file join $tmpspace td1 td2]
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
- cleanup
- file mkdir /tmp/tcltmptest; cleanup /tmp/tcltmptest
-} -constraints {unix notRoot} -body {
+ cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
file mkdir foo/bar
file attr foo -perm 040555
- file rename foo/bar /tmp/tcltmptest
+ file rename foo/bar $tmpspace
} -returnCodes error -cleanup {
- catch {file delete /tmp/tcltmptest/bar}
+ catch {file delete [file join $tmpspace bar]}
catch {file attr foo -perm 040777}
catch {file delete -force foo}
} -match glob -result {*: permission denied}
test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} -setup {
- catch {cleanup /tmp/tcltmptest}
-} -constraints {unix notRoot xdev} -body {
- file mkdir /tmp/tcltmptest/td1
- createfile /tmp/tcltmptest/td1/tf1
- file rename /tmp/tcltmptest/td1/tf1 tf1
- list [file exists /tmp/tcltmptest/td1/tf1] [file exists tf1]
+ cleanup $tmpspace
+} -constraints {notRoot xdev} -body {
+ file mkdir [file join $tmpspace td1]
+ createfile [file join $tmpspace td1 tf1]
+ file rename [file join $tmpspace td1 tf1] tf1
+ list [file exists [file join $tmpspace td1 tf1]] [file exists tf1]
} -result {0 1}
test fCmd-6.32 {CopyRenameOneFile: copy} -constraints {notRoot} -setup {
cleanup
} -returnCodes error -body {
file copy tf1 tf2
} -result {error copying "tf1": no such file or directory}
-catch {file delete -force /tmp/tcltmptest}
test fCmd-7.1 {FileForceOption: none} -constraints {notRoot} -setup {
cleanup
@@ -1306,25 +1310,23 @@ test fCmd-12.8 {renamefile: generic error} -setup {
file delete -force tfa
} -result {1}
test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
- file mkdir /tmp/tcltmptest
- catch {file delete -force -- tfa /tmp/tcltmptest/tfa}
-} -constraints {unix notRoot} -body {
+ cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
set s [createfile tfa]
- file rename tfa /tmp/tcltmptest
- list [checkcontent /tmp/tcltmptest/tfa $s] [file exists tfa]
+ file rename tfa $tmpspace
+ list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa]
} -cleanup {
- file delete -force /tmp/tcltmptest
+ cleanup $tmpspace
} -result {1 0}
test fCmd-12.10 {renamefile: moving a directory across volumes} -setup {
- file mkdir /tmp/tcltmptest
- catch {file delete -force -- tfad /tmp/tcltmptest/tfad}
-} -constraints {unix notRoot} -body {
+ cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
file mkdir tfad
set s [createfile tfad/a]
- file rename tfad /tmp/tcltmptest
- list [checkcontent /tmp/tcltmptest/tfad/a $s] [file exists tfad]
+ file rename tfad $tmpspace
+ list [checkcontent [file join $tmpspace tfad a] $s] [file exists tfad]
} -cleanup {
- file delete -force /tmp/tcltmptest
+ cleanup $tmpspace
} -result {1 0}
#
@@ -2554,5 +2556,8 @@ test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win 2000orNewer kno
# cleanup
cleanup
+if {[testConstraint unix]} {
+ removeDirectory tcl[pid] /tmp
+}
::tcltest::cleanupTests
return
diff --git a/tests/safe.test b/tests/safe.test
index 7b83cc6..4bd8509 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -690,6 +690,52 @@ test safe-14.1 {Check that module path is the same as in the master interpreter
} -cleanup {
safe::interpDelete $i
} -result [::tcl::tm::path list]
+
+### ~ should have no special meaning in paths in safe interpreters
+test safe-15.1 {Bug 2913625: defang ~ in paths} -setup {
+ set savedHOME $env(HOME)
+ set env(HOME) /foo/bar
+ set i [safe::interpCreate]
+} -constraints knownBug -body {
+ $i eval {
+ set d [format %c 126]
+ list [file dirname $d] [file tail $d] \
+ [file join [file dirname $d] [file tail $d]]
+ }
+} -cleanup {
+ safe::interpDelete $i
+ set env(HOME) $savedHOME
+} -result {~}
+test safe-15.2 {Bug 2913625: defang ~user in paths} -setup {
+ set i [safe::interpCreate]
+ set user $tcl_platform(user)
+} -constraints knownBug -body {
+ string map [list $user USER] [$i eval \
+ "file join \[file dirname ~$user\] \[file tail ~$user\]"]
+} -cleanup {
+ safe::interpDelete $i
+} -result {~USER}
+test safe-15.3 {Bug 2913625: defang ~ in globs} -setup {
+ set savedHOME $env(HOME)
+ set env(HOME) /
+ set i [safe::interpCreate]
+} -constraints knownBug -body {
+ $i expose glob realglob
+ $i eval {realglob -nocomplain [join {~ / *} ""]}
+} -cleanup {
+ safe::interpDelete $i
+ set env(HOME) $savedHOME
+} -result {~}
+test safe-15.4 {Bug 2913625: defang ~user in globs} -setup {
+ set i [safe::interpCreate]
+ set user $tcl_platform(user)
+} -constraints knownBug -body {
+ $i expose glob realglob
+ string map [list $user USER] [$i eval [list\
+ realglob -directory ~$user *]]
+} -cleanup {
+ safe::interpDelete $i
+} -result {~USER}
set ::auto_path $saveAutoPath
# cleanup
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index b43423d..4eaa03d 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -281,18 +281,26 @@ proc genStubs::rewriteFile {file text} {
# Results:
# Returns the original text inside an appropriate #ifdef.
-proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} {
+proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} {
set text ""
switch $plat {
win {
- append text "#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */\n${iftxt}"
+ append text "#if defined(__WIN32__)"
+ if {$withCygwin} {
+ append text " || defined(__CYGWIN__)"
+ }
+ append text " /* WIN */\n${iftxt}"
if {$eltxt ne ""} {
append text "#else /* WIN */\n${eltxt}"
}
append text "#endif /* WIN */\n"
}
unix {
- append text "#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL)\
+ append text "#if !defined(__WIN32__)"
+ if {$withCygwin} {
+ append text " && !defined(__CYGWIN__)"
+ }
+ append text " && !defined(MAC_OSX_TCL)\
/* UNIX */\n${iftxt}"
if {$eltxt ne ""} {
append text "#else /* UNIX */\n${eltxt}"
@@ -314,7 +322,11 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} {
append text "#endif /* AQUA */\n"
}
x11 {
- append text "#if !(defined(__WIN32__) || defined(__CYGWIN__) || defined(MAC_OSX_TK))\
+ append text "#if !(defined(__WIN32__)"
+ if {$withCygwin} {
+ append text " || defined(__CYGWIN__)"
+ }
+ append text " || defined(MAC_OSX_TK))\
/* X11 */\n${iftxt}"
if {$eltxt ne ""} {
append text "#else /* X11 */\n${eltxt}"
@@ -467,12 +479,6 @@ proc genStubs::makeDecl {name decl index} {
append text ";\n"
return $text
}
- if {$args == ""} {
- append line $fname
- append text $line
- append text ";\n"
- return $text
- }
append line $fname
regsub -all void $args VOID args
@@ -575,13 +581,13 @@ proc genStubs::makeSlot {name decl index} {
append lfname [string range $fname 1 end]
set text " "
- if {$rtype != "void"} {
- regsub -all void $rtype VOID rtype
- }
if {$args == ""} {
append text $rtype " *" $lfname "; /* $index */\n"
return $text
}
+ if {$rtype ne "void"} {
+ regsub -all void $rtype VOID rtype
+ }
if {[string range $rtype end-8 end] == "__stdcall"} {
append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") "
} else {
@@ -811,7 +817,7 @@ proc genStubs::forAllStubs {name slotProc onAll textVar
eval {append temp} $skipString
}
}
- append text [addPlatformGuard $plat $temp]
+ append text [addPlatformGuard $plat $temp {} true]
}
## win ##
if {$block(win)} {
@@ -825,7 +831,7 @@ proc genStubs::forAllStubs {name slotProc onAll textVar
eval {append temp} $skipString
}
}
- append text [addPlatformGuard $plat $temp]
+ append text [addPlatformGuard $plat $temp {} true]
}
## macosx ##
if {$block(macosx) && !$block(aqua) && !$block(x11)} {
@@ -897,7 +903,7 @@ proc genStubs::forAllStubs {name slotProc onAll textVar
} else {
eval {set etxt} $skipString
append temp [addPlatformGuard $plat [$slotProc \
- $name $stubs($name,$plat,$i) $i] $etxt]
+ $name $stubs($name,$plat,$i) $i] $etxt true]
}
set emit 1
break
@@ -907,7 +913,7 @@ proc genStubs::forAllStubs {name slotProc onAll textVar
eval {append temp} $skipString
}
}
- append text [addPlatformGuard x11 $temp]
+ append text [addPlatformGuard x11 $temp {} true]
}
}
}
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl
index c6932d0..59a2a63 100755
--- a/tools/tcltk-man2html.tcl
+++ b/tools/tcltk-man2html.tcl
@@ -947,6 +947,11 @@ proc cross-reference {ref} {
return $ref
}
}
+ safe.n {
+ if {$lref in {options}} {
+ return $ref
+ }
+ }
}
##
## return the cross reference
diff --git a/win/Makefile.in b/win/Makefile.in
index 1b7d21f..17bb1aa 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -745,8 +745,22 @@ $(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
@echo "This warning can be safely ignored, do not report as a bug!"
genstubs:
- $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \
+ $(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \
"$(GENERIC_DIR_NATIVE)" \
- "$(GENERIC_DIR_NATIVE)\tcl.decls" \
- "$(GENERIC_DIR_NATIVE)\tclInt.decls" \
- "$(GENERIC_DIR_NATIVE)\tclTomMath.decls"
+ "$(GENERIC_DIR_NATIVE)/tcl.decls" \
+ "$(GENERIC_DIR_NATIVE)/tclInt.decls" \
+ "$(GENERIC_DIR_NATIVE)/tclTomMath.decls"
+
+#
+# The list of all the targets that do not correspond to real files. This stops
+# 'make' from getting confused when someone makes an error in a rule.
+#
+
+.PHONY: all tcltest binaries libraries doc gendate gentommath_h install
+.PHONY: install-binaries install-libraries install-tzdata install-msgs
+.PHONY: install-doc install-private-headers test test-tcl runtest shell
+.PHONY: gdb depend cleanhelp clean distclean packages install-packages
+.PHONY: test-packages clean-packages distclean-packages genstubs html
+.PHONY: html-tcl html-tk
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 7e20da7..5543732 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -83,6 +83,10 @@ static int ddeIsServer = 0;
#define TCL_DDE_SERVICE_NAME "TclEval"
#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT"
+#define DDE_FLAG_ASYNC 1
+#define DDE_FLAG_BINARY 2
+#define DDE_FLAG_FORCE 4
+
TCL_DECLARE_MUTEX(ddeMutex)
/*
@@ -265,7 +269,7 @@ DdeSetServerName(
const char *name, /* The name that will be used to refer to the
* interpreter in later "send" commands. Must
* be globally unique. */
- int exactName, /* Should we make a unique name? 0 = unique */
+ int flags, /* DDE_FLAG_FORCE or 0 */
Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle
* incoming Dde eval's */
{
@@ -321,7 +325,7 @@ DdeSetServerName(
Tcl_DStringInit(&dString);
actualName = name;
- if (!exactName) {
+ if (!(flags & DDE_FLAG_FORCE)) {
r = DdeGetServicesList(interp, TCL_DDE_SERVICE_NAME, NULL);
if (r == TCL_OK) {
srvListPtr = Tcl_GetObjResult(interp);
@@ -761,6 +765,7 @@ DdeServerProc(
*/
Tcl_Obj *returnPackagePtr;
+ Tcl_UniChar *uniStr;
for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
@@ -774,11 +779,21 @@ DdeServerProc(
}
utilString = (char *) DdeAccessData(hData, &dlen);
- len = dlen;
- if (len && !utilString[len-1]) {
- len--;
+ uniStr = (Tcl_UniChar *) utilString;
+ if (!dlen) {
+ /* Empty binary array. */
+ ddeObjectPtr = Tcl_NewObj();
+ } else if ((dlen & 1) || uniStr[(dlen>>1)-1]) {
+ /* Cannot be unicode, so assume utf-8 */
+ if (!utilString[dlen-1]) {
+ dlen--;
+ }
+ ddeObjectPtr = Tcl_NewStringObj(utilString, dlen);
+ } else {
+ /* unicode */
+ dlen >>= 1;
+ ddeObjectPtr = Tcl_NewUnicodeObj(uniStr, dlen - 1);
}
- ddeObjectPtr = Tcl_NewStringObj(utilString, len);
Tcl_IncrRefCount(ddeObjectPtr);
DdeUnaccessData(hData);
if (convPtr->returnPackagePtr != NULL) {
@@ -966,7 +981,6 @@ DdeClientWindowProc(
WPARAM wParam,
LPARAM lParam) /* (Potentially) our local handle */
{
-
switch (uMsg) {
case WM_CREATE: {
LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
@@ -982,7 +996,6 @@ DdeClientWindowProc(
}
case WM_DDE_ACK:
return DdeServicesOnAck(hwnd, wParam, lParam);
- break;
default:
return DefWindowProc(hwnd, uMsg, wParam, lParam);
}
@@ -1174,9 +1187,8 @@ DdeObjCmd(
"-binary", NULL
};
- int index, i, length;
- int async = 0, binary = 0, exact = 0;
- int result = TCL_OK, firstArg = 0;
+ int index, i, length, argIndex;
+ int flags = 0, result = TCL_OK, firstArg = 0;
HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
HCONV hConv = NULL;
@@ -1201,7 +1213,6 @@ DdeObjCmd(
switch ((enum DdeSubcommands) index) {
case DDE_SERVERNAME:
for (i = 2; i < objc; i++) {
- int argIndex;
if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions,
"option", 0, &argIndex) != TCL_OK) {
/*
@@ -1216,7 +1227,7 @@ DdeObjCmd(
break;
}
if (argIndex == DDE_SERVERNAME_EXACT) {
- exact = 1;
+ flags |= DDE_FLAG_FORCE;
} else if (argIndex == DDE_SERVERNAME_HANDLER) {
if ((objc - i) == 1) { /* return current handler */
RegisteredInterp *riPtr = DdeGetRegistrationPtr(interp);
@@ -1249,10 +1260,9 @@ DdeObjCmd(
firstArg = 2;
break;
} else if (objc == 6) {
- int dummy;
if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0,
- &dummy) == TCL_OK) {
- async = 1;
+ &argIndex) == TCL_OK) {
+ flags |= DDE_FLAG_ASYNC;
firstArg = 3;
break;
}
@@ -1277,7 +1287,7 @@ DdeObjCmd(
int dummy;
if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0,
&dummy) == TCL_OK) {
- binary = 1;
+ flags |= DDE_FLAG_BINARY;
firstArg = 3;
break;
}
@@ -1303,15 +1313,13 @@ DdeObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args");
return TCL_ERROR;
} else {
- int dummy;
-
firstArg = 2;
if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option",
- 0, &dummy) == TCL_OK) {
+ 0, &argIndex) == TCL_OK) {
if (objc < 5) {
goto wrongDdeEvalArgs;
}
- async = 1;
+ flags |= DDE_FLAG_ASYNC;
firstArg++;
}
break;
@@ -1345,7 +1353,7 @@ DdeObjCmd(
switch ((enum DdeSubcommands) index) {
case DDE_SERVERNAME:
- serviceName = DdeSetServerName(interp, serviceName, exact,
+ serviceName = DdeSetServerName(interp, serviceName, flags,
handlerPtr);
if (serviceName != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1));
@@ -1378,7 +1386,7 @@ DdeObjCmd(
ddeData = DdeCreateDataHandle(ddeInstance, dataString,
(DWORD) dataLength+1, 0, 0, CF_TEXT, 0);
if (ddeData != NULL) {
- if (async) {
+ if (flags & DDE_FLAG_ASYNC) {
DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
@@ -1428,9 +1436,9 @@ DdeObjCmd(
DWORD tmp;
const char *dataString = (const char *) DdeAccessData(ddeData, &tmp);
- if (binary) {
- returnObjPtr = Tcl_NewByteArrayObj((BYTE *) dataString,
- (int) tmp);
+ if (flags & DDE_FLAG_BINARY) {
+ returnObjPtr =
+ Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp);
} else {
if (tmp && !dataString[tmp-1]) {
--tmp;
@@ -1504,8 +1512,8 @@ DdeObjCmd(
goto cleanup;
}
- objc -= (async + 3);
- objv += (async + 3);
+ objc -= firstArg + 1;
+ objv += firstArg + 1;
/*
* See if the target interpreter is local. If so, execute the command
@@ -1620,7 +1628,7 @@ DdeObjCmd(
ddeItemData = DdeCreateDataHandle(ddeInstance,
(BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0);
- if (async) {
+ if (flags & DDE_FLAG_ASYNC) {
ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
0xFFFFFFFF, hConv, 0,
CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
@@ -1644,7 +1652,7 @@ DdeObjCmd(
result = TCL_ERROR;
}
- if (async == 0) {
+ if (!(flags & DDE_FLAG_ASYNC)) {
Tcl_Obj *resultPtr;
/*
generated by cgit v0.12 at 2024-07-16 15:41:01 (GMT)