summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--doc/Eval.36
-rw-r--r--doc/FileSystem.36
-rw-r--r--doc/Number.3123
-rw-r--r--doc/glob.n4
-rw-r--r--doc/source.n4
-rw-r--r--doc/tclsh.18
-rw-r--r--generic/regc_lex.c4
-rw-r--r--generic/regc_locale.c86
-rw-r--r--generic/tcl.decls10
-rw-r--r--generic/tcl.h14
-rwxr-xr-xgeneric/tclArithSeries.c2
-rw-r--r--generic/tclBasic.c30
-rw-r--r--generic/tclCmdIL.c2
-rw-r--r--generic/tclDecls.h20
-rw-r--r--generic/tclExecute.c4
-rw-r--r--generic/tclFileName.c41
-rw-r--r--generic/tclIO.c2
-rw-r--r--generic/tclInt.h14
-rw-r--r--generic/tclLink.c2
-rw-r--r--generic/tclObj.c40
-rw-r--r--generic/tclStubInit.c4
-rw-r--r--generic/tclUtil.c10
-rw-r--r--library/auto.tcl4
-rw-r--r--library/init.tcl2
-rw-r--r--library/package.tcl3
-rw-r--r--library/safe.tcl2
-rw-r--r--tests/chanio.test4
-rw-r--r--tests/fCmd.test8
-rw-r--r--tests/fileName.test72
-rw-r--r--tests/io.test4
-rw-r--r--tests/winFile.test2
-rw-r--r--tools/genStubs.tcl2
32 files changed, 337 insertions, 202 deletions
diff --git a/doc/Eval.3 b/doc/Eval.3
index 27cdf35..8776b2a 100644
--- a/doc/Eval.3
+++ b/doc/Eval.3
@@ -93,13 +93,11 @@ its contents as a Tcl script. It returns the same information as
If the file could not be read then a Tcl error is returned to describe
why the file could not be read.
The eofchar for files is
-.QW \e32
+.QW \ex1A
(^Z) for all platforms. If you require a
.QW ^Z
in code for string comparison, you can use
-.QW \e032
-or
-.QW \eu001a ,
+.QW \ex1A ,
which will be safely substituted by the Tcl interpreter into
.QW ^Z .
.PP
diff --git a/doc/FileSystem.3 b/doc/FileSystem.3
index ae4f4b3..239ff0f 100644
--- a/doc/FileSystem.3
+++ b/doc/FileSystem.3
@@ -425,14 +425,12 @@ reading the file contents.
If the file could not be read then a Tcl error is returned to describe
why the file could not be read.
The eofchar for files is
-.QW \e32
+.QW \ex1A
(^Z) for all platforms.
If you require a
.QW ^Z
in code for string comparison, you can use
-.QW \e032
-or
-.QW \eu001a ,
+.QW \ex1A ,
which will be safely substituted by the Tcl interpreter into
.QW ^Z .
\fBTcl_FSEvalFile\fR is a simpler version of
diff --git a/doc/Number.3 b/doc/Number.3
new file mode 100644
index 0000000..f405060
--- /dev/null
+++ b/doc/Number.3
@@ -0,0 +1,123 @@
+'\"
+'\" Contribution from Don Porter, NIST, 2022. (not subject to US copyright)
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH Tcl_GetNumber 3 8.7 Tcl "Tcl Library Procedures"
+.so man.macros
+.BS
+.SH NAME
+Tcl_GetNumber, Tcl_GetNumberFromObj \- get numeric value from Tcl value
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fB#include <tclTomMath.h>\fR
+.sp
+int
+\fBTcl_GetNumber\fR(\fIinterp, bytes, numBytes, clientDataPtr, typePtr\fR)
+.sp
+int
+\fBTcl_GetNumberFromObj\fR(\fIinterp, objPtr, clientDataPtr, typePtr\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp clientDataPtr out
+.AP Tcl_Interp *interp out
+When non-NULL, error information is recorded here when the value is not
+in any of the numeric formats recognized by Tcl.
+.AP "const char" *bytes in
+Points to first byte of the string value to be examined.
+.AP size_t numBytes in
+The number of bytes, starting at \fIbytes\fR, that should be examined.
+If the value \fBTCL_INDEX_NONE\fR is provided, then all bytes should
+be examined until the first \fBNUL\fR byte terminates examination.
+.AP "void *" *clientDataPtr out
+Points to space where a pointer value may be written through which a numeric
+value is available to read.
+.AP int *typePtr out
+Points to space where a value may be written reporting what type of
+numeric storage is available to read.
+.AP Tcl_Obj *objPtr in
+A Tcl value to be examined.
+.BE
+.SH DESCRIPTION
+.PP
+These procedures enable callers to retrieve a numeric value from a
+Tcl value in a numeric format recognized by Tcl.
+.PP
+Tcl recognizes many values as numbers. Several examples include:
+\fB"0"\fR, \fB" +1"\fR, \fB"-2 "\fR, \fB" 3 "\fR, \fB"0xdad1"\fR, \fB"0d09"\fR,
+\fB"1_000_000"\fR, \fB"4.0"\fR, \fB"1e-7"\fR, \fB"NaN"\fR, or \fB"Inf"\fR.
+When built-in Tcl commands act on these values as numbers, they are converted
+to a numeric representation for efficient handling in C code. Tcl makes
+use of three C types to store these representations: \fBdouble\fR,
+\fBTcl_WideInt\fR, and \fBmp_int\fR. The \fBdouble\fR type is provided by the
+C language standard. The \fBTcl_WideInt\fR type is declared in the Tcl
+header file, \fBtcl.h\fR, and is equivalent to the C standard type
+\fBlong long\fR on most platforms. The \fBmp_int\fR type is declared in the
+header file \fBtclTomMath.h\fR, and implemented by the LibTomMath
+multiple-precision integer library, included with Tcl.
+.PP
+The routines \fBTcl_GetNumber\fR and \fBTcl_GetNumberFromObj\fR perform
+the same function. They differ only in how the arguments present the Tcl
+value to be examined. \fBTcl_GetNumber\fR accepts a counted string
+value in the arguments \fIbytes\fR and \fInumBytes\fR (or a
+\fBNUL\fR-terminated string value when \fInumBytes\fR is
+\fBTCL_INDEX_NONE\fR). \fBTcl_GetNumberFromObj\fR accepts the Tcl value
+in \fIobjPtr\fR.
+.PP
+Both routines examine the Tcl value and determine whether Tcl recognizes
+it as a number. If not, both routines return \fBTCL_ERROR\fR and (when
+\fIinterp\fR is not NULL) record an error message and error code
+in \fIinterp\fR.
+.PP
+If Tcl does recognize the examined value as a number, both routines return
+\fBTCL_OK\fR, and use the pointer arguments \fIclientDataPtr\fR
+and \fItypePtr\fR (which may not be NULL) to report information the
+caller can use to retrieve the numeric representation. Both routines
+write to *\fIclientDataPtr\fR a pointer to the internal storage location
+where Tcl holds the converted numeric value.
+.PP
+When the converted numeric value is stored as a \fBdouble\fR,
+a call to math library routine \fBisnan\fR determines whether that
+value is not a number (NaN). If so, both \fBTcl_GetNumber\fR and
+\fBTcl_GetNumberFromObj\fR write the value \fBTCL_NUMBER_NAN\fR
+to *\fItypePtr\fR. If not, both routines write the value
+\fBTCL_NUMBER_DOUBLE\fR to *\fItypePtr\fR. These routines report
+different type values in these cases because \fBTcl_GetDoubleFromObj\fR
+raises an error on NaN values. For both reported type values,
+the storage pointer may be cast to type \fBconst double *\fR and
+the \fBdouble\fR numeric value may be read through it.
+.PP
+When the converted numeric value is stored as a \fBTcl_WideInt\fR,
+both \fBTcl_GetNumber\fR and \fBTcl_GetNumberFromObj\fR write the
+value \fBTCL_NUMBER_INT\fR to *\fItypePtr\fR.
+The storage pointer may be cast to type \fBconst Tcl_WideInt *\fR and
+the \fBTcl_WideInt\fR numeric value may be read through it.
+.PP
+When the converted numeric value is stored as an \fBmp_int\fR,
+both \fBTcl_GetNumber\fR and \fBTcl_GetNumberFromObj\fR write the
+value \fBTCL_NUMBER_BIG\fR to *\fItypePtr\fR.
+The storage pointer may be cast to type \fBconst mp_int *\fR and
+the \fBmp_int\fR numeric value may be read through it.
+.PP
+Future releases of Tcl might expand or revise the recognition of
+values as numbers. If additional storage representations are
+adopted, these routines will add new values to be written to
+*\fItypePtr\fR to identify them. Callers should consider how
+they should react to unknown values written to *\fItypePtr\fR.
+.PP
+When callers of these routines read numeric values through the
+reported storage pointer, they are accessing memory that belongs
+to the Tcl library. The Tcl library has the power to overwrite
+or free this memory. The storage pointer reported by a call to
+\fBTcl_GetNumber\fR or \fBTcl_GetNumberFromObj\fR should not be
+used after the same thread has possibly returned control to the
+Tcl library. If longer term access to the numeric value is needed,
+it should be copied into memory controlled by the caller. Callers
+must not attempt to write through or free the storage pointer.
+.SH "SEE ALSO"
+Tcl_GetDouble, Tcl_GetDoubleFromObj, Tcl_GetWideIntFromObj
+.SH KEYWORDS
+double, double value, double type, integer, integer value, integer type,
+internal representation, value, value type, string representation
diff --git a/doc/glob.n b/doc/glob.n
index 8a3099e..80610f7 100644
--- a/doc/glob.n
+++ b/doc/glob.n
@@ -46,8 +46,8 @@ separators.
.TP
\fB\-nocomplain\fR
.
-Allows an empty list to be returned without error; without this
-switch an error is returned if the result list would be empty.
+Allows an empty list to be returned without error; This is the
+default behavior in Tcl 9.0, so this switch has no effect any more.
.TP
\fB\-path\fR \fIpathPrefix\fR
.
diff --git a/doc/source.n b/doc/source.n
index 8757cb8..cee1312 100644
--- a/doc/source.n
+++ b/doc/source.n
@@ -37,9 +37,7 @@ allowing for files containing code and data segments (scripted documents).
If you require a
.QW ^Z
in code for string comparison, you can use
-.QW \e032
-or
-.QW \eu001a ,
+.QW \ex1A ,
which will be safely substituted by the Tcl interpreter into
.QW ^Z .
.PP
diff --git a/doc/tclsh.1 b/doc/tclsh.1
index 8dbacc0..3a78737 100644
--- a/doc/tclsh.1
+++ b/doc/tclsh.1
@@ -38,15 +38,11 @@ read Tcl commands from the named file; \fBtclsh\fR will exit
when it reaches the end of the file.
The end of the file may be marked either by the physical end of
the medium, or by the character,
-.QW \e032
-.PQ \eu001a ", control-Z" .
+.PQ \ex1A ", control-Z" .
If this character is present in the file, the \fBtclsh\fR application
will read text up to but not including the character. An application
that requires this character in the file may safely encode it as
-.QW \e032 ,
-.QW \ex1A ,
-or
-.QW \eu001a ;
+.QW \ex1A ;
or may generate it by use of commands such as \fBformat\fR or \fBbinary\fR.
There is no automatic evaluation of \fB.tclshrc\fR when the name
of a script file is presented on the \fBtclsh\fR command
diff --git a/generic/regc_lex.c b/generic/regc_lex.c
index 57ba8d5..d28e582 100644
--- a/generic/regc_lex.c
+++ b/generic/regc_lex.c
@@ -775,7 +775,7 @@ lexescape(
NOTE(REG_UNONPOSIX);
switch (c) {
case CHR('a'):
- RETV(PLAIN, chrnamed(v, alert, ENDOF(alert), CHR('\007')));
+ RETV(PLAIN, chrnamed(v, alert, ENDOF(alert), CHR('\x07')));
break;
case CHR('A'):
RETV(SBEGIN, 0);
@@ -803,7 +803,7 @@ lexescape(
break;
case CHR('e'):
NOTE(REG_UUNPORT);
- RETV(PLAIN, chrnamed(v, esc, ENDOF(esc), CHR('\033')));
+ RETV(PLAIN, chrnamed(v, esc, ENDOF(esc), CHR('\x1B')));
break;
case CHR('f'):
RETV(PLAIN, CHR('\f'));
diff --git a/generic/regc_locale.c b/generic/regc_locale.c
index 8bca0b7..7252b88 100644
--- a/generic/regc_locale.c
+++ b/generic/regc_locale.c
@@ -16,49 +16,49 @@ static const struct cname {
const char *name;
const char code;
} cnames[] = {
- {"NUL", '\0'},
- {"SOH", '\001'},
- {"STX", '\002'},
- {"ETX", '\003'},
- {"EOT", '\004'},
- {"ENQ", '\005'},
- {"ACK", '\006'},
- {"BEL", '\007'},
- {"alert", '\007'},
- {"BS", '\010'},
- {"backspace", '\b'},
- {"HT", '\011'},
- {"tab", '\t'},
- {"LF", '\012'},
- {"newline", '\n'},
- {"VT", '\013'},
- {"vertical-tab", '\v'},
- {"FF", '\014'},
- {"form-feed", '\f'},
- {"CR", '\015'},
- {"carriage-return", '\r'},
- {"SO", '\016'},
- {"SI", '\017'},
- {"DLE", '\020'},
- {"DC1", '\021'},
- {"DC2", '\022'},
- {"DC3", '\023'},
- {"DC4", '\024'},
- {"NAK", '\025'},
- {"SYN", '\026'},
- {"ETB", '\027'},
- {"CAN", '\030'},
- {"EM", '\031'},
- {"SUB", '\032'},
- {"ESC", '\033'},
- {"IS4", '\034'},
- {"FS", '\034'},
- {"IS3", '\035'},
- {"GS", '\035'},
- {"IS2", '\036'},
- {"RS", '\036'},
- {"IS1", '\037'},
- {"US", '\037'},
+ {"NUL", '\x00'},
+ {"SOH", '\x01'},
+ {"STX", '\x02'},
+ {"ETX", '\x03'},
+ {"EOT", '\x04'},
+ {"ENQ", '\x05'},
+ {"ACK", '\x06'},
+ {"BEL", '\x07'},
+ {"alert", '\x07'},
+ {"BS", '\x08'},
+ {"backspace", '\x08'},
+ {"HT", '\x09'},
+ {"tab", '\x09'},
+ {"LF", '\x0A'},
+ {"newline", '\x0A'},
+ {"VT", '\x0B'},
+ {"vertical-tab", '\x0B'},
+ {"FF", '\x0C'},
+ {"form-feed", '\x0C'},
+ {"CR", '\x0D'},
+ {"carriage-return", '\x0D'},
+ {"SO", '\x0E'},
+ {"SI", '\x0F'},
+ {"DLE", '\x10'},
+ {"DC1", '\x11'},
+ {"DC2", '\x12'},
+ {"DC3", '\x13'},
+ {"DC4", '\x14'},
+ {"NAK", '\x15'},
+ {"SYN", '\x16'},
+ {"ETB", '\x17'},
+ {"CAN", '\x18'},
+ {"EM", '\x19'},
+ {"SUB", '\x1A'},
+ {"ESC", '\x1B'},
+ {"IS4", '\x1C'},
+ {"FS", '\x1C'},
+ {"IS3", '\x1D'},
+ {"GS", '\x1D'},
+ {"IS2", '\x1E'},
+ {"RS", '\x1E'},
+ {"IS1", '\x1F'},
+ {"US", '\x1F'},
{"space", ' '},
{"exclamation-mark",'!'},
{"quotation-mark", '"'},
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 815b89b..23dc4af 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2591,7 +2591,15 @@ declare 679 {
void *clientData, size_t objc, Tcl_Obj *const objv[])
}
-# slot 680 and 681 are reserved for TIP #638
+# TIP #638.
+declare 680 {
+ int Tcl_GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ void **clientDataPtr, int *typePtr)
+}
+declare 681 {
+ int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes, size_t numBytes,
+ void **clientDataPtr, int *typePtr)
+}
# TIP #220.
declare 682 {
diff --git a/generic/tcl.h b/generic/tcl.h
index 1d2c5be..e63a4a9 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -814,6 +814,20 @@ typedef struct Tcl_DString {
#define TCL_INTEGER_SPACE (3*(int)sizeof(Tcl_WideInt))
/*
+ *----------------------------------------------------------------------------
+ * Type values returned by Tcl_GetNumberFromObj
+ * TCL_NUMBER_INT Representation is a Tcl_WideInt
+ * TCL_NUMBER_BIG Representation is an mp_int
+ * TCL_NUMBER_DOUBLE Representation is a double
+ * TCL_NUMBER_NAN Value is NaN.
+ */
+
+#define TCL_NUMBER_INT 2
+#define TCL_NUMBER_BIG 3
+#define TCL_NUMBER_DOUBLE 4
+#define TCL_NUMBER_NAN 5
+
+/*
* Flag values passed to Tcl_ConvertElement.
* TCL_DONT_USE_BRACES forces it not to enclose the element in braces, but to
* use backslash quoting instead.
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
index d88c8ed..793c426 100755
--- a/generic/tclArithSeries.c
+++ b/generic/tclArithSeries.c
@@ -232,7 +232,7 @@ assignNumber(int useDoubles, Tcl_WideInt *intNumberPtr, double *dblNumberPtr, Tc
void *clientData;
int tcl_number_type;
- if (TclGetNumberFromObj(NULL, numberObj, &clientData, &tcl_number_type) != TCL_OK
+ if (Tcl_GetNumberFromObj(NULL, numberObj, &clientData, &tcl_number_type) != TCL_OK
|| tcl_number_type == TCL_NUMBER_BIG) {
return;
}
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 21e5ade..5ab12d4 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -6507,7 +6507,7 @@ Tcl_ExprLongObj(
return TCL_ERROR;
}
- if (TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type)!=TCL_OK) {
+ if (Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type)!=TCL_OK) {
return TCL_ERROR;
}
@@ -6553,7 +6553,7 @@ Tcl_ExprDoubleObj(
return TCL_ERROR;
}
- result = TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type);
+ result = Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type);
if (result == TCL_OK) {
switch (type) {
case TCL_NUMBER_NAN:
@@ -7120,7 +7120,7 @@ ExprIsqrtFunc(
* Make sure that the arg is a number.
*/
- if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+ if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
@@ -7383,7 +7383,7 @@ ExprAbsFunc(
return TCL_ERROR;
}
- if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+ if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
@@ -7538,7 +7538,7 @@ ExprIntFunc(
MathFuncWrongNumArgs(interp, 2, objc, objv);
return TCL_ERROR;
}
- if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+ if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
@@ -7619,7 +7619,7 @@ ExprMaxMinFunc(
}
res = objv[1];
for (i = 1; i < objc; i++) {
- if (TclGetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) {
+ if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
if (type == TCL_NUMBER_NAN) {
@@ -7771,7 +7771,7 @@ ExprRoundFunc(
return TCL_ERROR;
}
- if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+ if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
@@ -8039,7 +8039,7 @@ ExprIsFiniteFunc(
return TCL_ERROR;
}
- if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+ if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
if (type != TCL_NUMBER_NAN) {
@@ -8070,7 +8070,7 @@ ExprIsInfinityFunc(
return TCL_ERROR;
}
- if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+ if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
if (type != TCL_NUMBER_NAN) {
@@ -8100,7 +8100,7 @@ ExprIsNaNFunc(
return TCL_ERROR;
}
- if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+ if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
if (type != TCL_NUMBER_NAN) {
@@ -8130,7 +8130,7 @@ ExprIsNormalFunc(
return TCL_ERROR;
}
- if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+ if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
if (type != TCL_NUMBER_NAN) {
@@ -8160,7 +8160,7 @@ ExprIsSubnormalFunc(
return TCL_ERROR;
}
- if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+ if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
if (type != TCL_NUMBER_NAN) {
@@ -8190,7 +8190,7 @@ ExprIsUnorderedFunc(
return TCL_ERROR;
}
- if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+ if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
if (type == TCL_NUMBER_NAN) {
@@ -8200,7 +8200,7 @@ ExprIsUnorderedFunc(
result = (ClassifyDouble(d) == FP_NAN);
}
- if (TclGetNumberFromObj(interp, objv[2], &ptr, &type) != TCL_OK) {
+ if (Tcl_GetNumberFromObj(interp, objv[2], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
if (type == TCL_NUMBER_NAN) {
@@ -8232,7 +8232,7 @@ FloatClassifyObjCmd(
return TCL_ERROR;
}
- if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+ if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
return TCL_ERROR;
}
if (type == TCL_NUMBER_NAN) {
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 9011469..3e297f6 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -4086,7 +4086,7 @@ SequenceIdentifyArgument(
SequenceByMode bymode;
void *clientData;
- status = TclGetNumberFromObj(NULL, argPtr, &clientData, keywordIndexPtr);
+ status = Tcl_GetNumberFromObj(NULL, argPtr, &clientData, keywordIndexPtr);
if (status == TCL_OK) {
if (numValuePtr) {
*numValuePtr = argPtr;
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 7567e80..d0343d3 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1831,8 +1831,14 @@ EXTERN Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp,
EXTERN int Tcl_NRCallObjProc2(Tcl_Interp *interp,
Tcl_ObjCmdProc2 *objProc2, void *clientData,
size_t objc, Tcl_Obj *const objv[]);
-/* Slot 680 is reserved */
-/* Slot 681 is reserved */
+/* 680 */
+EXTERN int Tcl_GetNumberFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, void **clientDataPtr,
+ int *typePtr);
+/* 681 */
+EXTERN int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes,
+ size_t numBytes, void **clientDataPtr,
+ int *typePtr);
/* 682 */
EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp,
Tcl_Channel chan, int mode);
@@ -2527,8 +2533,8 @@ typedef struct TclStubs {
Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */
Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */
int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */
- void (*reserved680)(void);
- void (*reserved681)(void);
+ int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */
+ int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */
int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */
} TclStubs;
@@ -3842,8 +3848,10 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_NRCreateCommand2) /* 678 */
#define Tcl_NRCallObjProc2 \
(tclStubsPtr->tcl_NRCallObjProc2) /* 679 */
-/* Slot 680 is reserved */
-/* Slot 681 is reserved */
+#define Tcl_GetNumberFromObj \
+ (tclStubsPtr->tcl_GetNumberFromObj) /* 680 */
+#define Tcl_GetNumber \
+ (tclStubsPtr->tcl_GetNumber) /* 681 */
#define Tcl_RemoveChannelMode \
(tclStubsPtr->tcl_RemoveChannelMode) /* 682 */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 4b9ed0d..444f9aa 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -445,7 +445,7 @@ VarHashCreateVar(
/*
* Macro used in this file to save a function call for common uses of
- * TclGetNumberFromObj(). The ANSI C "prototype" is:
+ * Tcl_GetNumberFromObj(). The ANSI C "prototype" is:
*
* MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
* void **ptrPtr, int *tPtr);
@@ -464,7 +464,7 @@ VarHashCreateVar(
(&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \
? TCL_ERROR : \
- TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
+ Tcl_GetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
/*
* Macro used to make the check for type overflow more mnemonic. This works by
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 2628e41..040f0fd 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -41,7 +41,6 @@ static int TclGlob(Tcl_Interp *interp, char *pattern,
/* Flag values used by TclGlob() */
-#define TCL_GLOBMODE_NO_COMPLAIN 1
#define TCL_GLOBMODE_DIR 4
#define TCL_GLOBMODE_TAILS 8
@@ -1164,7 +1163,10 @@ Tcl_GlobObjCmd(
switch (index) {
case GLOB_NOCOMPLAIN: /* -nocomplain */
- globFlags |= TCL_GLOBMODE_NO_COMPLAIN;
+ /*
+ * Do nothing; This is normal operations in Tcl 9.
+ * Keep accepting as a no-op option to accommodate old scripts.
+ */
break;
case GLOB_DIR: /* -dir */
if (i == (objc-1)) {
@@ -1522,41 +1524,6 @@ Tcl_GlobObjCmd(
}
}
- if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) {
- if (TclListObjLengthM(interp, Tcl_GetObjResult(interp),
- &length) != TCL_OK) {
- /*
- * This should never happen. Maybe we should be more dramatic.
- */
-
- result = TCL_ERROR;
- goto endOfGlob;
- }
-
- if (length == 0) {
- Tcl_Obj *errorMsg =
- Tcl_ObjPrintf("no files matched glob pattern%s \"",
- (join || (objc == 1)) ? "" : "s");
-
- if (join) {
- Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1);
- } else {
- const char *sep = "";
-
- for (i = 0; i < objc; i++) {
- Tcl_AppendPrintfToObj(errorMsg, "%s%s",
- sep, TclGetString(objv[i]));
- sep = " ";
- }
- }
- Tcl_AppendToObj(errorMsg, "\"", -1);
- Tcl_SetObjResult(interp, errorMsg);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
- NULL);
- result = TCL_ERROR;
- }
- }
-
endOfGlob:
if (join || (dir == PATH_GENERAL)) {
Tcl_DStringFree(&prefix);
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 2e821a7..23b860a 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8186,7 +8186,7 @@ Tcl_SetChannelOption(
int inValue = (int) argv[0][0];
int outValue = (argc == 2) ? (int) argv[1][0] : 0;
- if (inValue & 0x80 || outValue) {
+ if (inValue & 0x80 || (inValue && argv[0][1]) || outValue) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"bad value for -eofchar: must be non-NUL ASCII"
diff --git a/generic/tclInt.h b/generic/tclInt.h
index a876f37..ad21b66 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2845,17 +2845,6 @@ typedef struct ProcessGlobalValue {
/* Reject underscore digit separator */
/*
- *----------------------------------------------------------------------
- * Type values TclGetNumberFromObj
- *----------------------------------------------------------------------
- */
-
-#define TCL_NUMBER_INT 2
-#define TCL_NUMBER_BIG 3
-#define TCL_NUMBER_DOUBLE 4
-#define TCL_NUMBER_NAN 5
-
-/*
*----------------------------------------------------------------
* Variables shared among Tcl modules but not used by the outside world.
*----------------------------------------------------------------
@@ -3162,9 +3151,6 @@ MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp,
Tcl_Obj *value, int *code);
MODULE_SCOPE Proc * TclGetLambdaFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr);
-MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp,
- Tcl_Obj *objPtr, void **clientDataPtr,
- int *typePtr);
MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp,
const char *modeString, int *seekFlagPtr,
int *binaryPtr);
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 2649d12..8579f36 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -530,7 +530,7 @@ GetUWide(
void *clientData;
int type, intValue;
- if (TclGetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) {
+ if (Tcl_GetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) {
if (type == TCL_NUMBER_INT) {
*widePtr = *((const Tcl_WideInt *) clientData);
return (*widePtr < 0);
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 5e55784..93cfcd1 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -3451,7 +3451,7 @@ TclSetBignumInternalRep(
/*
*----------------------------------------------------------------------
*
- * TclGetNumberFromObj --
+ * Tcl_GetNumberFromObj --
*
* Extracts a number (of any possible numeric type) from an object.
*
@@ -3469,7 +3469,7 @@ TclSetBignumInternalRep(
*/
int
-TclGetNumberFromObj(
+Tcl_GetNumberFromObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
void **clientDataPtr,
@@ -3504,6 +3504,42 @@ TclGetNumberFromObj(
TclParseNumber(interp, objPtr, "number", NULL, -1, NULL, 0));
return TCL_ERROR;
}
+
+int
+Tcl_GetNumber(
+ Tcl_Interp *interp,
+ const char *bytes,
+ size_t numBytes,
+ void **clientDataPtr,
+ int *typePtr)
+{
+ static Tcl_ThreadDataKey numberCacheKey;
+ Tcl_Obj *objPtr = (Tcl_Obj *)Tcl_GetThreadData(&numberCacheKey,
+ sizeof(Tcl_Obj));
+
+ Tcl_FreeInternalRep(objPtr);
+
+ if (bytes == NULL) {
+ bytes = &tclEmptyString;
+ numBytes = 0;
+ }
+ if (numBytes == (size_t)TCL_INDEX_NONE) {
+ numBytes = strlen(bytes);
+ }
+ if (numBytes > INT_MAX) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "max size for a Tcl value (%d bytes) exceeded", INT_MAX));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ objPtr->bytes = (char *) bytes;
+ objPtr->length = numBytes;
+
+ return Tcl_GetNumberFromObj(interp, objPtr, clientDataPtr, typePtr);
+}
/*
*----------------------------------------------------------------------
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index ec83355..18ef6d4 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -1476,8 +1476,8 @@ const TclStubs tclStubs = {
Tcl_CreateObjTrace2, /* 677 */
Tcl_NRCreateCommand2, /* 678 */
Tcl_NRCallObjProc2, /* 679 */
- 0, /* 680 */
- 0, /* 681 */
+ Tcl_GetNumberFromObj, /* 680 */
+ Tcl_GetNumber, /* 681 */
Tcl_RemoveChannelMode, /* 682 */
};
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 5870781..1ac2b31 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -3336,7 +3336,7 @@ GetWideForIndex(
{
int numType;
void *cd;
- int code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);
+ int code = Tcl_GetNumberFromObj(NULL, objPtr, &cd, &numType);
if (code == TCL_OK) {
if (numType == TCL_NUMBER_INT) {
@@ -3498,7 +3498,7 @@ GetEndOffsetFromObj(
/* ... value continues with [-+] ... */
/* Save first integer as wide if possible */
- TclGetNumberFromObj(NULL, objPtr, &cd, &t1);
+ Tcl_GetNumberFromObj(NULL, objPtr, &cd, &t1);
if (t1 == TCL_NUMBER_INT) {
w1 = (*(Tcl_WideInt *)cd);
}
@@ -3508,7 +3508,7 @@ GetEndOffsetFromObj(
/* ... value concludes with second valid integer */
/* Save second integer as wide if possible */
- TclGetNumberFromObj(NULL, objPtr, &cd, &t2);
+ Tcl_GetNumberFromObj(NULL, objPtr, &cd, &t2);
if (t2 == TCL_NUMBER_INT) {
w2 = (*(Tcl_WideInt *)cd);
}
@@ -3561,7 +3561,7 @@ GetEndOffsetFromObj(
Tcl_ExprObj(compute, objPtr, &sum);
Tcl_DeleteInterp(compute);
}
- TclGetNumberFromObj(NULL, sum, &cd, &numType);
+ Tcl_GetNumberFromObj(NULL, sum, &cd, &numType);
if (numType == TCL_NUMBER_INT) {
/* sum holds an integer in the signed wide range */
@@ -3612,7 +3612,7 @@ GetEndOffsetFromObj(
}
/* Got an integer offset; pull it from where parser left it. */
- TclGetNumberFromObj(NULL, objPtr, &cd, &t);
+ Tcl_GetNumberFromObj(NULL, objPtr, &cd, &t);
if (t == TCL_NUMBER_BIG) {
/* Truncate to the signed wide range. */
diff --git a/library/auto.tcl b/library/auto.tcl
index 0d30011..5baaf04 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -302,7 +302,7 @@ proc auto_mkindex_old {dir args} {
set f ""
set error [catch {
set f [open $file]
- fconfigure $f -encoding utf-8 -eofchar "\032 {}"
+ fconfigure $f -encoding utf-8 -eofchar "\x1A {}"
while {[gets $f line] >= 0} {
if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} {
set procName [lindex [auto_qualify $procName "::"] 0]
@@ -414,7 +414,7 @@ proc auto_mkindex_parser::mkindex {file} {
set scriptFile $file
set fid [open $file]
- fconfigure $fid -encoding utf-8 -eofchar "\032 {}"
+ fconfigure $fid -encoding utf-8 -eofchar "\x1A {}"
set contents [read $fid]
close $fid
diff --git a/library/init.tcl b/library/init.tcl
index d2e3624..2962dbd 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -450,7 +450,7 @@ proc auto_load_index {} {
continue
} else {
set error [catch {
- fconfigure $f -encoding utf-8 -eofchar "\032 {}"
+ fconfigure $f -encoding utf-8 -eofchar "\x1A {}"
set id [gets $f]
if {$id eq "# Tcl autoload index file, version 2.0"} {
eval [read $f]
diff --git a/library/package.tcl b/library/package.tcl
index 5f0795f..0c4aa29 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -137,6 +137,9 @@ proc pkg_mkIndex {args} {
} on error {msg opt} {
return -options $opt $msg
}
+ if {[llength $fileList] == 0} {
+ return -code error "no files matched glob pattern \"$patternList\""
+ }
foreach file $fileList {
# For each file, figure out what commands and packages it provides.
# To do this, create a child interpreter, load the file into the
diff --git a/library/safe.tcl b/library/safe.tcl
index 0cf891e..287ee5c 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -975,7 +975,7 @@ proc ::safe::AliasSource {child args} {
set replacementMsg "script error"
set code [catch {
set f [open $realfile]
- fconfigure $f -encoding $encoding -eofchar "\032 {}"
+ fconfigure $f -encoding $encoding -eofchar "\x1A {}"
set contents [read $f]
close $f
::interp eval $child [list info script $file]
diff --git a/tests/chanio.test b/tests/chanio.test
index 2c1548d..c7cde60 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -5288,7 +5288,7 @@ test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup {
} -constraints {unix} -body {
set f1 [open $path(test1) w+]
lappend l [chan configure $f1 -eofchar]
- chan configure $f1 -eofchar {ON {}}
+ chan configure $f1 -eofchar {O {}}
lappend l [chan configure $f1 -eofchar]
chan configure $f1 -eofchar D
lappend l [chan configure $f1 -eofchar]
@@ -5300,7 +5300,7 @@ test chan-io-39.22a {Tcl_SetChannelOption, invariance} -setup {
set l [list]
} -body {
set f1 [open $path(test1) w+]
- chan configure $f1 -eofchar {ON {}}
+ chan configure $f1 -eofchar {O {}}
lappend l [chan configure $f1 -eofchar]
chan configure $f1 -eofchar D
lappend l [chan configure $f1 -eofchar]
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 811beb3..93793d1 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -829,12 +829,12 @@ test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup {
} -result {bad option "-tf1": must be -force or --}
test fCmd-7.5 {FileForceOption: multiple times through loop} -setup {
cleanup
-} -constraints {notRoot} -returnCodes error -body {
+} -constraints {notRoot} -body {
createfile --
createfile -force
file delete -force -force -- -- -force
glob -- -- -force
-} -result {no files matched glob patterns "-- -force"}
+} -result {}
test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
-constraints {unix notRoot knownBug tildeexpansion} -body {
@@ -994,9 +994,9 @@ test fCmd-9.10 {file rename: comprehensive: file to new name and dir} -setup {
testchmod 0o444 tf2
file rename tf1 [file join td1 tf3]
file rename tf2 [file join td1 tf4]
- list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \
+ list [glob tf*] [lsort [glob -directory td1 t*]] \
[file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
-} -result [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
+} -result [subst {{} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup {
cleanup
} -constraints {notRoot testchmod} -body {
diff --git a/tests/fileName.test b/tests/fileName.test
index c4735cb..416c419 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -701,9 +701,9 @@ test filename-10.24 {Tcl_TranslateFileName} -body {
testtranslatefilename ~ouster/foo
} -result {/home/ouster/foo} -constraints {nonPortable testtranslatefilename}
-test filename-11.1 {Tcl_GlobCmd} -returnCodes error -body {
+test filename-11.1 {Tcl_GlobCmd} -body {
glob
-} -result {no files matched glob patterns ""}
+} -result {}
test filename-11.2 {Tcl_GlobCmd} -returnCodes error -body {
glob -gorp
} -result {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}
@@ -717,19 +717,19 @@ test filename-11.5 {Tcl_GlobCmd} -body {
# Should not error out because of ~
catch {glob -nocomplain * ~xyqrszzz}
} -result 0
-test filename-11.6 {Tcl_GlobCmd} -returnCodes error -body {
+test filename-11.6 {Tcl_GlobCmd} -body {
glob ~xyqrszzz
-} -result {no files matched glob pattern "~xyqrszzz"}
-test filename-11.7 {Tcl_GlobCmd} -returnCodes error -body {
+} -result {}
+test filename-11.7 {Tcl_GlobCmd} -body {
glob -- -nocomplain
-} -result {no files matched glob pattern "-nocomplain"}
+} -result {}
test filename-11.8 {Tcl_GlobCmd} -body {
glob -nocomplain -- -nocomplain
} -result {}
test filename-11.9 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
testsetplatform unix
glob ~\\xyqrszzz/bar
-} -returnCodes error -result {no files matched glob pattern "~\xyqrszzz/bar"}
+} -result {}
test filename-11.10 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
testsetplatform unix
glob -nocomplain ~\\xyqrszzz/bar
@@ -737,22 +737,22 @@ test filename-11.10 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
test filename-11.11 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
testsetplatform unix
glob ~xyqrszzz\\/\\bar
-} -returnCodes error -result {no files matched glob pattern "~xyqrszzz\/\bar"}
+} -result {}
test filename-11.12 {Tcl_GlobCmd} -constraints {testsetplatform} -setup {
testsetplatform unix
set home $env(HOME)
} -body {
unset env(HOME)
glob ~/*
-} -returnCodes error -cleanup {
+} -cleanup {
set env(HOME) $home
-} -result {no files matched glob pattern "~/*"}
+} -result {}
if {[testConstraint testsetplatform]} {
testsetplatform $platform
}
test filename-11.13 {Tcl_GlobCmd} -body {
file join [lindex [glob ~] 0]
-} -returnCodes error -result {no files matched glob pattern "~"}
+} -result {}
set oldpwd [pwd]
set oldhome $env(HOME)
catch {cd [makeDirectory tcl[pid]]}
@@ -772,10 +772,10 @@ touch globTest/.1
touch globTest/x,z1.c
test filename-11.14 {Tcl_GlobCmd} -body {
glob ~/globTest
-} -returnCodes error -result {no files matched glob pattern "~/globTest"}
+} -result {}
test filename-11.15 {Tcl_GlobCmd} -body {
glob ~\\/globTest
-} -returnCodes error -result {no files matched glob pattern "~\/globTest"}
+} -result {}
test filename-11.16 {Tcl_GlobCmd} {
glob globTest
} {globTest}
@@ -1098,42 +1098,42 @@ file delete -force $tildeglobname
set globname globTest
unset horribleglobname tildeglobname
-test filename-12.1 {simple globbing} {unixOrWin} {
+test filename-12.1 {simple globbing} -constraints {unixOrWin} -body {
glob {}
-} {.}
+} -result {.}
test filename-12.1.1 {simple globbing} -constraints {unixOrWin} -body {
glob -types f {}
-} -returnCodes error -result {no files matched glob pattern ""}
-test filename-12.1.2 {simple globbing} {unixOrWin} {
+} -result {}
+test filename-12.1.2 {simple globbing} -constraints {unixOrWin} -body {
glob -types d {}
-} {.}
-test filename-12.1.3 {simple globbing} {unix} {
+} -result {.}
+test filename-12.1.3 {simple globbing} -constraints {unix} -body {
glob -types hidden {}
-} {.}
+} -result {.}
test filename-12.1.4 {simple globbing} -constraints {win} -body {
glob -types hidden {}
-} -returnCodes error -result {no files matched glob pattern ""}
+} -result {}
test filename-12.1.5 {simple globbing} -constraints {win} -body {
glob -types hidden c:/
-} -returnCodes error -result {no files matched glob pattern "c:/"}
-test filename-12.1.6 {simple globbing} {win} {
+} -result {}
+test filename-12.1.6 {simple globbing} -constraints {win} -body {
glob c:/
-} {c:/}
-test filename-12.3 {simple globbing} {
+} -result {c:/}
+test filename-12.3 {simple globbing} -body {
glob -nocomplain \{a1,a2\}
-} {}
+} -result {}
set globPreResult globTest/
set x1 x1.c
set y1 y1.c
-test filename-12.4 {simple globbing} {unixOrWin} {
+test filename-12.4 {simple globbing} -constraints {unixOrWin} -body {
lsort [glob globTest/x1.c globTest/y1.c globTest/foo]
-} "$globPreResult$x1 $globPreResult$y1"
-test filename-12.5 {simple globbing} {
+} -result "$globPreResult$x1 $globPreResult$y1"
+test filename-12.5 {simple globbing} -body {
glob globTest\\/x1.c
-} "$globPreResult$x1"
-test filename-12.6 {simple globbing} {
+} -result "$globPreResult$x1"
+test filename-12.6 {simple globbing} -body {
glob globTest\\/\\x1.c
-} "$globPreResult$x1"
+} -result "$globPreResult$x1"
test filename-12.7 {globbing at filesystem root} -constraints {unix} -body {
list [glob -nocomplain /*] [glob -path / *]
} -match compareWords -result equal
@@ -1265,10 +1265,10 @@ test filename-14.20 {asterisks, question marks, and brackets} {
} {}
test filename-14.21 {asterisks, question marks, and brackets} -body {
glob globTest/*/gorp
-} -returnCodes error -result {no files matched glob pattern "globTest/*/gorp"}
+} -result {}
test filename-14.22 {asterisks, question marks, and brackets} -body {
glob goo/* x*z foo?q
-} -returnCodes error -result {no files matched glob patterns "goo/* x*z foo?q"}
+} -result {}
test filename-14.23 {slash globbing} {unix} {
glob /
} /
@@ -1368,7 +1368,7 @@ test filename-15.5 {unix specific globbing} {unix nonPortable} {
# supported, the test was meaningless
test filename-15.7 {glob tilde} -body {
glob ~
-} -returnCodes error -result {no files matched glob pattern "~"}
+} -result {}
test filename-15.8 {win and unix specific globbing} -constraints {unixOrWin} -setup {
global env
set temp $env(HOME)
@@ -1379,7 +1379,7 @@ test filename-15.8 {win and unix specific globbing} -constraints {unixOrWin} -se
} -cleanup {
set env(HOME) $temp
catch {file delete -force $env(HOME)/globTest/anyname}
-} -returnCodes error -result {no files matched glob pattern "~"}
+} -result {}
# The following tests are only valid for Windows systems.
set oldDir [pwd]
diff --git a/tests/io.test b/tests/io.test
index 1047376..0db2e9a 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -5761,7 +5761,7 @@ test io-39.22 {Tcl_SetChannelOption, invariance} {unix} {
set f1 [open $path(test1) w+]
set l ""
lappend l [fconfigure $f1 -eofchar]
- fconfigure $f1 -eofchar {ON {}}
+ fconfigure $f1 -eofchar {O {}}
lappend l [fconfigure $f1 -eofchar]
fconfigure $f1 -eofchar D
lappend l [fconfigure $f1 -eofchar]
@@ -5772,7 +5772,7 @@ test io-39.22a {Tcl_SetChannelOption, invariance} {
file delete $path(test1)
set f1 [open $path(test1) w+]
set l [list]
- fconfigure $f1 -eofchar {ON {}}
+ fconfigure $f1 -eofchar {O {}}
lappend l [fconfigure $f1 -eofchar]
fconfigure $f1 -eofchar D
lappend l [fconfigure $f1 -eofchar]
diff --git a/tests/winFile.test b/tests/winFile.test
index 38f6954..231fb3f 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -28,7 +28,7 @@ testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
test winFile-1.1 {TclpGetUserHome} -constraints {win} -body {
glob ~nosuchuser
-} -returnCodes error -result {no files matched glob pattern "~nosuchuser"}
+} -result {}
test winFile-1.2 {TclpGetUserHome} -constraints {win nonPortable} -body {
# The administrator account should always exist.
glob ~administrator
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index 282abcc..89e4ccc 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -257,7 +257,7 @@ proc genStubs::rewriteFile {file text} {
return
}
set in [open ${file} r]
- fconfigure $in -eofchar "\032 {}" -encoding utf-8
+ fconfigure $in -eofchar "\x1A {}" -encoding utf-8
set out [open ${file}.new w]
fconfigure $out -translation lf -encoding utf-8