summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.github/workflows/linux-build.yml26
-rw-r--r--.github/workflows/mac-build.yml61
-rw-r--r--.github/workflows/win-build.yml65
-rw-r--r--README.md3
-rw-r--r--doc/CrtChannel.33
-rw-r--r--doc/binary.n9
-rw-r--r--doc/dict.n2
-rw-r--r--doc/http.n26
-rw-r--r--doc/re_syntax.n6
-rw-r--r--generic/tclBinary.c15
-rw-r--r--generic/tclCmdMZ.c42
-rw-r--r--generic/tclCompExpr.c10
-rw-r--r--generic/tclInt.h6
-rw-r--r--generic/tclParse.c10
-rw-r--r--generic/tclTest.c6
-rw-r--r--generic/tclUtf.c15
-rw-r--r--tests/async.test2
-rw-r--r--tests/binary.test11
-rw-r--r--tests/chanio.test7
-rw-r--r--tests/cmdAH.test2
-rw-r--r--tests/exec.test7
-rw-r--r--tests/fCmd.test7
-rw-r--r--tests/fileName.test2
-rw-r--r--tests/fileSystem.test8
-rw-r--r--tests/format.test5
-rw-r--r--tests/httpcookie.test7
-rw-r--r--tests/io.test11
-rw-r--r--tests/registry.test2
-rw-r--r--tests/socket.test12
-rw-r--r--tests/utf.test12
-rw-r--r--tests/winDde.test2
-rw-r--r--tests/winFCmd.test42
-rw-r--r--tests/winFile.test2
-rw-r--r--tests/winPipe.test2
-rw-r--r--tests/winTime.test6
-rw-r--r--tools/tcltk-man2html-utils.tcl71
36 files changed, 384 insertions, 141 deletions
diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml
index db46cfd..a4fd7b3 100644
--- a/.github/workflows/linux-build.yml
+++ b/.github/workflows/linux-build.yml
@@ -1,37 +1,45 @@
name: Linux Build and Test
on: [push]
jobs:
- build:
+ gcc:
runs-on: ubuntu-latest
+ strategy:
+ matrix:
+ symbols:
+ - "no"
+ - "mem"
+ - "all"
+ defaults:
+ run:
+ shell: bash
+ working-directory: unix
steps:
- name: Checkout
uses: actions/checkout@v2
- - name: Configure
- working-directory: unix
+ - name: Configure (symbols=${{ matrix.symbols }})
run: |
mkdir "${HOME}/install dir"
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
+ env:
+ CFGOPT: --enable-symbols=${{ matrix.symbols }}
+ - name: Prepare
+ run: touch tclStubInit.c tclOOStubInit.c
+ working-directory: generic
- name: Build
- working-directory: unix
run: |
make all
- name: Build Test Harness
- working-directory: unix
run: |
make tcltest
- name: Run Tests
- working-directory: unix
run: |
make test
- name: Test-Drive Installation
- working-directory: unix
run: |
make install
- name: Create Distribution Package
- working-directory: unix
run: |
make dist
- name: Convert Documentation to HTML
- working-directory: unix
run: |
make html-tcl
diff --git a/.github/workflows/mac-build.yml b/.github/workflows/mac-build.yml
new file mode 100644
index 0000000..c78f882
--- /dev/null
+++ b/.github/workflows/mac-build.yml
@@ -0,0 +1,61 @@
+name: macOS Build and Test
+on: [push]
+jobs:
+ with-Xcode:
+ runs-on: macos-latest
+ defaults:
+ run:
+ shell: bash
+ working-directory: macosx
+ steps:
+ - name: Checkout
+ uses: actions/checkout@v2
+ - name: Prepare
+ run: touch tclStubInit.c tclOOStubInit.c
+ working-directory: generic
+ - name: Build
+ run: make all
+ - name: Run Tests
+ run: make test styles=develop
+ env:
+ ERROR_ON_FAILURES: 1
+ MAC_CI: 1
+ Unix-like:
+ runs-on: macos-latest
+ strategy:
+ matrix:
+ symbols:
+ - "no"
+ - "mem"
+ dtrace:
+ - "no"
+ - "yes"
+ defaults:
+ run:
+ shell: bash
+ working-directory: unix
+ steps:
+ - name: Checkout
+ uses: actions/checkout@v2
+ - name: Prepare
+ run: |
+ touch tclStubInit.c tclOOStubInit.c
+ mkdir "$HOME/install dir"
+ working-directory: generic
+ - name: Configure (symbols=${{ matrix.symbols }} dtrace=${{ matrix.dtrace }})
+ # Note that macOS is always a 64 bit platform
+ run: ./configure --enable-64bit ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
+ env:
+ CFGOPT: --enable-symbols=${{ matrix.symbols }} --enable-dtrace=${{ matrix.dtrace }}
+ - name: Build
+ run: |
+ make all tcltest
+ - name: Run Tests
+ run: |
+ make test
+ env:
+ ERROR_ON_FAILURES: 1
+ MAC_CI: 1
+ - name: Trial Installation
+ run: |
+ make install
diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml
index 652b34a..9c3d76c 100644
--- a/.github/workflows/win-build.yml
+++ b/.github/workflows/win-build.yml
@@ -1,22 +1,75 @@
name: Windows Build and Test
on: [push]
jobs:
- build:
+ MSVC:
runs-on: windows-latest
+ defaults:
+ run:
+ shell: powershell
+ working-directory: win
+ # Using powershell means we need to explicitly stop on failure
steps:
- name: Checkout
uses: actions/checkout@v2
- name: Init MSVC
uses: ilammy/msvc-dev-cmd@v1
- name: Build
- working-directory: win
run: |
- nmake -f makefile.vc all
+ &nmake -f makefile.vc all
+ if ($lastexitcode -ne 0) {
+ throw "nmake exit code: $lastexitcode"
+ }
- name: Build Test Harness
- working-directory: win
run: |
- nmake -f makefile.vc tcltest
+ &nmake -f makefile.vc tcltest
+ if ($lastexitcode -ne 0) {
+ throw "nmake exit code: $lastexitcode"
+ }
- name: Run Tests
+ run: |
+ &nmake -f makefile.vc test
+ if ($lastexitcode -ne 0) {
+ throw "nmake exit code: $lastexitcode"
+ }
+ env:
+ ERROR_ON_FAILURES: 1
+ CI_BUILD_WITH_MSVC: 1
+ MSYS-gcc:
+ runs-on: windows-latest
+ defaults:
+ run:
+ shell: bash
working-directory: win
+ strategy:
+ matrix:
+ symbols:
+ - "no"
+ - "mem"
+ - "all"
+ # Using powershell means we need to explicitly stop on failure
+ steps:
+ - name: Checkout
+ uses: actions/checkout@v2
+ - name: Install MSYS2 and Make
+ run: choco install msys2 make
+ - name: Prepare
+ run: |
+ touch tclStubInit.c tclOOStubInit.c
+ mkdir "${HOME}/install dir"
+ working-directory: generic
+ - name: Configure (symbols=${{ matrix.symbols }})
run: |
- nmake -f makefile.vc test
+ ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
+ env:
+ CFGOPT: --enable-64bit --enable-symbols=${{ matrix.symbols }}
+ - name: Build
+ run: make all
+ - name: Build Test Harness
+ run: make tcltest
+ - name: Run Tests
+ run: make test
+ env:
+ ERROR_ON_FAILURES: 1
+
+# If you add builds with Wine, be sure to define the environment variable
+# CI_USING_WINE when running them so that broken tests know not to run.
diff --git a/README.md b/README.md
index 56db098..905b32e 100644
--- a/README.md
+++ b/README.md
@@ -8,14 +8,17 @@ site](https://sourceforge.net/projects/tcl/files/Tcl/).
8.6.10
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Acore-8-6-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Acore-8-6-branch)
+[![Build Status](https://github.com/tcltk/tcl/workflows/macOS%20Build%20and%20Test/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Acore-8-6-branch)
<br>
8.7a4
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Acore-8-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Acore-8-branch)
+[![Build Status](https://github.com/tcltk/tcl/workflows/macOS%20Build%20and%20Test/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Acore-8-branch)
<br>
9.0a2
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Amain)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Amain)
+[![Build Status](https://github.com/tcltk/tcl/workflows/macOS%20Build%20and%20Test/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Amain)
## Contents
1. [Introduction](#intro)
diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3
index 929b1b8..0092cfb 100644
--- a/doc/CrtChannel.3
+++ b/doc/CrtChannel.3
@@ -259,7 +259,8 @@ outside this range, \fBTcl_SetChannelBufferSize\fR sets the buffer size to
the generic layer that the events specified by \fImask\fR have
occurred on the channel. Channel drivers are responsible for invoking
this function whenever the channel handlers need to be called for the
-channel. See \fBWATCHPROC\fR below for more details.
+channel (or other pending tasks like a write flush should be performed).
+See \fBWATCHPROC\fR below for more details.
.PP
\fBTcl_BadChannelOption\fR is called from driver specific
\fIsetOptionProc\fR or \fIgetOptionProc\fR to generate a complete
diff --git a/doc/binary.n b/doc/binary.n
index 0e8b28e..9b8b106 100644
--- a/doc/binary.n
+++ b/doc/binary.n
@@ -762,6 +762,15 @@ high-to-low order within each byte. For example,
will return \fB2\fR with \fB01110\fR stored in \fIvar1\fR and
\fB1000011100000101\fR stored in \fIvar2\fR.
.RE
+.IP \fBC\fR 5
+This form is similar to \fBA\fR, except that it scans the data from start
+and terminates at the first null (C string semantics). For example,
+.RS
+.CS
+\fBbinary scan\fR "abc\e000efghi" C* var1
+.CE
+will return \fB1\fR with \fBabc\fR stored in \fIvar1\fR.
+.RE
.IP \fBH\fR 5
The data is turned into a string of \fIcount\fR hexadecimal digits in
high-to-low order represented as a sequence of characters in the set
diff --git a/doc/dict.n b/doc/dict.n
index e06947b..5f5a087 100644
--- a/doc/dict.n
+++ b/doc/dict.n
@@ -61,7 +61,7 @@ of the given patterns (in the style of \fBstring match\fR.)
.
The script rule tests for matching by assigning the key to the
\fIkeyVariable\fR and the value to the \fIvalueVariable\fR, and then evaluating
-the given script which should return a boolean value (with the
+the given script which should result in a boolean value (with the
key/value pair only being included in the result of the \fBdict
filter\fR when a true value is returned.) Note that the first
argument after the rule selection word is a two-element list. If the
diff --git a/doc/http.n b/doc/http.n
index 03cc811..34fdf9d 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -78,6 +78,9 @@ when the transaction completes. For this to work, the Tcl event loop
must be active. In Tk applications this is always true. For pure-Tcl
applications, the caller can use \fB::http::wait\fR after calling
\fB::http::geturl\fR to start the event loop.
+.PP
+\fBNote:\fR The event queue is even used without the \fB-command\fR option.
+As a side effect, arbitrary commands may be processed while \fBhttp::geturl\fR is running.
.SH COMMANDS
.TP
\fB::http::config\fR ?\fIoptions\fR?
@@ -325,9 +328,11 @@ otherwise complain about HTTP/1.1.
\fB\-query\fR \fIquery\fR
.
This flag causes \fB::http::geturl\fR to do a POST request that passes the
-\fIquery\fR to the server. The \fIquery\fR must be an x-url-encoding
-formatted query. The \fB::http::formatQuery\fR procedure can be used to
-do the formatting.
+\fIquery\fR as payload verbatim to the server.
+The content format (and encoding) of \fIquery\fR is announced by the header
+field \fBcontent-type\fR set by the option \fB-type\fR.
+\fIquery\fR is an x-url-encoding formatted query, if used for html forms.
+The \fB::http::formatQuery\fR procedure can be used to do the formatting.
.TP
\fB\-queryblocksize\fR \fIsize\fR
.
@@ -551,6 +556,14 @@ is raised, but the status of the transaction will be \fBeof\fR.
.
The error message will also be stored in the \fBerror\fR status
array element, accessible via \fB::http::error\fR.
+.TP
+\fBtimeout\fR
+.
+A timeout occurred before the transaction could complete
+.TP
+\fBreset\fR
+.
+user-reset
.PP
Another error possibility is that \fB::http::geturl\fR is unable to
write all the post query data to the server before the server
@@ -666,10 +679,9 @@ the post query data to the server.
.TP
\fBstatus\fR
.
-Either \fBok\fR, for successful completion, \fBreset\fR for
-user-reset, \fBtimeout\fR if a timeout occurred before the transaction
-could complete, or \fBerror\fR for an error condition. During the
-transaction this value is the empty string.
+See description in the chapter \fBERRORS\fR above for a
+list and description of \fBstatus\fR.
+During the transaction this value is the empty string.
.TP
\fBtotalsize\fR
.
diff --git a/doc/re_syntax.n b/doc/re_syntax.n
index 8d732ed..4504a58 100644
--- a/doc/re_syntax.n
+++ b/doc/re_syntax.n
@@ -293,12 +293,12 @@ treatment is as if the enclosing delimiters were
.QW \fB[.\fR \&
and
.QW \fB.]\fR .)
-For example, if \fBo\fR and \fB\[^o]\fR are the members of an
+For example, if \fBo\fR and \fB\(^o\fR are the members of an
equivalence class, then
.QW \fB[[=o=]]\fR ,
-.QW \fB[[=\[^o]=]]\fR ,
+.QW \fB[[=\(^o=]]\fR ,
and
-.QW \fB[o\[^o]]\fR \&
+.QW \fB[o\(^o]\fR \&
are all synonymous. An equivalence class may not be an endpoint of a range.
.RS
.PP
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index f53c707..8a3541b 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -1518,7 +1518,8 @@ BinaryScanCmd(
}
switch (cmd) {
case 'a':
- case 'A': {
+ case 'A':
+ case 'C': {
unsigned char *src;
if (arg >= objc) {
@@ -1540,10 +1541,18 @@ BinaryScanCmd(
size = count;
/*
- * Trim trailing nulls and spaces, if necessary.
+ * Apply C string semantics or trim trailing
+ * nulls and spaces, if necessary.
*/
- if (cmd == 'A') {
+ if (cmd == 'C') {
+ for (i = 0; i < size; i++) {
+ if (src[i] == '\0') {
+ size = i;
+ break;
+ }
+ }
+ } else if (cmd == 'A') {
while (size > 0) {
if (src[size - 1] != '\0' && src[size - 1] != ' ') {
break;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index c47490a..0764c60 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -2500,8 +2500,8 @@ StringStartCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int ch;
- const char *p, *string;
- int cur, index, length, numChars;
+ const Tcl_UniChar *p, *string;
+ int cur, index, length;
Tcl_Obj *obj;
if (objc != 3) {
@@ -2509,32 +2509,30 @@ StringStartCmd(
return TCL_ERROR;
}
- string = TclGetStringFromObj(objv[1], &length);
- numChars = Tcl_NumUtfChars(string, length);
- if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) {
+ string = Tcl_GetUnicodeFromObj(objv[1], &length);
+ if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
return TCL_ERROR;
}
- string = TclGetStringFromObj(objv[1], &length);
- if (index >= numChars) {
- index = numChars - 1;
+ if (index >= length) {
+ index = length - 1;
}
cur = 0;
if (index > 0) {
- p = Tcl_UtfAtIndex(string, index);
+ p = &string[index];
- TclUtfToUCS4(p, &ch);
+ (void)TclUniCharToUCS4(p, &ch);
for (cur = index; cur >= 0; cur--) {
int delta = 0;
- const char *next;
+ const Tcl_UniChar *next;
if (!Tcl_UniCharIsWordChar(ch)) {
break;
}
- next = TclUtfPrev(p, string);
+ next = TclUCS4Prev(p, string);
do {
next += delta;
- delta = TclUtfToUCS4(next, &ch);
+ delta = TclUniCharToUCS4(next, &ch);
} while (next + delta < p);
p = next;
}
@@ -2572,8 +2570,8 @@ StringEndCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int ch;
- const char *p, *end, *string;
- int cur, index, length, numChars;
+ const Tcl_UniChar *p, *end, *string;
+ int cur, index, length;
Tcl_Obj *obj;
if (objc != 3) {
@@ -2581,20 +2579,18 @@ StringEndCmd(
return TCL_ERROR;
}
- string = TclGetStringFromObj(objv[1], &length);
- numChars = Tcl_NumUtfChars(string, length);
- if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) {
+ string = Tcl_GetUnicodeFromObj(objv[1], &length);
+ if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
return TCL_ERROR;
}
- string = TclGetStringFromObj(objv[1], &length);
if (index < 0) {
index = 0;
}
- if (index < numChars) {
- p = Tcl_UtfAtIndex(string, index);
+ if (index < length) {
+ p = &string[index];
end = string+length;
for (cur = index; p < end; cur++) {
- p += TclUtfToUCS4(p, &ch);
+ p += TclUniCharToUCS4(p, &ch);
if (!Tcl_UniCharIsWordChar(ch)) {
break;
}
@@ -2603,7 +2599,7 @@ StringEndCmd(
cur++;
}
} else {
- cur = numChars;
+ cur = length;
}
TclNewIntObj(obj, cur);
Tcl_SetObjResult(interp, obj);
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 41938e3..fa15fba 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -1928,7 +1928,7 @@ ParseLexeme(
{
const char *end;
int scanned, size;
- Tcl_UniChar ch = 0;
+ int ch;
Tcl_Obj *literal = NULL;
unsigned char byte;
@@ -2145,14 +2145,14 @@ ParseLexeme(
*/
if (!TclIsBareword(*start) || *start == '_') {
- if (Tcl_UtfCharComplete(start, numBytes)) {
- scanned = TclUtfToUniChar(start, &ch);
+ if (TclUCS4Complete(start, numBytes)) {
+ scanned = TclUtfToUCS4(start, &ch);
} else {
- char utfBytes[4];
+ char utfBytes[8];
memcpy(utfBytes, start, numBytes);
utfBytes[numBytes] = '\0';
- scanned = TclUtfToUniChar(utfBytes, &ch);
+ scanned = TclUtfToUCS4(utfBytes, &ch);
}
*lexemePtr = INVALID;
Tcl_DecrRefCount(literal);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 9dde88b..8088d0e 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3252,12 +3252,14 @@ MODULE_SCOPE int TclUtfCount(int ch);
#if TCL_UTF_MAX > 3
# define TclUtfToUCS4 Tcl_UtfToUniChar
# define TclUniCharToUCS4(src, ptr) (*ptr = *(src),1)
+# define TclUCS4Prev(src, ptr) (((src) > (ptr)) ? ((src) - 1) : (src))
# define TclUCS4Complete Tcl_UtfCharComplete
# define TclChar16Complete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
? ((length) >= 3) : Tcl_UtfCharComplete((src), (length)))
#else
- MODULE_SCOPE int TclUtfToUCS4(const char *src, int *ucs4Ptr);
- MODULE_SCOPE int TclUniCharToUCS4(const Tcl_UniChar *src, int *ucs4Ptr);
+ MODULE_SCOPE int TclUtfToUCS4(const char *, int *);
+ MODULE_SCOPE int TclUniCharToUCS4(const Tcl_UniChar *, int *);
+ MODULE_SCOPE const Tcl_UniChar *TclUCS4Prev(const Tcl_UniChar *, const Tcl_UniChar *);
# define TclUCS4Complete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
? ((length) >= 4) : Tcl_UtfCharComplete((src), (length)))
# define TclChar16Complete Tcl_UtfCharComplete
diff --git a/generic/tclParse.c b/generic/tclParse.c
index daad31d..b863ff2 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -789,7 +789,7 @@ TclParseBackslash(
* written. At most 4 bytes will be written there. */
{
const char *p = src+1;
- Tcl_UniChar unichar = 0;
+ int unichar;
int result;
int count;
char buf[4] = "";
@@ -935,14 +935,14 @@ TclParseBackslash(
* #217987] test subst-3.2
*/
- if (Tcl_UtfCharComplete(p, numBytes - 1)) {
- count = TclUtfToUniChar(p, &unichar) + 1; /* +1 for '\' */
+ if (TclUCS4Complete(p, numBytes - 1)) {
+ count = TclUtfToUCS4(p, &unichar) + 1; /* +1 for '\' */
} else {
- char utfBytes[4];
+ char utfBytes[8];
memcpy(utfBytes, p, numBytes - 1);
utfBytes[numBytes - 1] = '\0';
- count = TclUtfToUniChar(utfBytes, &unichar) + 1;
+ count = TclUtfToUCS4(utfBytes, &unichar) + 1;
}
result = unichar;
break;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index d7f16f8..03f8842 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -6914,8 +6914,10 @@ TestUtfNextCmd(
/* Run Tcl_UtfNext with many more possible bytes at src[end], all should give the same result */
result = Tcl_UtfNext(buffer + 1);
if (first != result) {
- first = buffer;
- break;
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Tcl_UtfNext is not supposed to read src[end]\n"
+ "Different result when src[end] is %#x", UCHAR(p[-1])));
+ return TCL_ERROR;
}
}
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 11bde5c..525cd50 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -2629,12 +2629,25 @@ TclUniCharToUCS4(
* by the Tcl_UniChar string. */
{
if (((src[0] & 0xFC00) == 0xD800) && ((src[1] & 0xFC00) == 0xDC00)) {
- *ucs4Ptr = (((src[0] & 0x3FF) << 10) | (src[01] & 0x3FF)) + 0x10000;
+ *ucs4Ptr = (((src[0] & 0x3FF) << 10) | (src[1] & 0x3FF)) + 0x10000;
return 2;
}
*ucs4Ptr = src[0];
return 1;
}
+
+const Tcl_UniChar *TclUCS4Prev(const Tcl_UniChar *src, const Tcl_UniChar *ptr) {
+ if (src <= ptr + 1) {
+ return ptr;
+ }
+ if (((src[-1] & 0xFC00) == 0xDC00) && ((src[-2] & 0xFC00) == 0xD800)) {
+ return src - 2;
+ }
+ return src - 1;
+}
+
+
+
#endif
/*
diff --git a/tests/async.test b/tests/async.test
index 642e295..553735b 100644
--- a/tests/async.test
+++ b/tests/async.test
@@ -20,7 +20,7 @@ if {"::tcltest" ni [namespace children]} {
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testasync [llength [info commands testasync]]
-testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
+testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]
proc async1 {result code} {
global aresult acode
diff --git a/tests/binary.test b/tests/binary.test
index cf3195f..7433fe8 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -759,7 +759,16 @@ test binary-21.12 {Tcl_BinaryObjCmd: scan} -setup {
} -body {
list [binary scan "abc def \x00ghi " A* arg1] $arg1
} -result [list 1 "abc def \x00ghi"]
-
+test binary-21.13 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ list [binary scan "abc def \x00 " C* arg1] $arg1
+} -result {1 {abc def }}
+test binary-21.12 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ list [binary scan "abc def \x00ghi" C* arg1] $arg1
+} -result {1 {abc def }}
test binary-22.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
binary scan abc b
} -result {not enough arguments for all format specifiers}
diff --git a/tests/chanio.test b/tests/chanio.test
index 8e46e88..16244e2 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -47,7 +47,8 @@ namespace eval ::tcl::test::io {
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint testservicemode [llength [info commands testservicemode]]
- testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
+ testConstraint notWinCI [expr {
+ $::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
# You need a *very* special environment to do some tests. In particular,
@@ -1886,7 +1887,7 @@ test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -bod
} -result {{{} {}} {auto lf}}
test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup {
set path(stdout) [makeFile {} stdout]
-} -constraints {stdio knownMsvcBug} -body {
+} -constraints {stdio notWinCI} -body {
set f [open $path(script) w]
chan puts -nonewline $f {
chan close stdout
@@ -2796,7 +2797,7 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} -s
chan puts $s $l
}
}
-} -constraints {socket tempNotMac fileevent knownMsvcBug} -body {
+} -constraints {socket tempNotMac fileevent notWinCI} -body {
proc accept {s a p} {
variable x
chan event $s readable [namespace code [list readit $s]]
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 67c49c7..8c83660 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -30,7 +30,7 @@ testConstraint linkDirectory [expr {
($::tcl_platform(osVersion) >= 5.0
&& [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
}]
-testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
global env
set cmdAHwd [pwd]
diff --git a/tests/exec.test b/tests/exec.test
index 458e12a..83241a9 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -26,7 +26,8 @@ package require tcltests
# All tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
-testConstraint noosx [expr {![info exists ::env(TRAVIS_OSX_IMAGE)] || ![string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]
+# Some skips when running in a macOS CI environment
+testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}]
unset -nocomplain path
@@ -673,7 +674,9 @@ test exec-18.2 {exec cat deals with weird file names} -body {
# Note that this test cannot be adapted to work on Windows; that platform has
# no kernel support for an analog of O_APPEND. OTOH, that means we can assume
# that there is a POSIX shell...
-test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind noosx} -setup {
+#
+# This test also fails in some cases when building with macOS
+test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind noosxCI} -setup {
set tmpfile [makeFile {0} tmpfile.exec-19.1]
} -body {
# Note that we have to allow for the current contents of the temporary
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 986e2f4..ac8cfb5 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -41,7 +41,7 @@ if {[testConstraint win]} {
testConstraint reg 1
}
}
-testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint notCI [expr {![info exists ::env(CI)] || !$::env(CI)}]
set tmpspace /tmp;# default value
# Find a group that exists on this Unix system, or else skip tests that
@@ -79,6 +79,7 @@ testConstraint darwin9 [expr {
&& [package vsatisfies 1.$::tcl_platform(osVersion) 1.9]
}]
testConstraint notDarwin9 [expr {![testConstraint darwin9]}]
+testConstraint notContinuousIntegration [expr {![info exists ::env(CI)]}]
testConstraint fileSharing 0
testConstraint notFileSharing 1
@@ -2581,7 +2582,9 @@ test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win notWine} -body
&& [file exists $env(USERPROFILE)/NTUSER.DAT]
&& [file readable $env(USERPROFILE)/NTUSER.DAT]}
} -result {1}
-test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win notWine} -body {
+# At least one CI environment (GitHub Actions) is set up with the page file in
+# an unusual location; skip the test if that is so.
+test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win notCI} -body {
set r {}
if {[info exists env(SystemDrive)]} {
set path $env(SystemDrive)/pagefile.sys
diff --git a/tests/fileName.test b/tests/fileName.test
index bef5a22..8be4fdd 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -31,7 +31,7 @@ if {[testConstraint win]} {
testConstraint symbolicLinkFile 0
testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
}
-testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
# This match compares the first two words of the result. If the wanted result
# is "equal", then this is successful if the words are equal. If the wanted
# result is "not equal", then this is successful if the words are different.
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 93a3f51..a6fa645 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -37,7 +37,9 @@ catch {
testConstraint testfilesystem [llength [info commands ::testfilesystem]]
testConstraint testsetplatform [llength [info commands ::testsetplatform]]
testConstraint testsimplefilesystem [llength [info commands ::testsimplefilesystem]]
-testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
+# Some things fail under all Continuous Integration systems for subtle reasons
+# such as CI often running with elevated privileges in a container.
+testConstraint notInCIenv [expr {![info exists ::env(CI)]}]
cd [tcltest::temporaryDirectory]
makeFile "test file" gorp.file
@@ -316,7 +318,7 @@ test filesystem-1.37 {file normalisation with '/./'} -body {
} -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$}
test filesystem-1.38 {file normalisation with volume relative} -setup {
set dir [pwd]
-} -constraints {win moreThanOneDrive knownMsvcBug} -body {
+} -constraints {win moreThanOneDrive notInCIenv} -body {
set path "[string range [lindex $drives 0] 0 1]foo"
cd [lindex $drives 1]
file norm $path
@@ -565,7 +567,7 @@ test filesystem-7.1.1 {load from vfs} -setup {
cd [file dirname $::ddelib]
testsimplefilesystem 1
# This loads dde via a complex copy-to-temp operation
- load simplefs:/[file tail $::ddelib] dde
+ load simplefs:/[file tail $::ddelib] Dde
testsimplefilesystem 0
return ok
# The real result of this test is what happens when Tcl exits.
diff --git a/tests/format.test b/tests/format.test
index 8d6fd82..44fa64e 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -20,7 +20,10 @@ testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]
-testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
+# MSVC uses a broken libc that gets sprintf("%g") wrong. This is a pain
+# particularly in Continuous Integration, and there isn't anything much we can
+# do about it.
+testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]
test format-1.1 {integer formatting} {
format "%*d %d %d %d" 6 34 16923 -12 -1
diff --git a/tests/httpcookie.test b/tests/httpcookie.test
index ca54073..38a18bb 100644
--- a/tests/httpcookie.test
+++ b/tests/httpcookie.test
@@ -16,11 +16,8 @@ if {"::tcltest" ni [namespace children]} {
::tcltest::loadTestedCommands
-testConstraint notOSXtravis [apply {{} {
- upvar 1 env(TRAVIS_OSX_IMAGE) travis
- return [expr {![info exists travis] || ![string match xcode* $travis]}]
-}}]
-testConstraint sqlite3 [expr {[testConstraint notOSXtravis] && ![catch {
+testConstraint notMacCI [expr {![info exists ::env(MAC_CI)]}]
+testConstraint sqlite3 [expr {[testConstraint notMacCI] && ![catch {
package require sqlite3
}]}]
testConstraint cookiejar [expr {[testConstraint sqlite3] && ![catch {
diff --git a/tests/io.test b/tests/io.test
index 8379a09..0aa4ebf 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -43,7 +43,10 @@ testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint testobj [llength [info commands testobj]]
testConstraint testservicemode [llength [info commands testservicemode]]
-testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
+# Some things fail under Windows in Continuous Integration systems for subtle
+# reasons such as CI often running with elevated privileges in a container.
+testConstraint notWinCI [expr {
+ $::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
# You need a *very* special environment to do some tests. In
@@ -2230,7 +2233,7 @@ test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \
set path(pipe) [makeFile {} pipe]
set path(output) [makeFile {} output]
test io-27.6 {FlushChannel, async flushing, async close} \
- {stdio asyncPipeClose knownMsvcBug} {
+ {stdio asyncPipeClose notWinCI} {
# This test may fail on old Unix systems (seen on IRIX64 6.5) with
# obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
file delete $path(pipe)
@@ -2834,7 +2837,7 @@ test io-29.31 {Tcl_WriteChars, background flush} stdio {
set result
} ok
test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
- {stdio asyncPipeClose knownMsvcBug} {
+ {stdio asyncPipeClose notWinCI} {
# This test may fail on old Unix systems (seen on IRIX64 6.5) with
# obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
file delete $path(pipe)
@@ -8132,7 +8135,7 @@ test io-53.17 {[7c187a3773] MBWrite: proper inQueueTail handling} -setup {
removeFile out
} -result {line 100 line}
-test io-54.1 {Recursive channel events} {socket fileevent knownMsvcBug} {
+test io-54.1 {Recursive channel events} {socket fileevent notWinCI} {
# This test checks to see if file events are delivered during recursive
# event loops when there is buffered data on the channel.
diff --git a/tests/registry.test b/tests/registry.test
index dbf4575..c1673b5 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -24,7 +24,7 @@ if {[testConstraint win]} {
testConstraint reg 1
}
}
-testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
# determine the current locale
testConstraint english [expr {
diff --git a/tests/socket.test b/tests/socket.test
index 82f5968..0cb1411 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -69,15 +69,19 @@ if {"::tcltest" ni [namespace children]} {
catch [list package require -exact tcl::test [info patchlevel]]
::tcltest::loadTestedCommands
-if {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]} {
+# A bad interaction between socket creation, macOS, and unattended CI
+# environments make this whole file impractical to run; too many weird hangs.
+if {[info exists ::env(MAC_CI)]} {
return
}
-testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
# Some tests require the Thread package or exec command
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint exec [llength [info commands exec]]
-testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
+testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]
+testConstraint notWinCI [expr {
+ $tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
# Produce a random port number in the Dynamic/Private range
# from 49152 through 65535.
@@ -2390,7 +2394,7 @@ test socket-14.10.1 {pending [socket -async] and nonblocking [puts], server is I
removeFile script
} -result {{} ok}
test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \
- -constraints {socket knownMsvcBug} \
+ -constraints {socket notWinCI} \
-body {
set sock [socket -async localhost [randport]]
fconfigure $sock -blocking 0
diff --git a/tests/utf.test b/tests/utf.test
index eacff20..8c36b9a 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -253,8 +253,8 @@ test utf-6.22 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xD0\xF8]
} 1
test utf-6.23 {Tcl_UtfNext} {testutfnext testbytestring} {
- testutfnext [testbytestring \xE8]
-} -1
+ testutfnext [testbytestring \xE8\x00]
+} 1
test utf-6.24 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xE8]G
} 1
@@ -277,8 +277,8 @@ test utf-6.30.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
testutfnext [testbytestring \xF2]
} 1
test utf-6.30.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
- testutfnext [testbytestring \xF2]
-} -1
+ testutfnext [testbytestring \xF2\x00]
+} 1
test utf-6.31 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xF2]G
} 1
@@ -286,8 +286,8 @@ test utf-6.32.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
testutfnext [testbytestring \xF2\xA0]
} 1
test utf-6.32.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
- testutfnext [testbytestring \xF2\xA0]
-} -1
+ testutfnext [testbytestring \xF2\xA0\x00]
+} 1
test utf-6.33 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xF2\xD0]
} 1
diff --git a/tests/winDde.test b/tests/winDde.test
index 421578b..9d15357 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -24,7 +24,7 @@ if {[testConstraint win]} {
testConstraint dde 1
}
}
-testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
# -------------------------------------------------------------------------
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index c390de3..dcc3d67 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -28,8 +28,10 @@ testConstraint testchmod [llength [info commands testchmod]]
testConstraint cdrom 0
testConstraint exdev 0
testConstraint longFileNames 0
-testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
-testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+# Some things fail under all Continuous Integration systems for subtle reasons
+# such as CI often running with elevated privileges in a container.
+testConstraint notInCIenv [expr {![info exists ::env(CI)]}]
+testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]
proc createfile {file {string a}} {
set f [open $file w]
@@ -133,25 +135,25 @@ test winFCmd-1.1 {TclpRenameFile: errno: EACCES} -body {
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} -setup {
cleanup
-} -constraints {win testfile notWine} -body {
+} -constraints {win testfile notInCIenv} -body {
file mkdir td1/td2/td3
file mkdir td2
testfile mv td2 td1/td2
} -returnCodes error -result EEXIST
test winFCmd-1.3 {TclpRenameFile: errno: EINVAL} -setup {
cleanup
-} -constraints {win testfile notWine} -body {
+} -constraints {win testfile notInCIenv} -body {
testfile mv / td1
} -returnCodes error -result EINVAL
test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} -setup {
cleanup
-} -constraints {win testfile notWine} -body {
+} -constraints {win testfile notInCIenv} -body {
file mkdir td1
testfile mv td1 td1/td2
} -returnCodes error -result EINVAL
test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} -setup {
cleanup
-} -constraints {win testfile notWine} -body {
+} -constraints {win testfile notInCIenv} -body {
file mkdir td1
createfile tf1
testfile mv tf1 td1
@@ -256,7 +258,7 @@ test winFCmd-1.22 {TclpRenameFile: long dst} -setup {
} -returnCodes error -result ENAMETOOLONG
test winFCmd-1.23 {TclpRenameFile: move dir into self} -setup {
cleanup
-} -constraints {win testfile notWine} -body {
+} -constraints {win testfile notInCIenv} -body {
file mkdir td1
testfile mv [pwd]/td1 td1/td2
} -returnCodes error -result EINVAL
@@ -301,21 +303,21 @@ test winFCmd-1.29 {TclpRenameFile: src is dir} -setup {
} -returnCodes error -result ENOTDIR
test winFCmd-1.30 {TclpRenameFile: dst is dir} -setup {
cleanup
-} -constraints {win testfile notWine} -body {
+} -constraints {win testfile notInCIenv} -body {
file mkdir td1
file mkdir td2/td2
testfile mv td1 td2
} -returnCodes error -result EEXIST
test winFCmd-1.31 {TclpRenameFile: TclpRemoveDirectory fails} -setup {
cleanup
-} -constraints {win testfile notWine} -body {
+} -constraints {win testfile notInCIenv} -body {
file mkdir td1
file mkdir td2/td2
testfile mv td1 td2
} -returnCodes error -result EEXIST
test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} -setup {
cleanup
-} -constraints {win testfile notWine} -body {
+} -constraints {win testfile notInCIenv} -body {
file mkdir td1/td2
file mkdir td2
testfile mv td1 td2
@@ -344,7 +346,7 @@ test winFCmd-1.34 {TclpRenameFile: src is dir, dst is not} -setup {
} -returnCodes error -result ENOTDIR
test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} -setup {
cleanup
-} -constraints {win testfile notWine} -body {
+} -constraints {win testfile notInCIenv} -body {
file mkdir td1
createfile tf1
testfile mv tf1 td1
@@ -395,7 +397,7 @@ proc MakeFiles {dirname} {
test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup {
cleanup
-} -constraints {win winNonZeroInodes knownMsvcBug notWine} -body {
+} -constraints {win winNonZeroInodes knownMsvcBug notInCIenv} -body {
file mkdir td1
foreach {a b} [MakeFiles td1] break
file rename -force $a $b
@@ -640,7 +642,7 @@ test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} -setup {
test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup {
cleanup
-} -constraints {winVista testfile testchmod knownMsvcBug notWine} -body {
+} -constraints {winVista testfile testchmod knownMsvcBug notInCIenv} -body {
file mkdir td1
testchmod 0 td1
testfile rmdir td1
@@ -694,7 +696,7 @@ test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} -setup {
} -result {1 {tf1 ENOTDIR}}
test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup {
cleanup
-} -constraints {winVista testfile testchmod knownMsvcBug notWine} -body {
+} -constraints {winVista testfile testchmod knownMsvcBug notInCIenv} -body {
file mkdir td1
testchmod 0 td1
testfile rmdir td1
@@ -705,14 +707,14 @@ test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup {
} -result {td1 EACCES}
test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
cleanup
-} -constraints {win testfile notWine} -body {
+} -constraints {win testfile notInCIenv} -body {
testfile rmdir /
# WinXP returns EEXIST, WinNT seems to return EACCES. No policy
# decision has been made as to which is correct.
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
cleanup
-} -constraints {winVista testfile testchmod knownMsvcBug notWine} -body {
+} -constraints {winVista testfile testchmod knownMsvcBug notInCIenv} -body {
file mkdir td1
testchmod 0 td1
testfile rmdir td1
@@ -941,7 +943,7 @@ test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup {
} -result {}
test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
cleanup
-} -constraints {winVista testfile testchmod knownMsvcBug notWine} -body {
+} -constraints {winVista testfile testchmod knownMsvcBug notInCIenv} -body {
file mkdir td1/td2
testchmod 0 td1
testfile rmdir -force td1
@@ -1130,7 +1132,7 @@ test winFCmd-15.2 {SetWinFileAttributes - archive} -constraints {win} -setup {
} -cleanup {
cleanup
} -result {{} 1}
-test winFCmd-15.3 {SetWinFileAttributes - archive} -constraints {win notWine} -setup {
+test winFCmd-15.3 {SetWinFileAttributes - archive} -constraints {win notInCIenv} -setup {
cleanup
} -body {
createfile td1 {}
@@ -1138,7 +1140,7 @@ test winFCmd-15.3 {SetWinFileAttributes - archive} -constraints {win notWine} -s
} -cleanup {
cleanup
} -result {{} 0}
-test winFCmd-15.4 {SetWinFileAttributes - hidden} -constraints {win notWine} -setup {
+test winFCmd-15.4 {SetWinFileAttributes - hidden} -constraints {win notInCIenv} -setup {
cleanup
} -body {
createfile td1 {}
@@ -1171,7 +1173,7 @@ test winFCmd-15.7 {SetWinFileAttributes - readonly} -setup {
} -cleanup {
cleanup
} -result {{} 0}
-test winFCmd-15.8 {SetWinFileAttributes - system} -constraints {win notWine} -setup {
+test winFCmd-15.8 {SetWinFileAttributes - system} -constraints {win notInCIenv} -setup {
cleanup
} -body {
createfile td1 {}
diff --git a/tests/winFile.test b/tests/winFile.test
index 07bee07..357195e 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -24,7 +24,7 @@ testConstraint notNTFS 0
if {[testConstraint testvolumetype]} {
testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}]
}
-testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
test winFile-1.1 {TclpGetUserHome} -constraints {win} -body {
glob ~nosuchuser
diff --git a/tests/winPipe.test b/tests/winPipe.test
index d35373a..25b5517 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -28,7 +28,7 @@ set org_pwd [pwd]
set bindir [file join $org_pwd [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]
-testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
# several test-cases here expect current directory == [temporaryDirectory]:
diff --git a/tests/winTime.test b/tests/winTime.test
index c03e316..12d9b2d 100644
--- a/tests/winTime.test
+++ b/tests/winTime.test
@@ -19,7 +19,9 @@ if {"::tcltest" ni [namespace children]} {
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testwinclock [llength [info commands testwinclock]]
-testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
+# Some things fail under all Continuous Integration systems for subtle reasons
+# such as CI often running with elevated privileges in a container.
+testConstraint notInCIenv [expr {![info exists ::env(CI)]}]
# The next two tests will crash on Windows if the check for negative
# clock values is not done properly.
@@ -41,7 +43,7 @@ test winTime-1.2 {TclpGetDate} {win} {
# with the Windows clock. 30 sec really isn't enough,
# but how much time does a tester have patience for?
-test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock knownMsvcBug} {
+test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock notInCIenv} {
# May fail due to OS/hardware discrepancies. See:
# http://support.microsoft.com/default.aspx?scid=kb;en-us;274323
set failed {}
diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl
index b38f0b5..5b2a831 100644
--- a/tools/tcltk-man2html-utils.tcl
+++ b/tools/tcltk-man2html-utils.tcl
@@ -130,8 +130,8 @@ proc htmlize-text {text {charmap {}}} {
\" {&quot;} \
{<} {&lt;} \
{>} {&gt;} \
- \u201c "&#8220;" \
- \u201d "&#8221;"
+ \u201c "&ldquo;" \
+ \u201d "&rdquo;"
return [string map $charmap $text]
}
@@ -144,25 +144,70 @@ proc process-text {text} {
{\&} "\t" \
{\%} {} \
"\\\n" "\n" \
- {\(+-} "&#177;" \
+ {\(r!} "&iexcl;" \
+ {\(ct} "&cent;" \
+ {\(Po} "&pound;" \
+ {\(Cs} "&curren;" \
+ {\(Ye} "&yen;" \
+ {\(bb} "&brvbar;" \
+ {\(sc} "&sect;" \
+ {\(ad} "&die;" \
{\(co} "&copy;" \
- {\(em} "&#8212;" \
- {\(en} "&#8211;" \
- {\(fm} "&#8242;" \
- {\(mc} "&#181;" \
- {\(mu} "&#215;" \
- {\(mi} "&#8722;" \
- {\(->} "<font size=\"+1\">&#8594;</font>" \
+ {\(Of} "&ordf;" \
+ {\(Fo} "&laquo;" \
+ {\(no} "&not;" \
+ {\(rg} "&reg;" \
+ {\(a-} "&macr;" \
+ {\(de} "&deg;" \
+ {\(+-} "&plusmn;" \
+ {\(S2} "&sup2;" \
+ {\(S3} "&sup3;" \
+ {\(aa} "&acute;" \
+ {\(mc} "&micro;" \
+ {\(ps} "&para;" \
+ {\(pc} "&middot;" \
+ {\(ac} "&cedil;" \
+ {\(S1} "&sup1;" \
+ {\(Om} "&ordm;" \
+ {\(Fc} "&raquo;" \
+ {\(14} "&frac14;" \
+ {\(12} "&frac12;" \
+ {\(34} "&frac34;" \
+ {\(r?} "&iquest;" \
+ {\(AE} "&AElig;" \
+ {\(-D} "&ETH;" \
+ {\(mu} "&times;" \
+ {\(TP} "&THORN;" \
+ {\(ss} "&szlig;" \
+ {\(ae} "&aelig;" \
+ {\(Sd} "&eth;" \
+ {\(di} "&divide;" \
+ {\(Tp} "&thorn;" \
+ {\(em} "&mdash;" \
+ {\(en} "&ndash;" \
+ {\(bu} "&bull;" \
+ {\(fm} "&prime;" \
+ {\(mi} "&minus;" \
+ {\(.i} "&imath;" \
+ {\(.j} "&jmath;" \
+ {\(Fn} "&fnof;" \
+ {\(OE} "&OElig;" \
+ {\(oe} "&oelig;" \
+ {\(IJ} "&IJlig;" \
+ {\(ij} "&ijlig;" \
+ {\(<-} "<font size=\"+1\">&larr;</font>" \
+ {\(->} "<font size=\"+1\">&rarr;</font>" \
+ {\(eu} "&euro;" \
{\fP} {\fR} \
{\.} . \
- {\(bu} "&#8226;" \
]
# This might make a few invalid mappings, but we don't use them
- foreach c {a e i o u y A E I O U Y} {
+ foreach c {a c e g i l n o s t u y z A C E G I L N O S T U Y Z} {
foreach {prefix suffix} {
- o ring / slash : uml ' acute ^ circ ` grave
+ o ring / slash : uml ' acute ^ circ ` grave ~ tilde , cedil v caron
} {
lappend charmap "\\\[${prefix}${c}\]" "&${c}${suffix};"
+ lappend charmap "\\(${prefix}${c}" "&${c}${suffix};"
}
}
lappend charmap {\-\|\-} -- ; # two hyphens