Tcl Source Code

.TH expr n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
expr \- Evaluate an expression
.SH SYNOPSIS
\fBexpr \fIarg \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
The \fIexpr\fR command concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates
that expression, returning its value.
The operators permitted in an expression include a subset of
the operators permitted in C expressions.  For those operators
common to both Tcl and C, Tcl applies the same meaning and precedence
as the corresponding C operators.
The value of an expression is often a numeric result, either an integer or a
floating-point value, but may also be a non-numeric value.
For example, the expression
.PP
.CS
\fBexpr\fR 8.2 + 6
.CE
.PP
evaluates to 14.2.
Expressions differ from C expressions in the way that
operands are specified.  Expressions also support
non-numeric operands, string comparisons, and some
additional operators not found in C.
.PP
When an expression evaluates to an integer, the value is the decimal form of
the integer, and when an expression evaluates to a floating-point number, the
value is the form produced by the \fB%g\fR format specifier of Tcl's
\fBformat\fR command.







.SS OPERANDS
.PP
An expression consists of a combination of operands, operators, parentheses and
commas, possibly with whitespace between any of these elements, which is
ignored.
.PP
An operand may be specified in any of the following ways:
................................................................................
.PP
Below are some examples of simple expressions where the value of \fBa\fR is 3
and the value of \fBb\fR is 6.  The command on the left side of each line
produces the value on the right side.
.PP
.CS
.ta 9c
\fBexpr\fR 3.1 + $a	\fI6.1\fR
\fBexpr\fR 2 + "$a.$b"	\fI5.6\fR
\fBexpr\fR 4*[llength "6 2"]	\fI8\fR
\fBexpr\fR {{word one} < "word $a"}	\fI0\fR
.CE
.PP
\fBInteger value\fR
.PP
An integer operand may be specified in decimal (the normal case, the optional
first two characters are \fB0d\fR), binary
................................................................................
.PP
As in C, \fB&&\fR, \fB||\fR, and \fB?:\fR feature
.QW "lazy evaluation" ,
which means that operands are not evaluated if they are
not needed to determine the outcome.  For example, in
.PP
.CS
\fBexpr\fR {$v ? [a] : [b]}
.CE
.PP
only one of \fB[a]\fR or \fB[b]\fR is evaluated,
depending on the value of \fB$v\fR.  This is not true of the normal Tcl parser,
so it is normally recommended to enclose the arguments to \fBexpr\fR in braces.
Without braces, as in
\fBexpr\fR $v ? [a] : [b]
both \fB[a]\fR and \fB[b]\fR are evaluated before \fBexpr\fR is even called.
.PP
For more details on the results
produced by each operator, see the documentation for C.
.SS "MATH FUNCTIONS"
.PP
A mathematical function such as \fBsin($x)\fR is replaced with a call to an ordinary
................................................................................
.CE
.PP
both return 1.25.
A floating-point result can be distinguished from an integer result by the
presence of either
.QW \fB.\fR
or
.QW \fBe\fR
.PP
. For example,
.PP
.CS
\fBexpr\fR {20.0/5.0}
.CE
.PP
returns \fB4.0\fR, not \fB4\fR.
.SH "PERFORMANCE CONSIDERATIONS"
.PP
Where an expression contains syntax that Tcl would otherwise perform
substitutions on, enclosing an expression in braces or otherwise quoting it
so that it's a static value allows the Tcl compiler to generate bytecode for
the expression, resulting in better speed and smaller storage requirements.
This also avoids issues that can arise if Tcl is allowed to perform
substitution on the value before \fBexpr\fR is called.
.PP
In the following example, the value of the expression is 11 because the Tcl parser first
substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR as part
of evaluating the expression
.QW "$a + 2*4" .
Enclosing the
expression in braces would result in a syntax error as \fB$b\fR does
not evaluate to a numeric value.
.PP
.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b*4
................................................................................
Most expressions are not formed at runtime, but are literal strings or contain
substitutions that don't introduce other substitutions.  To allow the bytecode
compiler to work with an expression as a string literal at compilation time,
ensure that it contains no substitutions or that it is enclosed in braces or
otherwise quoted to prevent Tcl from performing substitutions, allowing
\fBexpr\fR to perform them instead.
.PP
If it is necessary to include a non-constant expression string within the
wider context of an otherwise-constant expression, the most efficient
technique is to put the varying part inside a recursive \fBexpr\fR, as this at
least allows for the compilation of the outer part, though it does mean that
the varying part must itself be evaluated as a separate expression. Thus, in
this example the result is 20 and the outer expression benefits from fully
cached bytecode compilation.




.PP










.CS
set a 3
set b {$a + 2}



























\fBexpr\fR {[\fBexpr\fR $b] * 4}
.CE
.PP
In general, you should enclose your expression in braces wherever possible,
and where not possible, the argument to \fBexpr\fR should be an expression
defined elsewhere as simply as possible. It is usually more efficient and
safer to use other techniques (e.g., the commands in the \fBtcl::mathop\fR
namespace) than it is to do complex expression generation.







.SH EXAMPLES
.PP
A numeric comparison whose result is 1:
.PP
.CS
\fBexpr\fR {"0x03" > "2"}
.CE
................................................................................
.nf
Copyright \(co 1993 The Regents of the University of California.
Copyright \(co 1994-2000 Sun Microsystems Incorporated.
Copyright \(co 2005 by Kevin B. Kenny <[email protected]>. All rights reserved.
.fi
'\" Local Variables:
'\" mode: nroff

'\" End:

.TH expr n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
expr \- Evaluate an expression
.SH SYNOPSIS
\fBexpr \fIexpression\fR
.BE
.SH DESCRIPTION
.PP
Evaluates the expression, \fIexpression\fR, returning its value.

The operators permitted in an expression include a subset of
the operators permitted in C expressions.  For those operators
common to both Tcl and C, Tcl applies the same meaning and precedence
as the corresponding C operators.
The value of an expression is often a numeric result, either an integer or a
floating-point value, but may also be a non-numeric value.
For example, the expression
.PP
.CS
\fBexpr\fR {8.2 + 6}
.CE
.PP
evaluates to 14.2.
Expressions differ from C expressions in the way that
operands are specified.  Expressions also support
non-numeric operands, string comparisons, and some
additional operators not found in C.
.PP
When an expression evaluates to an integer, the value is the decimal form of
the integer, and when an expression evaluates to a floating-point number, the
value is the form produced by the \fB%g\fR format specifier of Tcl's
\fBformat\fR command.
.PP
.VS "9.0, TIP 526"
Unlike with prior versions of Tcl, from Tcl 9.0 onwards, the \fBexpr\fR
command only accepts a single argument instead of concatenating an arbitrary
number of arguments to form an expression.
See \fBCOMPATIBILITY WITH TCL 8.*\fR below for details.
.VE "9.0, TIP 526"
.SS OPERANDS
.PP
An expression consists of a combination of operands, operators, parentheses and
commas, possibly with whitespace between any of these elements, which is
ignored.
.PP
An operand may be specified in any of the following ways:
................................................................................
.PP
Below are some examples of simple expressions where the value of \fBa\fR is 3
and the value of \fBb\fR is 6.  The command on the left side of each line
produces the value on the right side.
.PP
.CS
.ta 9c
\fBexpr\fR {3.1 + $a}	\fI6.1\fR
\fBexpr\fR {2 + "$a.$b"}	\fI5.6\fR
\fBexpr\fR {4*[llength "6 2"]}	\fI8\fR
\fBexpr\fR {{word one} < "word $a"}	\fI0\fR
.CE
.PP
\fBInteger value\fR
.PP
An integer operand may be specified in decimal (the normal case, the optional
first two characters are \fB0d\fR), binary
................................................................................
.PP
As in C, \fB&&\fR, \fB||\fR, and \fB?:\fR feature
.QW "lazy evaluation" ,
which means that operands are not evaluated if they are
not needed to determine the outcome.  For example, in
.PP
.CS
\fBexpr\fR {$v?[a]:[b]}
.CE
.PP
only one of \fB[a]\fR or \fB[b]\fR is evaluated,
depending on the value of \fB$v\fR.  This is not true of the normal Tcl parser,
so it is normally recommended to enclose the arguments to \fBexpr\fR in braces.
Without braces, as in
\fBexpr\fR $v?[a]:[b]
both \fB[a]\fR and \fB[b]\fR are evaluated before \fBexpr\fR is even called.
.PP
For more details on the results
produced by each operator, see the documentation for C.
.SS "MATH FUNCTIONS"
.PP
A mathematical function such as \fBsin($x)\fR is replaced with a call to an ordinary
................................................................................
.CE
.PP
both return 1.25.
A floating-point result can be distinguished from an integer result by the
presence of either
.QW \fB.\fR
or
.QW \fBe\fR .
.PP
For example,
.PP
.CS
\fBexpr\fR {20.0/5.0}
.CE
.PP
returns \fB4.0\fR, not \fB4\fR.
.SH "PERFORMANCE AND COMPATIBILITY"
.PP
Where an expression contains syntax that Tcl would otherwise perform
substitutions on, enclosing an expression in braces or otherwise quoting it
so that it's a static value allows the Tcl compiler to generate bytecode for
the expression, resulting in better speed and smaller storage requirements.
This also avoids issues that can arise if Tcl is allowed to perform
substitution on the value before \fBexpr\fR is called.
.PP
In the following example, the value of the expression is 11 because the Tcl parser first
substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR as part
of evaluating the expression
.QW "$a + 2*4" .
Simply enclosing the
expression in braces would result in a syntax error as \fB$b\fR does
not evaluate to a numeric value.
.PP
.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b*4
................................................................................
Most expressions are not formed at runtime, but are literal strings or contain
substitutions that don't introduce other substitutions.  To allow the bytecode
compiler to work with an expression as a string literal at compilation time,
ensure that it contains no substitutions or that it is enclosed in braces or
otherwise quoted to prevent Tcl from performing substitutions, allowing
\fBexpr\fR to perform them instead.
.PP
In general, you should enclose your expression in braces wherever possible,
and where not possible, the argument to \fBexpr\fR should be an expression
defined elsewhere as simply as possible. It is usually more efficient and
safer to use other techniques (e.g., the commands in the \fBtcl::mathop\fR
namespace) than it is to do complex expression generation. Storing a
complex expression in a variable and using that with \fBexpr\fR is a
case which the bytecode compiler also supports well, provided that
expression is always evaluated in the same stack context (though the
expression could be conveyed across procedure calls and through
\fBuplevel\fR calls in between).
.SS "COMPATIBILITY WITH TCL 8.*"
.PP
.VS "9.0, TIP 526"
In Tcl 8 and older, the \fBexpr\fR command would concatenate multiple
arguments to form the expression; if this behavior is desired in Tcl 9.0
onwards, explicit use of \fBconcat\fR is required (this is also compatible
with earlier versions of Tcl) or a double-quoted argument could be used (as
whitespace is not generally important in expressions). Note that this style of
programming is often a source of bugs, including security bugs, so it is
\fInot recommended\fR. For example, instead of this version (supported in Tcl
8 and before):
.PP
.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b * 4
.CE
.PP
you might write:
.PP
.CS
# ...
\fBexpr\fR [concat $b * 4]
.CE
.PP
or:
.PP
.CS
# ...
\fBexpr\fR "$b * 4"
.CE
.PP
Both of the above cases substitute \fB$b\fR prior to evaluating the
expression, and do the building of the expression dynamically making it
difficult to avoid compiling the expression on every call to \fBexpr\fR.
.PP
However, some use cases that \fIare\fR supported may be preferable, such as
embedding the use of \fBexpr\fR with a variable argument inside an otherwise
constant expression:
.PP
.CS
# ...
\fBexpr\fR {[\fBexpr\fR $b] * 4}
.CE
.PP





This changes what value is calculated (in this case, producing \fB20\fR rather
than \fB11\fR) because they force the inner expression to be evaluated
independently of the outer one; such changes may actually fix more bugs than
they cause! Note that this allows the outer expression to be fully compiled,
and enables compilation of the inner expression too (which can be cached in
some cases).
.VE "9.0, TIP 526"
.SH EXAMPLES
.PP
A numeric comparison whose result is 1:
.PP
.CS
\fBexpr\fR {"0x03" > "2"}
.CE
................................................................................
.nf
Copyright \(co 1993 The Regents of the University of California.
Copyright \(co 1994-2000 Sun Microsystems Incorporated.
Copyright \(co 2005 by Kevin B. Kenny <[email protected]>. All rights reserved.
.fi
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *resultPtr, *objPtr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
	return TCL_ERROR;
    }

    TclNewObj(resultPtr);
    Tcl_IncrRefCount(resultPtr);
    if (objc == 2) {
	objPtr = objv[1];
	TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL);
    } else {
	objPtr = Tcl_ConcatObj(objc-1, objv+1);
	TclNRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL, NULL);
    }

    return Tcl_NRExprObj(interp, objPtr, resultPtr);
}

static int
ExprCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultPtr = (Tcl_Obj *)data[0];
    Tcl_Obj *objPtr = (Tcl_Obj *)data[1];

    if (objPtr != NULL) {
	Tcl_DecrRefCount(objPtr);
    }

    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, resultPtr);
    }
    Tcl_DecrRefCount(resultPtr);
    return result;
}

    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *resultPtr, *objPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "expression");
	return TCL_ERROR;
    }

    TclNewObj(resultPtr);
    Tcl_IncrRefCount(resultPtr);

    objPtr = objv[1];
    TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL);





    return Tcl_NRExprObj(interp, objPtr, resultPtr);
}

static int
ExprCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultPtr = (Tcl_Obj *)data[0];






    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, resultPtr);
    }
    Tcl_DecrRefCount(resultPtr);
    return result;
}

    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *firstWordPtr;

    if (parsePtr->numWords == 1) {
	return TCL_ERROR;
    }

    /*
     * TIP #280: Use the per-word line information of the current command.
     */

    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *firstWordPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    /*
     * TIP #280: Use the per-word line information of the current command.
     */

test append-1.3 {append command} {
    set x "abcd"
    append x
} abcd

test append-2.1 {long appends} {
    set x ""
    for {set i 0} {$i < 1000} {set i [expr $i+1]} {
	append x "foobar "
    }
    set y "foobar"
    set y "$y $y $y $y $y $y $y $y $y $y"
    set y "$y $y $y $y $y $y $y $y $y $y"
    set y "$y $y $y $y $y $y $y $y $y $y "
    expr {$x == $y}
................................................................................
test append-5.1 {long lappends} -setup {
    unset -nocomplain x
    proc check {var size} {
	set l [llength $var]
	if {$l != $size} {
	    return "length mismatch: should have been $size, was $l"
	}
	for {set i 0} {$i < $size} {set i [expr $i+1]} {
	    set j [lindex $var $i]
	    if {$j ne "item $i"} {
		return "element $i should have been \"item $i\", was \"$j\""
	    }
	}
	return ok
    }

test append-1.3 {append command} {
    set x "abcd"
    append x
} abcd

test append-2.1 {long appends} {
    set x ""
    for {set i 0} {$i < 1000} {incr i} {
	append x "foobar "
    }
    set y "foobar"
    set y "$y $y $y $y $y $y $y $y $y $y"
    set y "$y $y $y $y $y $y $y $y $y $y"
    set y "$y $y $y $y $y $y $y $y $y $y "
    expr {$x == $y}
................................................................................
test append-5.1 {long lappends} -setup {
    unset -nocomplain x
    proc check {var size} {
	set l [llength $var]
	if {$l != $size} {
	    return "length mismatch: should have been $size, was $l"
	}
	for {set i 0} {$i < $size} {incr i} {
	    set j [lindex $var $i]
	    if {$j ne "item $i"} {
		return "element $i should have been \"item $i\", was \"$j\""
	    }
	}
	return ok
    }

    }
    foo
} abcd

test appendComp-2.1 {long appends} {
    proc foo {} {
	set x ""
	for {set i 0} {$i < 1000} {set i [expr $i+1]} {
	    append x "foobar "
	}
	set y "foobar"
	set y "$y $y $y $y $y $y $y $y $y $y"
	set y "$y $y $y $y $y $y $y $y $y $y"
	set y "$y $y $y $y $y $y $y $y $y $y "
	expr {$x == $y}
................................................................................
		return "element $i should have been \"item $i\", was \"$j\""
	    }
	}
	return ok
    }
} -body {
    set x ""
    for {set i 0} {$i < 300} {set i [expr $i+1]} {
	lappend x "item $i"
    }
    check $x 300
} -cleanup {
    unset -nocomplain x
    catch {rename check ""}
} -result ok

    }
    foo
} abcd

test appendComp-2.1 {long appends} {
    proc foo {} {
	set x ""
	for {set i 0} {$i < 1000} {incr i} {
	    append x "foobar "
	}
	set y "foobar"
	set y "$y $y $y $y $y $y $y $y $y $y"
	set y "$y $y $y $y $y $y $y $y $y $y"
	set y "$y $y $y $y $y $y $y $y $y $y "
	expr {$x == $y}
................................................................................
		return "element $i should have been \"item $i\", was \"$j\""
	    }
	}
	return ok
    }
} -body {
    set x ""
    for {set i 0} {$i < 300} {incr i} {
	lappend x "item $i"
    }
    check $x 300
} -cleanup {
    unset -nocomplain x
    catch {rename check ""}
} -result ok

# This shouldn't cause any problems
namespace import -force blt::*

# Should be able to handle "proc" definitions, even if they are preceded by
# white space.

proc normal {x y} {return [expr $x+$y]}
  proc indented {x y} {return [expr $x+$y]}

#
# Should be able to handle proc declarations within namespaces, even if they
# have explicit namespace paths.
#
namespace eval buried {
    proc inside {args} {return "inside: $args"}

# This shouldn't cause any problems
namespace import -force blt::*

# Should be able to handle "proc" definitions, even if they are preceded by
# white space.

proc normal {x y} {return [expr {$x+$y}]}
  proc indented {x y} {return [expr {$x+$y}]}

#
# Should be able to handle proc declarations within namespaces, even if they
# have explicit namespace paths.
#
namespace eval buried {
    proc inside {args} {return "inside: $args"}

proc l3 {} {
    list i j k {l l}
}

# Do all tests once byte compiled and once with direct string evaluation
foreach noComp {0 1} {

if $noComp {
    interp alias {} run {} testevalex
    set constraints testevalex
} else {
    interp alias {} run {} if 1
    set constraints {}
}

proc l3 {} {
    list i j k {l l}
}

# Do all tests once byte compiled and once with direct string evaluation
foreach noComp {0 1} {

if {$noComp} {
    interp alias {} run {} testevalex
    set constraints testevalex
} else {
    interp alias {} run {} if 1
    set constraints {}
}

    }
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto
    string length [chan read $f]
} -cleanup {
    chan close $f
} -result [expr 700*15+1]
test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    chan puts -nonewline $f x	;# shift crlf across block boundary
................................................................................
    }
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    string length [chan read $f]
} -cleanup {
    chan close $f
} -result [expr 700*15+1]
test chan-io-30.15 {Tcl_Write mixed, Tcl_Read auto} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\rhere
    chan close $f
................................................................................
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    while {[chan gets $f line] >= 0} {
	append c $line\n
    }
    chan close $f
    string length $c
} -result [expr 700*15+1]
test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set c ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
................................................................................
    set f [open $path(test1) r]
    chan configure $f -translation auto
    while {[chan gets $f line] >= 0} {
	append c $line\n
    }
    chan close $f
    string length $c
} -result [expr 700*15+1]

# Test Tcl_Read and buffering.

test chan-io-32.1 {Tcl_Read, channel not readable} -body {
    read stdout
} -returnCodes error -result {channel "stdout" wasn't opened for reading}
test chan-io-32.2 {Tcl_Read, zero byte count} {
................................................................................
    chan close $f
} -result {zzy abzzy}
test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -constraints {unix} -body {
    set f [open $path(test3) {WRONLY CREAT} 0600]
    file stat $path(test3) stats
    set x [format "%#o" [expr $stats(mode)&0o777]]
    chan puts $f "line 1"
    chan close $f
    set f [open $path(test3) r]
    lappend x [chan gets $f]
} -cleanup {
    chan close $f
} -result {0o600 {line 1}}
test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -constraints {unix umask} -body {
    # This test only works if your umask is 2, like ouster's.
    chan close [open $path(test3) {WRONLY CREAT}]
    file stat $path(test3) stats
    format "%#o" [expr $stats(mode)&0o777]
} -result [format %#5o [expr {0o666 & ~ $umaskValue}]]
test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]
    chan configure $f -eofchar {}
    chan puts $f xyzzy
................................................................................
test chan-io-52.6 {TclCopyChannel} -setup {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation lf -blocking 0
    set s0 [chan copy $f1 $f2 -size [expr [file size $thisScript] + 5]]
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {($s1 == $s2) && ($s0 == $s1)} {
        lappend result ok
................................................................................
    set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
    set in [open $thisScript]	;# 126 K
    set out [socket 127.0.0.1 [lindex [chan configure $listen -sockname] 2]]
    catch {unset fcopyTestDone}
    chan close $listen	;# This means the socket open never really succeeds
    chan copy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    if ![info exists fcopyTestDone] {
	vwait [namespace which -variable fcopyTestDone]		;# The error occurs here in the b.g.
    }
    chan close $in
    chan close $out
    set fcopyTestDone	;# 1 for error condition
} 1
test chan-io-53.6 {CopyData: error during chan copy} -setup {
................................................................................
    set f1 [open $path(pipe) w]
    chan puts $f1 "exit 1"
    chan close $f1
    set in [openpipe r+ $path(pipe)]
    set out [open $path(test1) w]
    chan copy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    if ![info exists fcopyTestDone] {
	vwait [namespace which -variable fcopyTestDone]
    }
    return $fcopyTestDone	;# 0 for plain end of file
} -cleanup {
    catch {chan close $in}
    chan close $out
} -result 0
................................................................................
    set out [open $path(test1) w]
    doFcopy $in $out
    variable fcopyTestDone
    if {![info exists fcopyTestDone]} {
	vwait [namespace which -variable fcopyTestDone]
    }
    # -1=error 0=script error N=number of bytes
    expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
} -cleanup {
    catch {chan close $in}
    chan close $out
} -result {3450}
test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
    # copy progress callback. errors out intentionally
    proc cmd args {

    }
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto
    string length [chan read $f]
} -cleanup {
    chan close $f
} -result [expr {700*15 + 1}]
test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    chan puts -nonewline $f x	;# shift crlf across block boundary
................................................................................
    }
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    string length [chan read $f]
} -cleanup {
    chan close $f
} -result [expr {700*15 + 1}]
test chan-io-30.15 {Tcl_Write mixed, Tcl_Read auto} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\rhere
    chan close $f
................................................................................
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    while {[chan gets $f line] >= 0} {
	append c $line\n
    }
    chan close $f
    string length $c
} -result [expr {700*15 + 1}]
test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set c ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
................................................................................
    set f [open $path(test1) r]
    chan configure $f -translation auto
    while {[chan gets $f line] >= 0} {
	append c $line\n
    }
    chan close $f
    string length $c
} -result [expr {700*15 + 1}]

# Test Tcl_Read and buffering.

test chan-io-32.1 {Tcl_Read, channel not readable} -body {
    read stdout
} -returnCodes error -result {channel "stdout" wasn't opened for reading}
test chan-io-32.2 {Tcl_Read, zero byte count} {
................................................................................
    chan close $f
} -result {zzy abzzy}
test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -constraints {unix} -body {
    set f [open $path(test3) {WRONLY CREAT} 0600]
    file stat $path(test3) stats
    set x [format "%#o" [expr {$stats(mode) & 0o777}]]
    chan puts $f "line 1"
    chan close $f
    set f [open $path(test3) r]
    lappend x [chan gets $f]
} -cleanup {
    chan close $f
} -result {0o600 {line 1}}
test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -constraints {unix umask} -body {
    # This test only works if your umask is 2, like ouster's.
    chan close [open $path(test3) {WRONLY CREAT}]
    file stat $path(test3) stats
    format "%#o" [expr {$stats(mode) & 0o777}]
} -result [format %#5o [expr {0o666 & ~ $umaskValue}]]
test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]
    chan configure $f -eofchar {}
    chan puts $f xyzzy
................................................................................
test chan-io-52.6 {TclCopyChannel} -setup {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation lf -blocking 0
    set s0 [chan copy $f1 $f2 -size [expr {[file size $thisScript] + 5}]]
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {($s1 == $s2) && ($s0 == $s1)} {
        lappend result ok
................................................................................
    set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
    set in [open $thisScript]	;# 126 K
    set out [socket 127.0.0.1 [lindex [chan configure $listen -sockname] 2]]
    catch {unset fcopyTestDone}
    chan close $listen	;# This means the socket open never really succeeds
    chan copy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    if {![info exists fcopyTestDone]} {
	vwait [namespace which -variable fcopyTestDone]		;# The error occurs here in the b.g.
    }
    chan close $in
    chan close $out
    set fcopyTestDone	;# 1 for error condition
} 1
test chan-io-53.6 {CopyData: error during chan copy} -setup {
................................................................................
    set f1 [open $path(pipe) w]
    chan puts $f1 "exit 1"
    chan close $f1
    set in [openpipe r+ $path(pipe)]
    set out [open $path(test1) w]
    chan copy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    if {![info exists fcopyTestDone]} {
	vwait [namespace which -variable fcopyTestDone]
    }
    return $fcopyTestDone	;# 0 for plain end of file
} -cleanup {
    catch {chan close $in}
    chan close $out
} -result 0
................................................................................
    set out [open $path(test1) w]
    doFcopy $in $out
    variable fcopyTestDone
    if {![info exists fcopyTestDone]} {
	vwait [namespace which -variable fcopyTestDone]
    }
    # -1=error 0=script error N=number of bytes
    expr {($fcopyTestDone == 0) ? $fcopyTestCount : -1}
} -cleanup {
    catch {chan close $in}
    chan close $out
} -result {3450}
test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
    # copy progress callback. errors out intentionally
    proc cmd args {

    set problems
} {}

# Legacy tests

# clock clicks
test clock-33.1 {clock clicks tests} {
    expr [clock clicks]+1
    concat {}
} {}
test clock-33.2 {clock clicks tests} {
    set start [clock clicks]
    after 10
    set end [clock clicks]
    expr {$end > $start}
} {1}
test clock-33.3 {clock clicks tests} {
    list [catch {clock clicks foo} msg] $msg
} {1 {bad option "foo": must be -milliseconds or -microseconds}}
test clock-33.4 {clock clicks tests} {
    expr [clock clicks -milliseconds]+1
    concat {}
} {}
test clock-33.4a {clock milliseconds} {
    expr { [clock milliseconds] + 1 }
    concat {}
} {}
test clock-33.5 {clock clicks tests, millisecond timing test} {
................................................................................
test clock-34.68 {clock scan tests (merid and TZ)} {
    set time [clock scan "10:59 pm +0100" -base 2000000 -gmt true]
    clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
} {Jan 24,1970 21:59:00 GMT}

# clock seconds
test clock-35.1 {clock seconds tests} {
    expr [clock seconds]+1
    concat {}
} {}
test clock-35.2 {clock seconds tests} {
    list [catch {clock seconds foo} msg] $msg
} {1 {wrong # args: should be "clock seconds"}}
test clock-35.3 {clock seconds tests} {
    set start [clock seconds]

    set problems
} {}

# Legacy tests

# clock clicks
test clock-33.1 {clock clicks tests} {
    expr {[clock clicks] + 1}
    concat {}
} {}
test clock-33.2 {clock clicks tests} {
    set start [clock clicks]
    after 10
    set end [clock clicks]
    expr {$end > $start}
} {1}
test clock-33.3 {clock clicks tests} {
    list [catch {clock clicks foo} msg] $msg
} {1 {bad option "foo": must be -milliseconds or -microseconds}}
test clock-33.4 {clock clicks tests} {
    expr {[clock clicks -milliseconds] + 1}
    concat {}
} {}
test clock-33.4a {clock milliseconds} {
    expr { [clock milliseconds] + 1 }
    concat {}
} {}
test clock-33.5 {clock clicks tests, millisecond timing test} {
................................................................................
test clock-34.68 {clock scan tests (merid and TZ)} {
    set time [clock scan "10:59 pm +0100" -base 2000000 -gmt true]
    clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
} {Jan 24,1970 21:59:00 GMT}

# clock seconds
test clock-35.1 {clock seconds tests} {
    expr {[clock seconds] + 1}
    concat {}
} {}
test clock-35.2 {clock seconds tests} {
    list [catch {clock seconds foo} msg] $msg
} {1 {wrong # args: should be "clock seconds"}}
test clock-35.3 {clock seconds tests} {
    set start [clock seconds]

    file lstat $linkfile stat
    lsort [array names stat]
} -result {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-23.4 {Tcl_FileObjCmd: lstat} -setup {
    unset -nocomplain stat
} -constraints {unix nonPortable} -body {
    file lstat $linkfile stat
    list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
} -result {1 511 link}
test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
    list [catch {file lstat _bogus_ stat} msg] [string tolower $msg] \
	$errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} -setup {
    unset -nocomplain x

    file lstat $linkfile stat
    lsort [array names stat]
} -result {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-23.4 {Tcl_FileObjCmd: lstat} -setup {
    unset -nocomplain stat
} -constraints {unix nonPortable} -body {
    file lstat $linkfile stat
    list $stat(nlink) [expr {$stat(mode) & 0o777}] $stat(type)
} -result {1 511 link}
test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
    list [catch {file lstat _bogus_ stat} msg] [string tolower $msg] \
	$errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} -setup {
    unset -nocomplain x

} {{dogs {0 1}} {the {0 1 2} lazy} {jumps {30 31 2 33} over} {brown {0 1 2 3 4} fox} {the {0 1 2 3 4 5} quick}}
test cmdIL-5.5 {lsort with list style index and sharing} -body {
    proc test_lsort {l} {
	set n $l
	foreach e $l {lappend n [list [expr {rand()}] $e]}
	lindex [lsort -real -index $l $n] 1 1
    }
    expr srand(1)
    test_lsort 0
} -result 0 -cleanup {
    rename test_lsort ""
}
test cmdIL-5.6 {lsort with multiple list-style index options} {
    lsort -index {1 2 3} -index 0 {{a b} {c d} {b e}}
} {{a b} {b e} {c d}}

} {{dogs {0 1}} {the {0 1 2} lazy} {jumps {30 31 2 33} over} {brown {0 1 2 3 4} fox} {the {0 1 2 3 4 5} quick}}
test cmdIL-5.5 {lsort with list style index and sharing} -body {
    proc test_lsort {l} {
	set n $l
	foreach e $l {lappend n [list [expr {rand()}] $e]}
	lindex [lsort -real -index $l $n] 1 1
    }
    expr {srand(1)}
    test_lsort 0
} -result 0 -cleanup {
    rename test_lsort ""
}
test cmdIL-5.6 {lsort with multiple list-style index options} {
    lsort -index {1 2 3} -index 0 {{a b} {c d} {b e}}
} {{a b} {b e} {c d}}

# start of tests

catch {unset a b i x}

test compExpr-old-1.1 {TclCompileExprCmd: no expression} {
    list [catch {expr  } msg] $msg
} {1 {wrong # args: should be "expr arg ?arg ...?"}}
test compExpr-old-1.2 {TclCompileExprCmd: one expression word} {
    expr -25
} -25
test compExpr-old-1.3 {TclCompileExprCmd: two expression words} {
    expr -8.2   -6
} -14.2
test compExpr-old-1.4 {TclCompileExprCmd: five expression words} {
    expr 20 - 5 +10 -7
} 18
test compExpr-old-1.5 {TclCompileExprCmd: quoted expression word} {
    expr "0005"
} 5
test compExpr-old-1.6 {TclCompileExprCmd: quoted expression word} {
    catch {expr "0005"zxy} msg
    set msg
} {extra characters after close-quote}
................................................................................
test compExpr-old-1.13 {TclCompileExprCmd: second level of substitutions in expr not in braces with single var reference} {
    set a xxx
    set x 27;  set bool {$x};  if $bool {set a foo}
    set a
} foo
test compExpr-old-1.14 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} {
    set a xxx
    set x 2;  set b {$x};  set a [expr $b == 2]
    set a
} 1

test compExpr-old-2.1 {TclCompileExpr: are builtin functions registered?} {
    expr double(5*[llength "6 2"])
} 10.0
test compExpr-old-2.2 {TclCompileExpr: error in expr} -body {

# start of tests

catch {unset a b i x}

test compExpr-old-1.1 {TclCompileExprCmd: no expression} {
    list [catch {expr  } msg] $msg
} {1 {wrong # args: should be "expr expression"}}
test compExpr-old-1.2 {TclCompileExprCmd: one expression word} {
    expr -25
} -25
# 1.3 and 1.4 no longer apply





test compExpr-old-1.5 {TclCompileExprCmd: quoted expression word} {
    expr "0005"
} 5
test compExpr-old-1.6 {TclCompileExprCmd: quoted expression word} {
    catch {expr "0005"zxy} msg
    set msg
} {extra characters after close-quote}
................................................................................
test compExpr-old-1.13 {TclCompileExprCmd: second level of substitutions in expr not in braces with single var reference} {
    set a xxx
    set x 27;  set bool {$x};  if $bool {set a foo}
    set a
} foo
test compExpr-old-1.14 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} {
    set a xxx
    set x 2;  set b {$x};  set a [expr $b==2]
    set a
} 1

test compExpr-old-2.1 {TclCompileExpr: are builtin functions registered?} {
    expr double(5*[llength "6 2"])
} 10.0
test compExpr-old-2.2 {TclCompileExpr: error in expr} -body {

    expr {0? 42 : $a}
} -result 83
test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} {
    list [catch {expr {1? 15 : [expr *2]}} msg] $msg
} {0 15}

test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
    format %.6g [expr atan2(1.0, 2.0)]
} 0.463648
test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body {
    expr {do_it()}
} -returnCodes error -match glob -result {* "*do_it"}
test compExpr-5.5 {CompileMathFuncCall procedure, not enough arguments} -body {
    expr {atan2(1.0)}
} -returnCodes error -match glob -result {not enough arguments for math function*}
test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} {
    format %.6g [expr pow(2.1, 27.5-(24.4*(5%2)))]
} 9.97424
test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} -body {
    expr {sinh(2.*)}
} -returnCodes error -match glob -result *
test compExpr-5.8 {CompileMathFuncCall procedure, too many arguments} -body {
    expr {sinh(2.0, 3.0)}
} -returnCodes error -match glob -result {too many arguments for math function*}

    expr {0? 42 : $a}
} -result 83
test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} {
    list [catch {expr {1? 15 : [expr *2]}} msg] $msg
} {0 15}

test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
    format %.6g [expr {atan2(1.0, 2.0)}]
} 0.463648
test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body {
    expr {do_it()}
} -returnCodes error -match glob -result {* "*do_it"}
test compExpr-5.5 {CompileMathFuncCall procedure, not enough arguments} -body {
    expr {atan2(1.0)}
} -returnCodes error -match glob -result {not enough arguments for math function*}
test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} {
    format %.6g [expr {pow(2.1, 27.5-(24.4*(5%2)))}]
} 9.97424
test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} -body {
    expr {sinh(2.*)}
} -returnCodes error -match glob -result *
test compExpr-5.8 {CompileMathFuncCall procedure, too many arguments} -body {
    expr {sinh(2.0, 3.0)}
} -returnCodes error -match glob -result {too many arguments for math function*}

    -cleanup {namespace delete catchtest}
}

test compile-4.1 {TclCompileForCmd: command substituted test expression} {
    set i 0
    set j 0
    # Should be "forever"
    for {} [expr $i < 3] {} {
	set j [incr i]
	if {$j > 3} break
    }
    set j
} {4}

test compile-5.1 {TclCompileForeachCmd: exception stack} {
................................................................................
    list $::x $::test_ns_compile::arr(1)
} -result {hello 123}

test compile-7.1 {TclCompileWhileCmd: command substituted test expression} {
    set i 0
    set j 0
    # Should be "forever"
    while [expr $i < 3] {
	set j [incr i]
	if {$j > 3} break
    }
    set j
} {4}

test compile-8.1 {CollectArgInfo: binary data} {
................................................................................
test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; incr foo bar baz}}
} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; incr}}
} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test compile-11.7 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; expr !a }}
} -returnCodes error -match glob -result *
test compile-11.8 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; expr {!a} }}
} -returnCodes error -match glob -result *
test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; llength "\{" }}
    list [catch {p} msg] $msg
................................................................................
test compile-15.5 {proper TCL_RETURN code from [return]} {
    apply {{} {catch {set a 1}; return}}
} ""

# Do all tests once byte compiled and once with direct string evaluation
foreach noComp {0 1} {

if $noComp {
    interp alias {} run {} testevalex
    set constraints testevalex
} else {
    interp alias {} run {} if 1
    set constraints {}
}

    -cleanup {namespace delete catchtest}
}

test compile-4.1 {TclCompileForCmd: command substituted test expression} {
    set i 0
    set j 0
    # Should be "forever"
    for {} [expr {$i < 3}] {} {
	set j [incr i]
	if {$j > 3} break
    }
    set j
} {4}

test compile-5.1 {TclCompileForeachCmd: exception stack} {
................................................................................
    list $::x $::test_ns_compile::arr(1)
} -result {hello 123}

test compile-7.1 {TclCompileWhileCmd: command substituted test expression} {
    set i 0
    set j 0
    # Should be "forever"
    while [expr {$i < 3}] {
	set j [incr i]
	if {$j > 3} break
    }
    set j
} {4}

test compile-8.1 {CollectArgInfo: binary data} {
................................................................................
test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; incr foo bar baz}}
} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; incr}}
} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test compile-11.7 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; expr [concat !a] }}
} -returnCodes error -match glob -result *
test compile-11.8 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; expr {!a} }}
} -returnCodes error -match glob -result *
test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; llength "\{" }}
    list [catch {p} msg] $msg
................................................................................
test compile-15.5 {proper TCL_RETURN code from [return]} {
    apply {{} {catch {set a 1}; return}}
} ""

# Do all tests once byte compiled and once with direct string evaluation
foreach noComp {0 1} {

if {$noComp} {
    interp alias {} run {} testevalex
    set constraints testevalex
} else {
    interp alias {} run {} if 1
    set constraints {}
}

	    continue
	}
	lappend newcmd $arg
    }
    exit
} sh2]
set path(sleep) [makeFile {
    after [expr $argv*1000]
    exit
} sleep]
set path(exit) [makeFile {
    exit $argv
} exit]

proc readfile filename {

	    continue
	}
	lappend newcmd $arg
    }
    exit
} sh2]
set path(sleep) [makeFile {
    after [expr {[lindex $argv 0] * 1000}]
    exit
} sleep]
set path(exit) [makeFile {
    exit $argv
} exit]

proc readfile filename {

test execute-7.9 {Wide int handling in INST_MOD} {
    expr {(wide(1)<<60) % ((wide(47)<<45)-1)}
} 316659348800185
test execute-7.10 {Wide int handling in INST_MOD} {
    expr {((wide(1)<<60)-1) % 0x400000000}
} 17179869183
test execute-7.11 {Wide int handling in INST_LSHIFT} {
    expr wide(42)<<30
} 45097156608
test execute-7.12 {Wide int handling in INST_LSHIFT} {
    expr 12345678901<<3
} 98765431208
test execute-7.13 {Wide int handling in INST_RSHIFT} {
    expr 0x543210febcda9876>>7
} 47397893236700464
test execute-7.14 {Wide int handling in INST_RSHIFT} {
    expr wide(0x9876543210febcda)>>7
} -58286587177206407
test execute-7.15 {Wide int handling in INST_BITOR} {
    expr wide(0x9876543210febcda) | 0x543210febcda9876
} -2560765885044310786
test execute-7.16 {Wide int handling in INST_BITXOR} {
    expr wide(0x9876543210febcda) ^ 0x543210febcda9876
} -3727778945703861076
test execute-7.17 {Wide int handling in INST_BITAND} {
    expr wide(0x9876543210febcda) & 0x543210febcda9876
} 1167013060659550290
test execute-7.18 {Wide int handling in INST_ADD} {
    expr wide(0x7fffffff)+wide(0x7fffffff)
} 4294967294
test execute-7.19 {Wide int handling in INST_ADD} {
    expr 0x7fffffff+wide(0x7fffffff)
} 4294967294
test execute-7.20 {Wide int handling in INST_ADD} {
    expr wide(0x7fffffff)+0x7fffffff
} 4294967294
test execute-7.21 {Wide int handling in INST_ADD} {
    expr double(0x7fffffff)+wide(0x7fffffff)
} 4294967294.0
test execute-7.22 {Wide int handling in INST_ADD} {
    expr wide(0x7fffffff)+double(0x7fffffff)
} 4294967294.0
test execute-7.23 {Wide int handling in INST_SUB} {
    expr 0x123456789a-0x20406080a
} 69530054800
test execute-7.24 {Wide int handling in INST_MULT} {
    expr 0x123456789a*193
} 15090186251290
test execute-7.25 {Wide int handling in INST_DIV} {
    expr 0x123456789a/193
} 405116546
test execute-7.26 {Wide int handling in INST_UPLUS} {
    set x 0x123456871234568
    expr {+ $x}
} 81985533099853160
test execute-7.27 {Wide int handling in INST_UMINUS} {
    set x 0x123456871234568

test execute-7.9 {Wide int handling in INST_MOD} {
    expr {(wide(1)<<60) % ((wide(47)<<45)-1)}
} 316659348800185
test execute-7.10 {Wide int handling in INST_MOD} {
    expr {((wide(1)<<60)-1) % 0x400000000}
} 17179869183
test execute-7.11 {Wide int handling in INST_LSHIFT} {
    expr {wide(42) << 30}
} 45097156608
test execute-7.12 {Wide int handling in INST_LSHIFT} {
    expr {12345678901 << 3}
} 98765431208
test execute-7.13 {Wide int handling in INST_RSHIFT} {
    expr {0x543210febcda9876 >> 7}
} 47397893236700464
test execute-7.14 {Wide int handling in INST_RSHIFT} {
    expr {wide(0x9876543210febcda) >> 7}
} -58286587177206407
test execute-7.15 {Wide int handling in INST_BITOR} {
    expr {wide(0x9876543210febcda) | 0x543210febcda9876}
} -2560765885044310786
test execute-7.16 {Wide int handling in INST_BITXOR} {
    expr {wide(0x9876543210febcda) ^ 0x543210febcda9876}
} -3727778945703861076
test execute-7.17 {Wide int handling in INST_BITAND} {
    expr {wide(0x9876543210febcda) & 0x543210febcda9876}
} 1167013060659550290
test execute-7.18 {Wide int handling in INST_ADD} {
    expr {wide(0x7fffffff) + wide(0x7fffffff)}
} 4294967294
test execute-7.19 {Wide int handling in INST_ADD} {
    expr {0x7fffffff + wide(0x7fffffff)}
} 4294967294
test execute-7.20 {Wide int handling in INST_ADD} {
    expr {wide(0x7fffffff) + 0x7fffffff}
} 4294967294
test execute-7.21 {Wide int handling in INST_ADD} {
    expr {double(0x7fffffff) + wide(0x7fffffff)}
} 4294967294.0
test execute-7.22 {Wide int handling in INST_ADD} {
    expr {wide(0x7fffffff) + double(0x7fffffff)}
} 4294967294.0
test execute-7.23 {Wide int handling in INST_SUB} {
    expr {0x123456789a - 0x20406080a}
} 69530054800
test execute-7.24 {Wide int handling in INST_MULT} {
    expr {0x123456789a * 193}
} 15090186251290
test execute-7.25 {Wide int handling in INST_DIV} {
    expr {0x123456789a / 193}
} 405116546
test execute-7.26 {Wide int handling in INST_UPLUS} {
    set x 0x123456871234568
    expr {+ $x}
} 81985533099853160
test execute-7.27 {Wide int handling in INST_UMINUS} {
    set x 0x123456871234568

	}
    }
}
testConstraint ieeeFloatingPoint [testIEEE]

# First, test all of the integer operators individually.

test expr-old-1.1 {integer operators} {expr -4} -4
test expr-old-1.2 {integer operators} {expr -(1+4)} -5
test expr-old-1.3 {integer operators} {expr ~3} -4
test expr-old-1.4 {integer operators} {expr !2} 0
test expr-old-1.5 {integer operators} {expr !0} 1
test expr-old-1.6 {integer operators} {expr 4*6} 24
test expr-old-1.7 {integer operators} {expr 36/12} 3
test expr-old-1.8 {integer operators} {expr 27/4} 6
test expr-old-1.9 {integer operators} {expr 27%4} 3
test expr-old-1.10 {integer operators} {expr 2+2} 4
test expr-old-1.11 {integer operators} {expr 2-6} -4
test expr-old-1.12 {integer operators} {expr 1<<3} 8
test expr-old-1.13 {integer operators} {expr 0xff>>2} 63
test expr-old-1.14 {integer operators} {expr -1>>2} -1
test expr-old-1.15 {integer operators} {expr 3>2} 1
test expr-old-1.16 {integer operators} {expr 2>2} 0
test expr-old-1.17 {integer operators} {expr 1>2} 0
test expr-old-1.18 {integer operators} {expr 3<2} 0
test expr-old-1.19 {integer operators} {expr 2<2} 0
test expr-old-1.20 {integer operators} {expr 1<2} 1
test expr-old-1.21 {integer operators} {expr 3>=2} 1
test expr-old-1.22 {integer operators} {expr 2>=2} 1
test expr-old-1.23 {integer operators} {expr 1>=2} 0
test expr-old-1.24 {integer operators} {expr 3<=2} 0
test expr-old-1.25 {integer operators} {expr 2<=2} 1
test expr-old-1.26 {integer operators} {expr 1<=2} 1
test expr-old-1.27 {integer operators} {expr 3==2} 0
test expr-old-1.28 {integer operators} {expr 2==2} 1
test expr-old-1.29 {integer operators} {expr 3!=2} 1
test expr-old-1.30 {integer operators} {expr 2!=2} 0
test expr-old-1.31 {integer operators} {expr 7&0x13} 3
test expr-old-1.32 {integer operators} {expr 7^0x13} 20
test expr-old-1.33 {integer operators} {expr 7|0x13} 23
test expr-old-1.34 {integer operators} {expr 0&&1} 0
test expr-old-1.35 {integer operators} {expr 0&&0} 0
test expr-old-1.36 {integer operators} {expr 1&&3} 1
test expr-old-1.37 {integer operators} {expr 0||1} 1
test expr-old-1.38 {integer operators} {expr 3||0} 1
test expr-old-1.39 {integer operators} {expr 0||0} 0
test expr-old-1.40 {integer operators} {expr 3>2?44:66} 44
test expr-old-1.41 {integer operators} {expr 2>3?44:66} 66
test expr-old-1.42 {integer operators} {expr 36/5} 7
test expr-old-1.43 {integer operators} {expr 36%5} 1
test expr-old-1.44 {integer operators} {expr -36/5} -8
test expr-old-1.45 {integer operators} {expr -36%5} 4
test expr-old-1.46 {integer operators} {expr 36/-5} -8
test expr-old-1.47 {integer operators} {expr 36%-5} -4
test expr-old-1.48 {integer operators} {expr -36/-5} 7
test expr-old-1.49 {integer operators} {expr -36%-5} -1
test expr-old-1.50 {integer operators} {expr +36} 36
test expr-old-1.51 {integer operators} {expr +--++36} 36
test expr-old-1.52 {integer operators} {expr +36%+5} 1
test expr-old-1.53 {integer operators} {
    unset -nocomplain x

    set x yes
    list [expr {1 && $x}] [expr {$x && 1}] \
         [expr {0 || $x}] [expr {$x || 0}]
} {1 1 1 1}

# Check the floating-point operators individually, along with
# automatic conversion to integers where needed.

test expr-old-2.1 {floating-point operators} {expr -4.2} -4.2
test expr-old-2.2 {floating-point operators} {expr -(1.125+4.25)} -5.375
test expr-old-2.3 {floating-point operators} {expr +5.7} 5.7
test expr-old-2.4 {floating-point operators} {expr +--+-62.0} -62.0
test expr-old-2.5 {floating-point operators} {expr !2.1} 0
test expr-old-2.6 {floating-point operators} {expr !0.0} 1
test expr-old-2.7 {floating-point operators} {expr 4.2*6.3} 26.46
test expr-old-2.8 {floating-point operators} {expr 36.0/12.0} 3.0
test expr-old-2.9 {floating-point operators} {expr 27/4.0} 6.75
test expr-old-2.10 {floating-point operators} {expr 2.3+2.1} 4.4
test expr-old-2.11 {floating-point operators} {expr 2.3-6.5} -4.2
test expr-old-2.12 {floating-point operators} {expr 3.1>2.1} 1
test expr-old-2.13 {floating-point operators} {expr {2.1 > 2.1}} 0
test expr-old-2.14 {floating-point operators} {expr 1.23>2.34e+1} 0
test expr-old-2.15 {floating-point operators} {expr 3.45<2.34} 0
test expr-old-2.16 {floating-point operators} {expr 0.002e3<--200e-2} 0
test expr-old-2.17 {floating-point operators} {expr 1.1<2.1} 1
test expr-old-2.18 {floating-point operators} {expr 3.1>=2.2} 1
test expr-old-2.19 {floating-point operators} {expr 2.345>=2.345} 1
test expr-old-2.20 {floating-point operators} {expr 1.1>=2.2} 0
test expr-old-2.21 {floating-point operators} {expr 3.0<=2.0} 0
test expr-old-2.22 {floating-point operators} {expr 2.2<=2.2} 1
test expr-old-2.23 {floating-point operators} {expr 2.2<=2.2001} 1
test expr-old-2.24 {floating-point operators} {expr 3.2==2.2} 0
test expr-old-2.25 {floating-point operators} {expr 2.2==2.2} 1
test expr-old-2.26 {floating-point operators} {expr 3.2!=2.2} 1
test expr-old-2.27 {floating-point operators} {expr 2.2!=2.2} 0
test expr-old-2.28 {floating-point operators} {expr 0.0&&0.0} 0
test expr-old-2.29 {floating-point operators} {expr 0.0&&1.3} 0
test expr-old-2.30 {floating-point operators} {expr 1.3&&0.0} 0
test expr-old-2.31 {floating-point operators} {expr 1.3&&3.3} 1
test expr-old-2.32 {floating-point operators} {expr 0.0||0.0} 0
test expr-old-2.33 {floating-point operators} {expr 0.0||1.3} 1
test expr-old-2.34 {floating-point operators} {expr 1.3||0.0} 1
test expr-old-2.35 {floating-point operators} {expr 3.3||0.0} 1
test expr-old-2.36 {floating-point operators} {expr 3.3>2.3?44.3:66.3} 44.3
test expr-old-2.37 {floating-point operators} {expr 2.3>3.3?44.3:66.3} 66.3
test expr-old-2.38 {floating-point operators} {
    list [catch {expr 028.1 + 09.2} msg] $msg
} {0 37.3}

# Operators that aren't legal on floating-point numbers

test expr-old-3.1 {illegal floating-point operations} {
    list [catch {expr ~4.0} msg] $msg
} {1 {can't use floating-point value "4.0" as operand of "~"}}
test expr-old-3.2 {illegal floating-point operations} {
    list [catch {expr 27%4.0} msg] $msg
} {1 {can't use floating-point value "4.0" as operand of "%"}}
test expr-old-3.3 {illegal floating-point operations} {
    list [catch {expr 27.0%4} msg] $msg
} {1 {can't use floating-point value "27.0" as operand of "%"}}
test expr-old-3.4 {illegal floating-point operations} {
    list [catch {expr 1.0<<3} msg] $msg
} {1 {can't use floating-point value "1.0" as operand of "<<"}}
test expr-old-3.5 {illegal floating-point operations} {
    list [catch {expr 3<<1.0} msg] $msg
} {1 {can't use floating-point value "1.0" as operand of "<<"}}
test expr-old-3.6 {illegal floating-point operations} {
    list [catch {expr 24.0>>3} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of ">>"}}
test expr-old-3.7 {illegal floating-point operations} {
    list [catch {expr 24>>3.0} msg] $msg
} {1 {can't use floating-point value "3.0" as operand of ">>"}}
test expr-old-3.8 {illegal floating-point operations} {
    list [catch {expr 24&3.0} msg] $msg
} {1 {can't use floating-point value "3.0" as operand of "&"}}
test expr-old-3.9 {illegal floating-point operations} {
    list [catch {expr 24.0|3} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "|"}}
test expr-old-3.10 {illegal floating-point operations} {
    list [catch {expr 24.0^3} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "^"}}

# Check the string operators individually.

test expr-old-4.1 {string operators} {expr {"abc" > "def"}} 0
test expr-old-4.2 {string operators} {expr {"def" > "def"}} 0
test expr-old-4.3 {string operators} {expr {"g" > "def"}} 1
test expr-old-4.4 {string operators} {expr {"abc" < "abd"}} 1
................................................................................
test expr-old-4.29 {string operators} {expr {"0" == "+"}} 0
test expr-old-4.30 {string operators} {expr {"0" == "-"}} 0
test expr-old-4.31 {string operators} {expr {1?"foo":"bar"}} foo
test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar

# Operators that aren't legal on string operands.

test expr-old-5.1 {illegal string operations} {
    list [catch {expr {-"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "-"}}
test expr-old-5.2 {illegal string operations} {
    list [catch {expr {+"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
test expr-old-5.3 {illegal string operations} {
    list [catch {expr {~"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "~"}}
test expr-old-5.4 {illegal string operations} {
    list [catch {expr {!"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "!"}}
test expr-old-5.5 {illegal string operations} {
    list [catch {expr {"a"*"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "*"}}
test expr-old-5.6 {illegal string operations} {
    list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "/"}}
test expr-old-5.7 {illegal string operations} {
    list [catch {expr {"a"%"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "%"}}
test expr-old-5.8 {illegal string operations} {
    list [catch {expr {"a"+"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
test expr-old-5.9 {illegal string operations} {
    list [catch {expr {"a"-"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "-"}}
test expr-old-5.10 {illegal string operations} {
    list [catch {expr {"a"<<"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "<<"}}
test expr-old-5.11 {illegal string operations} {
    list [catch {expr {"a">>"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of ">>"}}
test expr-old-5.12 {illegal string operations} {
    list [catch {expr {"a"&"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "&"}}
test expr-old-5.13 {illegal string operations} {
    list [catch {expr {"a"^"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "^"}}
test expr-old-5.14 {illegal string operations} {
    list [catch {expr {"a"|"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "|"}}
test expr-old-5.15 {illegal string operations} {
    list [catch {expr {"a"&&"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
test expr-old-5.16 {illegal string operations} {
    list [catch {expr {"a"||"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
test expr-old-5.17 {illegal string operations} {
    list [catch {expr {"a"?4:2}} msg] $msg
} {1 {expected boolean value but got "a"}}

# Check precedence pairwise.

test expr-old-6.1 {precedence checks} {expr -~3} 4
test expr-old-6.2 {precedence checks} {expr -!3} 0
test expr-old-6.3 {precedence checks} {expr -~0} 1

test expr-old-7.1 {precedence checks} {expr 2*4/6} 1
test expr-old-7.2 {precedence checks} {expr 24/6*3} 12
test expr-old-7.3 {precedence checks} {expr 24/6/2} 2

test expr-old-8.1 {precedence checks} {expr -2+4} 2
test expr-old-8.2 {precedence checks} {expr -2-4} -6
test expr-old-8.3 {precedence checks} {expr +2-4} -2

test expr-old-9.1 {precedence checks} {expr 2*3+4} 10
test expr-old-9.2 {precedence checks} {expr 8/2+4} 8
test expr-old-9.3 {precedence checks} {expr 8%3+4} 6
test expr-old-9.4 {precedence checks} {expr 2*3-1} 5
test expr-old-9.5 {precedence checks} {expr 8/2-1} 3
test expr-old-9.6 {precedence checks} {expr 8%3-1} 1

test expr-old-10.1 {precedence checks} {expr 6-3-2} 1

test expr-old-11.1 {precedence checks} {expr 7+1>>2} 2
test expr-old-11.2 {precedence checks} {expr 7+1<<2} 32
test expr-old-11.3 {precedence checks} {expr 7>>3-2} 3
test expr-old-11.4 {precedence checks} {expr 7<<3-2} 14

test expr-old-12.1 {precedence checks} {expr 6>>1>4} 0
test expr-old-12.2 {precedence checks} {expr 6>>1<2} 0
test expr-old-12.3 {precedence checks} {expr 6>>1>=3} 1
test expr-old-12.4 {precedence checks} {expr 6>>1<=2} 0
test expr-old-12.5 {precedence checks} {expr 6<<1>5} 1
test expr-old-12.6 {precedence checks} {expr 6<<1<5} 0
test expr-old-12.7 {precedence checks} {expr 5<=6<<1} 1
test expr-old-12.8 {precedence checks} {expr 5>=6<<1} 0

test expr-old-13.1 {precedence checks} {expr 2<3<4} 1
test expr-old-13.2 {precedence checks} {expr 0<4>2} 0
test expr-old-13.3 {precedence checks} {expr 4>2<1} 0
test expr-old-13.4 {precedence checks} {expr 4>3>2} 0
test expr-old-13.5 {precedence checks} {expr 4>3>=2} 0
test expr-old-13.6 {precedence checks} {expr 4>=3>2} 0
test expr-old-13.7 {precedence checks} {expr 4>=3>=2} 0
test expr-old-13.8 {precedence checks} {expr 0<=4>=2} 0
test expr-old-13.9 {precedence checks} {expr 4>=2<=0} 0
test expr-old-13.10 {precedence checks} {expr 2<=3<=4} 1

test expr-old-14.1 {precedence checks} {expr 1==4>3} 1
test expr-old-14.2 {precedence checks} {expr 0!=4>3} 1
test expr-old-14.3 {precedence checks} {expr 1==3<4} 1
test expr-old-14.4 {precedence checks} {expr 0!=3<4} 1
test expr-old-14.5 {precedence checks} {expr 1==4>=3} 1
test expr-old-14.6 {precedence checks} {expr 0!=4>=3} 1
test expr-old-14.7 {precedence checks} {expr 1==3<=4} 1
test expr-old-14.8 {precedence checks} {expr 0!=3<=4} 1
test expr-old-14.9 {precedence checks} {expr 1eq4>3} 1
test expr-old-14.10 {precedence checks} {expr 0ne4>3} 1
test expr-old-14.11 {precedence checks} {expr 1eq3<4} 1
test expr-old-14.12 {precedence checks} {expr 0ne3<4} 1
test expr-old-14.13 {precedence checks} {expr 1eq4>=3} 1
test expr-old-14.14 {precedence checks} {expr 0ne4>=3} 1
test expr-old-14.15 {precedence checks} {expr 1eq3<=4} 1
test expr-old-14.16 {precedence checks} {expr 0ne3<=4} 1

test expr-old-15.1 {precedence checks} {expr 1==3==3} 0
test expr-old-15.2 {precedence checks} {expr 3==3!=2} 1
test expr-old-15.3 {precedence checks} {expr 2!=3==3} 0
test expr-old-15.4 {precedence checks} {expr 2!=1!=1} 0
test expr-old-15.5 {precedence checks} {expr 1eq3eq3} 0
test expr-old-15.6 {precedence checks} {expr 3eq3ne2} 1
test expr-old-15.7 {precedence checks} {expr 2ne3eq3} 0
test expr-old-15.8 {precedence checks} {expr 2ne1ne1} 0

test expr-old-16.1 {precedence checks} {expr 2&3eq2} 0
test expr-old-16.2 {precedence checks} {expr 1&3ne3} 0
test expr-old-16.3 {precedence checks} {expr 2&3eq2} 0
test expr-old-16.4 {precedence checks} {expr 1&3ne3} 0

test expr-old-17.1 {precedence checks} {expr 7&3^0x10} 19
test expr-old-17.2 {precedence checks} {expr 7^0x10&3} 7

test expr-old-18.1 {precedence checks} {expr 7^0x10|3} 23
test expr-old-18.2 {precedence checks} {expr 7|0x10^3} 23

test expr-old-19.1 {precedence checks} {expr 7|3&&1} 1
test expr-old-19.2 {precedence checks} {expr 1&&3|7} 1
test expr-old-19.3 {precedence checks} {expr 0&&1||1} 1
test expr-old-19.4 {precedence checks} {expr 1||1&&0} 1

test expr-old-20.1 {precedence checks} {expr 1||0?3:4} 3
test expr-old-20.2 {precedence checks} {expr 1?0:4||1} 0
test expr-old-20.3 {precedence checks} {expr 1?2:0?3:4} 2
test expr-old-20.4 {precedence checks} {expr 0?2:0?3:4} 4
test expr-old-20.5 {precedence checks} {expr 1?2?3:4:0} 3
test expr-old-20.6 {precedence checks} {expr 0?2?3:4:0} 0

# Parentheses.

test expr-old-21.1 {parenthesization} {expr (2+4)*6} 36
test expr-old-21.2 {parenthesization} {expr (1?0:4)||1} 1
test expr-old-21.3 {parenthesization} {expr +(3-4)} -1

# Embedded commands and variable names.

set a 16
test expr-old-22.1 {embedded variables} {expr {2*$a}} 32
test expr-old-22.2 {embedded variables} {
    set x -5
................................................................................
} {5}
test expr-old-22.3 {embedded variables} {
    set x "  -5"
    set y "  +10"
    expr {$x + $y}
} {5}
test expr-old-22.4 {embedded commands and variables} {expr {[set a] - 14}} 2
test expr-old-22.5 {embedded commands and variables} {
    list [catch {expr {12 - [bad_command_name]}} msg] $msg
} {1 {invalid command name "bad_command_name"}}

# Double-quotes and things inside them.

test expr-old-23.1 {double quotes} {expr {"abc"}} abc
test expr-old-23.2 {double quotes} {
    set a 189
    expr {"$a.bc"}
................................................................................
} {1 Testing}
test expr-old-23.8 {double quotes} {
    list [catch {expr {"12398712938788234-1298379" != ""}} msg] $msg
} {0 1}

# Numbers in various bases.

test expr-old-24.1 {numbers in different bases} {expr 0x20} 32
test expr-old-24.2 {numbers in different bases} {expr 0o15} 13

# Conversions between various data types.

test expr-old-25.1 {type conversions} {expr 2+2.5} 4.5
test expr-old-25.2 {type conversions} {expr 2.5+2} 4.5
test expr-old-25.3 {type conversions} {expr 2-2.5} -0.5
test expr-old-25.4 {type conversions} {expr 2/2.5} 0.8
test expr-old-25.5 {type conversions} {expr 2>2.5} 0
test expr-old-25.6 {type conversions} {expr 2.5>2} 1
test expr-old-25.7 {type conversions} {expr 2<2.5} 1
test expr-old-25.8 {type conversions} {expr 2>=2.5} 0
test expr-old-25.9 {type conversions} {expr 2<=2.5} 1
test expr-old-25.10 {type conversions} {expr 2==2.5} 0
test expr-old-25.11 {type conversions} {expr 2!=2.5} 1
test expr-old-25.12 {type conversions} {expr 2>"ab"} 0
test expr-old-25.13 {type conversions} {expr {2>" "}} 1
test expr-old-25.14 {type conversions} {expr {"24.1a" > 24.1}} 1
test expr-old-25.15 {type conversions} {expr {24.1 > "24.1a"}} 0
test expr-old-25.16 {type conversions} {expr 2+2.5} 4.5
test expr-old-25.17 {type conversions} {expr 2+2.5} 4.5
test expr-old-25.18 {type conversions} {expr 2.0e2} 200.0
test expr-old-25.19 {type conversions} {expr 2.0e15} 2000000000000000.0
test expr-old-25.20 {type conversions} {expr 10.0} 10.0

# Various error conditions.

test expr-old-26.1 {error conditions} {
    list [catch {expr 2+"a"} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
test expr-old-26.2 {error conditions} -body {
    expr 2+4*
} -returnCodes error -match glob -result *
test expr-old-26.3 {error conditions} -body {
    expr 2+4*(
} -returnCodes error -match glob -result *
unset -nocomplain _non_existent_
test expr-old-26.4 {error conditions} {
    list [catch {expr 2+$_non_existent_} msg] $msg
} {1 {can't read "_non_existent_": no such variable}}
set a xx
test expr-old-26.5 {error conditions} {
    list [catch {expr {2+$a}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "+"}}
test expr-old-26.6 {error conditions} {
    list [catch {expr {2+[set a]}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "+"}}
test expr-old-26.7 {error conditions} -body {
    expr {2+(4}
} -returnCodes error -match glob -result *
test expr-old-26.8 {error conditions} {
    list [catch {expr 2/0} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
test expr-old-26.9 {error conditions} {
    list [catch {expr 2%0} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
test expr-old-26.10a {error conditions} !ieeeFloatingPoint {
    list [catch {expr 2.0/0.0} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
test expr-old-26.10b {error conditions} ieeeFloatingPoint {
    list [catch {expr 2.0/0.0} msg] $msg
} {0 Inf}
test expr-old-26.11 {error conditions} -body {
    expr 2#
} -returnCodes error -match glob -result *
test expr-old-26.12 {error conditions} -body {
    expr a.b
} -returnCodes error -match glob -result *
test expr-old-26.13 {error conditions} {
    list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "/"}}
test expr-old-26.14 {error conditions} -body {
    expr 2:3
} -returnCodes error -match glob -result *
test expr-old-26.15 {error conditions} -body {
    expr [email protected]
} -returnCodes error -match glob -result *
test expr-old-26.16 {error conditions} {
    list [catch {expr a[b} msg] $msg
} {1 {missing close-bracket}}
test expr-old-26.17 {error conditions} -body {
    expr a`b
} -returnCodes error -match glob -result *
test expr-old-26.18 {error conditions} -body {
    expr \"a\"\{b
} -returnCodes error -match glob -result *
test expr-old-26.19 {error conditions} -body {
    expr a
} -returnCodes error -match glob -result *
test expr-old-26.20 {error conditions} {
    list [catch expr msg] $msg
} {1 {wrong # args: should be "expr arg ?arg ...?"}}




# Cancelled evaluation.

test expr-old-27.1 {cancelled evaluation} {
    set a 1
    expr {0&&[set a 2]}
    set a
................................................................................
test expr-old-30.2 {long values} {
    set a "000000000000000000000000000000"
    set a "$a$a$a$a$a$a$a$a$a$a$a$a$a$a$a$a${a}5"
    expr $a
} 5

# Expressions spanning multiple arguments

test expr-old-31.1 {multiple arguments to expr command} {
    expr 4 + ( 6 *12) -3
} 73
test expr-old-31.2 {multiple arguments to expr command} -body {
    expr 2 + (3 + 4
} -returnCodes error -match glob -result *
test expr-old-31.3 {multiple arguments to expr command} -body {
    expr 2 + 3 +
} -returnCodes error -match glob -result *
test expr-old-31.4 {multiple arguments to expr command} -body {
    expr 2 + 3 )
} -returnCodes error -match glob -result *


# Math functions

test expr-old-32.1 {math functions in expressions} {
    format %.6g [expr acos(0.5)]
} {1.0472}
test expr-old-32.2 {math functions in expressions} {
    format %.6g [expr asin(0.5)]
} {0.523599}
test expr-old-32.3 {math functions in expressions} {
    format %.6g [expr atan(1.0)]
} {0.785398}
test expr-old-32.4 {math functions in expressions} {
    format %.6g [expr atan2(2.0, 2.0)]
} {0.785398}
test expr-old-32.5 {math functions in expressions} {
    format %.6g [expr ceil(1.999)]
} {2}
test expr-old-32.6 {math functions in expressions} {
    format %.6g [expr cos(.1)]
} {0.995004}
test expr-old-32.7 {math functions in expressions} {
    format %.6g [expr cosh(.1)]
} {1.005}
test expr-old-32.8 {math functions in expressions} {
    format %.6g [expr exp(1.0)]
} {2.71828}
test expr-old-32.9 {math functions in expressions} {
    format %.6g [expr floor(2.000)]
} {2}
test expr-old-32.10 {math functions in expressions} {
    format %.6g [expr floor(2.001)]
} {2}
test expr-old-32.11 {math functions in expressions} {
    format %.6g [expr fmod(7.3, 3.2)]
} {0.9}
test expr-old-32.12 {math functions in expressions} {
    format %.6g [expr hypot(3.0, 4.0)]
} {5}
test expr-old-32.13 {math functions in expressions} {
    format %.6g [expr log(2.8)]
} {1.02962}
test expr-old-32.14 {math functions in expressions} {
    format %.6g [expr log10(2.8)]
} {0.447158}
test expr-old-32.15 {math functions in expressions} {
    format %.6g [expr pow(2.1, 3.1)]
} {9.97424}
test expr-old-32.16 {math functions in expressions} {
    format %.6g [expr sin(.1)]
} {0.0998334}
test expr-old-32.17 {math functions in expressions} {
    format %.6g [expr sinh(.1)]
} {0.100167}
test expr-old-32.18 {math functions in expressions} {
    format %.6g [expr sqrt(2.0)]
} {1.41421}
test expr-old-32.19 {math functions in expressions} {
    format %.6g [expr tan(0.8)]
} {1.02964}
test expr-old-32.20 {math functions in expressions} {
    format %.6g [expr tanh(0.8)]
} {0.664037}
test expr-old-32.21 {math functions in expressions} {
    format %.6g [expr abs(-1.8)]
} {1.8}
test expr-old-32.22 {math functions in expressions} {
    expr abs(10.0)
} {10.0}
test expr-old-32.23 {math functions in expressions} {
    format %.6g [expr abs(-4)]
} {4}
test expr-old-32.24 {math functions in expressions} {
    format %.6g [expr abs(66)]
} {66}

test expr-old-32.25a {math functions in expressions} {
    expr abs(0x8000000000000000)
} [expr 1<<63]

test expr-old-32.25b {math functions in expressions} {
    expr abs(0x80000000)
} 2147483648

test expr-old-32.26 {math functions in expressions} {
    expr double(1)
} {1.0}
test expr-old-32.27 {math functions in expressions} {
    expr double(1.1)
} {1.1}
test expr-old-32.28 {math functions in expressions} {
    expr int(1)
} {1}
test expr-old-32.29 {math functions in expressions} {
    expr int(1.4)
} {1}
test expr-old-32.30 {math functions in expressions} {
    expr int(1.6)
} {1}
test expr-old-32.31 {math functions in expressions} {
    expr int(-1.4)
} {-1}
test expr-old-32.32 {math functions in expressions} {
    expr int(-1.6)
} {-1}
test expr-old-32.33 {math functions in expressions} {
    expr int(1e60)
} 999999999999999949387135297074018866963645011013410073083904
test expr-old-32.34 {math functions in expressions} {
    expr int(-1e60)
} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.35 {math functions in expressions} {
    expr round(1.49)
} {1}
test expr-old-32.36 {math functions in expressions} {
    expr round(1.51)
} {2}
test expr-old-32.37 {math functions in expressions} {
    expr round(-1.49)
} {-1}
test expr-old-32.38 {math functions in expressions} {
    expr round(-1.51)
} {-2}
test expr-old-32.39 {math functions in expressions} {
    expr round(1e60)
} 999999999999999949387135297074018866963645011013410073083904
test expr-old-32.40 {math functions in expressions} {
    expr round(-1e60)
} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.41 {math functions in expressions} {
    list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg
} {0 16.0}
test expr-old-32.42 {math functions in expressions} {
    list [catch {expr hypot(5*.8,3)} msg] $msg
} {0 5.0}
test expr-old-32.45 {math functions in expressions} {
    expr (0 <= rand()) && (rand() < 1)
} {1}
test expr-old-32.46 {math functions in expressions} -body {
    list [catch {expr rand(24)} msg] $msg
} -match glob -result {1 {too many arguments for math function*}}
test expr-old-32.47 {math functions in expressions} -body {
    list [catch {expr srand()} msg] $msg
} -match glob -result {1 {not enough arguments for math function*}}
test expr-old-32.48 {math functions in expressions} -body {
    expr srand(3.79)
} -returnCodes error -match glob -result *
test expr-old-32.49 {math functions in expressions} -body {
    expr srand("")
} -returnCodes error -match glob -result *
test expr-old-32.50 {math functions in expressions} {
    set result [expr round(srand(12345) * 1000)]
    for {set i 0} {$i < 10} {incr i} {
	lappend result [expr round(rand() * 1000)]
    }
    set result
} {97 834 948 36 12 51 766 585 914 784 333}
test expr-old-32.51 {math functions in expressions} -body {
    expr {srand([lindex "6ty" 0])}
} -returnCodes error -match glob -result *
test expr-old-32.52 {math functions in expressions} {
................................................................................
    expr {srand(int(1<<37)) < 1}
} {1}
test expr-old-32.53 {math functions in expressions} {
    expr {srand((1<<31) - 1) > 0}
} {1}

test expr-old-33.1 {conversions and fancy args to math functions} {
    expr hypot ( 3 , 4 )
} 5.0
test expr-old-33.2 {conversions and fancy args to math functions} {
    expr hypot ( (2.0+1.0) , 4 )
} 5.0
test expr-old-33.3 {conversions and fancy args to math functions} {
    expr hypot ( 3 , (3.0 + 1.0) )
} 5.0
test expr-old-33.4 {conversions and fancy args to math functions} {
    format %.6g [expr cos(acos(0.1))]
} 0.1

test expr-old-34.1 {errors in math functions} -body {
    list [catch {expr func_2(1.0)} msg] $msg
} -match glob -result {1 {* "*func_2"}}
test expr-old-34.2 {errors in math functions} -body {
    expr func|(1.0)
} -returnCodes error -match glob -result *
test expr-old-34.3 {errors in math functions} {
    list [catch {expr {hypot("a b", 2.0)}} msg] $msg
} {1 {expected floating-point number but got "a b"}}
test expr-old-34.4 {errors in math functions} -body {
    expr hypot(1.0 2.0)
} -returnCodes error -match glob -result *
test expr-old-34.5 {errors in math functions} -body {
    expr hypot(1.0, 2.0
} -returnCodes error -match glob -result *
test expr-old-34.6 {errors in math functions} -body {
    expr hypot(1.0 ,
} -returnCodes error -match glob -result *
test expr-old-34.7 {errors in math functions} -body {
    list [catch {expr hypot(1.0)} msg] $msg
} -match glob -result {1 {not enough arguments for math function*}}
test expr-old-34.8 {errors in math functions} -body {
    list [catch {expr hypot(1.0, 2.0, 3.0)} msg] $msg
} -match glob -result {1 {too many arguments for math function*}}
test expr-old-34.9 {errors in math functions} {
    list [catch {expr acos(-2.0)} msg] $msg $errorCode
} {1 {domain error: argument not in valid range} {ARITH DOMAIN {domain error: argument not in valid range}}}
test expr-old-34.10 {errors in math functions} {
    list [catch {expr pow(-3, 1000001)} msg] $msg
} {0 -Inf}
test expr-old-34.11a {errors in math functions} !ieeeFloatingPoint {
    list [catch {expr pow(3, 1000001)} msg] $msg $errorCode
} {1 {floating-point value too large to represent} {ARITH OVERFLOW {floating-point value too large to represent}}}
test expr-old-34.11b {errors in math functions} ieeeFloatingPoint {
    list [catch {expr pow(3, 1000001)} msg] $msg
} {0 Inf}
test expr-old-34.12a {errors in math functions} !ieeeFloatingPoint {
    list [catch {expr -14.0*exp(100000)} msg] $msg $errorCode
} {1 {floating-point value too large to represent} {ARITH OVERFLOW {floating-point value too large to represent}}}
test expr-old-34.12b {errors in math functions} ieeeFloatingPoint {
    list [catch {expr -14.0*exp(100000)} msg] $msg
} {0 -Inf}
test expr-old-34.13 {errors in math functions} {
    expr wide(1.0e30)
} 5076964154930102272
test expr-old-34.14 {errors in math functions} {
    expr wide(-1.0e30)
} -5076964154930102272
test expr-old-34.15 {errors in math functions} {
    expr round(1.0e30)
} 1000000000000000019884624838656
test expr-old-34.16 {errors in math functions} {
    expr round(-1.0e30)
} -1000000000000000019884624838656

test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
    expr 0o289
} -returnCodes error -match glob -result {*invalid octal number*}
test expr-old-36.2 {ExprLooksLikeInt procedure} {
    set x 0o289
    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string "0o289" as operand of "+"}}
test expr-old-36.3 {ExprLooksLikeInt procedure} {
    list [catch {expr 0289.1} msg] $msg
} {0 289.1}
test expr-old-36.4 {ExprLooksLikeInt procedure} {
    set x 0289.1
    list [catch {expr {$x+1}} msg] $msg
} {0 290.1}
test expr-old-36.5 {ExprLooksLikeInt procedure} {
    set x {  +22}
    list [catch {expr {$x+1}} msg] $msg
} {0 23}
test expr-old-36.6 {ExprLooksLikeInt procedure} {
    set x {	-22}
    list [catch {expr {$x+1}} msg] $msg
} {0 -21}
test expr-old-36.7 {ExprLooksLikeInt procedure} {
    list [catch {expr nan} msg] $msg
} {1 {domain error: argument not in valid range}}
test expr-old-36.8 {ExprLooksLikeInt procedure} {
    list [catch {expr 78e1} msg] $msg
} {0 780.0}
test expr-old-36.9 {ExprLooksLikeInt procedure} {
    list [catch {expr 24E1} msg] $msg
} {0 240.0}
test expr-old-36.10 {ExprLooksLikeInt procedure} -body {
    expr 78e
} -returnCodes error -match glob -result *

# test for [Bug #542588]
test expr-old-36.11 {ExprLooksLikeInt procedure} {
    # define a "too large integer"; this one works also for 64bit arith
    set x 665802003400000000000000
    expr {$x+1}
} 665802003400000000000001

# tests for [Bug #587140]
test expr-old-36.12 {ExprLooksLikeInt procedure} {
    set x "10;"
    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string "10;" as operand of "+"}}
test expr-old-36.13 {ExprLooksLikeInt procedure} {
    set x " +"
    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string " +" as operand of "+"}}
test expr-old-36.14 {ExprLooksLikeInt procedure} {
    set x "123456789012345678901234567890 "
    expr {$x+1}
} 123456789012345678901234567891
test expr-old-36.15 {ExprLooksLikeInt procedure} {
    set x "0o99 "
    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string "0o99 " as operand of "+"}}
test expr-old-36.16 {ExprLooksLikeInt procedure} {
    set x " 0xffffffffffffffffffffffffffffffffffffff  "
    expr {$x+1}
} [expr 0x100000000000000000000000000000000000000]

test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} testexprlong {
    testexprlong 4+1
} {This is a result: 5}
#Check for [Bug 1109484]
test expr-old-37.2 {Tcl_ExprLong handles wide ints gracefully} testexprlong {
    testexprlong wide(1)+2
................................................................................
#
# Test for bug #908375: rounding numbers that do not fit in a
# long but do fit in a wide
#

test expr-old-39.1 {Rounding with wide result} {
    set x 1.0e10
    set y [expr $x + 0.1]
    catch {
	set x [list [expr {$x == round($y)}] [expr $x == -round(-$y)]]
    }
    set x
} {1 1}
unset -nocomplain x y

#
# TIP #255 min and max math functions
................................................................................
test expr-old-40.5 {min math function} -body {
    expr {min("a", 0)}
} -returnCodes error -match glob -result *
test expr-old-40.6 {min math function} -body {
    expr {min(300, "0xFF")}
} -result 255
test expr-old-40.7 {min math function} -body {
    expr min(1[string repeat 0 10000], 1e300)
} -result 1e+300
test expr-old-40.8 {min math function} -body {
    expr {min(0, "a")}
} -returnCodes error -match glob -result *

test expr-old-41.1 {max math function} -body {
    expr {max(0)}
................................................................................
test expr-old-41.5 {max math function} -body {
    expr {max("a", 0)}
} -returnCodes error -match glob -result *
test expr-old-41.6 {max math function} -body {
    expr {max(200, "0xFF")}
} -result 255
test expr-old-41.7 {max math function} -body {
    expr max(1[string repeat 0 10000], 1e300)
} -result 1[string repeat 0 10000]
test expr-old-41.8 {max math function} -body {
    expr {max(0, "a")}
} -returnCodes error -match glob -result *

# Special test for Pentium arithmetic bug of 1994:

	}
    }
}
testConstraint ieeeFloatingPoint [testIEEE]

# First, test all of the integer operators individually.

test expr-old-1.1 {integer operators} {expr {-4}} -4
test expr-old-1.2 {integer operators} {expr {-(1 + 4)}} -5
test expr-old-1.3 {integer operators} {expr {~3}} -4
test expr-old-1.4 {integer operators} {expr {!2}} 0
test expr-old-1.5 {integer operators} {expr {!0}} 1
test expr-old-1.6 {integer operators} {expr {4 * 6}} 24
test expr-old-1.7 {integer operators} {expr {36 / 12}} 3
test expr-old-1.8 {integer operators} {expr {27 / 4}} 6
test expr-old-1.9 {integer operators} {expr {27 % 4}} 3
test expr-old-1.10 {integer operators} {expr {2 + 2}} 4
test expr-old-1.11 {integer operators} {expr {2 - 6}} -4
test expr-old-1.12 {integer operators} {expr {1 << 3}} 8
test expr-old-1.13 {integer operators} {expr {0xff >> 2}} 63
test expr-old-1.14 {integer operators} {expr {-1 >> 2}} -1
test expr-old-1.15 {integer operators} {expr {3 > 2}} 1
test expr-old-1.16 {integer operators} {expr {2 > 2}} 0
test expr-old-1.17 {integer operators} {expr {1 > 2}} 0
test expr-old-1.18 {integer operators} {expr {3 < 2}} 0
test expr-old-1.19 {integer operators} {expr {2 < 2}} 0
test expr-old-1.20 {integer operators} {expr {1 < 2}} 1
test expr-old-1.21 {integer operators} {expr {3 >= 2}} 1
test expr-old-1.22 {integer operators} {expr {2 >= 2}} 1
test expr-old-1.23 {integer operators} {expr {1 >= 2}} 0
test expr-old-1.24 {integer operators} {expr {3 <= 2}} 0
test expr-old-1.25 {integer operators} {expr {2 <= 2}} 1
test expr-old-1.26 {integer operators} {expr {1 <= 2}} 1
test expr-old-1.27 {integer operators} {expr {3 == 2}} 0
test expr-old-1.28 {integer operators} {expr {2 == 2}} 1
test expr-old-1.29 {integer operators} {expr {3 != 2}} 1
test expr-old-1.30 {integer operators} {expr {2 != 2}} 0
test expr-old-1.31 {integer operators} {expr {7 & 0x13}} 3
test expr-old-1.32 {integer operators} {expr {7 ^ 0x13}} 20
test expr-old-1.33 {integer operators} {expr {7 | 0x13}} 23
test expr-old-1.34 {integer operators} {expr {0 && 1}} 0
test expr-old-1.35 {integer operators} {expr {0 && 0}} 0
test expr-old-1.36 {integer operators} {expr {1 && 3}} 1
test expr-old-1.37 {integer operators} {expr {0 || 1}} 1
test expr-old-1.38 {integer operators} {expr {3 || 0}} 1
test expr-old-1.39 {integer operators} {expr {0 || 0}} 0
test expr-old-1.40 {integer operators} {expr {3>2 ? 44 : 66}} 44
test expr-old-1.41 {integer operators} {expr {2>3 ? 44 : 66}} 66
test expr-old-1.42 {integer operators} {expr {36 / 5}} 7
test expr-old-1.43 {integer operators} {expr {36 % 5}} 1
test expr-old-1.44 {integer operators} {expr {-36 / 5}} -8
test expr-old-1.45 {integer operators} {expr {-36 % 5}} 4
test expr-old-1.46 {integer operators} {expr {36 / -5}} -8
test expr-old-1.47 {integer operators} {expr {36 % -5}} -4
test expr-old-1.48 {integer operators} {expr {-36 / -5}} 7
test expr-old-1.49 {integer operators} {expr {-36 % -5}} -1
test expr-old-1.50 {integer operators} {expr {+36}} 36
test expr-old-1.51 {integer operators} {expr {+--++36}} 36
test expr-old-1.52 {integer operators} {expr {+36%+5}} 1
test expr-old-1.53 {integer operators} -setup {
    unset -nocomplain x
} -body {
    set x yes
    list [expr {1 && $x}] [expr {$x && 1}] \
         [expr {0 || $x}] [expr {$x || 0}]
} -result {1 1 1 1}

# Check the floating-point operators individually, along with
# automatic conversion to integers where needed.

test expr-old-2.1 {floating-point operators} {expr {-4.2}} -4.2
test expr-old-2.2 {floating-point operators} {expr {-(1.125 + 4.25)}} -5.375
test expr-old-2.3 {floating-point operators} {expr {+5.7}} 5.7
test expr-old-2.4 {floating-point operators} {expr {+--+-62.0}} -62.0
test expr-old-2.5 {floating-point operators} {expr {!2.1}} 0
test expr-old-2.6 {floating-point operators} {expr {!0.0}} 1
test expr-old-2.7 {floating-point operators} {expr {4.2 * 6.3}} 26.46
test expr-old-2.8 {floating-point operators} {expr {36.0 / 12.0}} 3.0
test expr-old-2.9 {floating-point operators} {expr {27 / 4.0}} 6.75
test expr-old-2.10 {floating-point operators} {expr {2.3 + 2.1}} 4.4
test expr-old-2.11 {floating-point operators} {expr {2.3 - 6.5}} -4.2
test expr-old-2.12 {floating-point operators} {expr {3.1 > 2.1}} 1
test expr-old-2.13 {floating-point operators} {expr {2.1 > 2.1}} 0
test expr-old-2.14 {floating-point operators} {expr {1.23 > 2.34e+1}} 0
test expr-old-2.15 {floating-point operators} {expr {3.45 < 2.34}} 0
test expr-old-2.16 {floating-point operators} {expr {0.002e3<--200e-2}} 0
test expr-old-2.17 {floating-point operators} {expr {1.1 < 2.1}} 1
test expr-old-2.18 {floating-point operators} {expr {3.1 >= 2.2}} 1
test expr-old-2.19 {floating-point operators} {expr {2.345 >= 2.345}} 1
test expr-old-2.20 {floating-point operators} {expr {1.1 >= 2.2}} 0
test expr-old-2.21 {floating-point operators} {expr {3.0 <= 2.0}} 0
test expr-old-2.22 {floating-point operators} {expr {2.2 <= 2.2}} 1
test expr-old-2.23 {floating-point operators} {expr {2.2 <= 2.2001}} 1
test expr-old-2.24 {floating-point operators} {expr {3.2 == 2.2}} 0
test expr-old-2.25 {floating-point operators} {expr {2.2 == 2.2}} 1
test expr-old-2.26 {floating-point operators} {expr {3.2 != 2.2}} 1
test expr-old-2.27 {floating-point operators} {expr {2.2 != 2.2}} 0
test expr-old-2.28 {floating-point operators} {expr {0.0 && 0.0}} 0
test expr-old-2.29 {floating-point operators} {expr {0.0 && 1.3}} 0
test expr-old-2.30 {floating-point operators} {expr {1.3 && 0.0}} 0
test expr-old-2.31 {floating-point operators} {expr {1.3 && 3.3}} 1
test expr-old-2.32 {floating-point operators} {expr {0.0 || 0.0}} 0
test expr-old-2.33 {floating-point operators} {expr {0.0 || 1.3}} 1
test expr-old-2.34 {floating-point operators} {expr {1.3 || 0.0}} 1
test expr-old-2.35 {floating-point operators} {expr {3.3 || 0.0}} 1
test expr-old-2.36 {floating-point operators} {expr {3.3>2.3 ? 44.3 : 66.3}} 44.3
test expr-old-2.37 {floating-point operators} {expr {2.3>3.3 ? 44.3 : 66.3}} 66.3
test expr-old-2.38 {floating-point operators} {
    list [catch {expr {028.1 + 09.2}} msg] $msg
} {0 37.3}

# Operators that aren't legal on floating-point numbers

test expr-old-3.1 {illegal floating-point operations} -returnCodes error -body {
    expr {~4.0}
} -result {can't use floating-point value "4.0" as operand of "~"}
test expr-old-3.2 {illegal floating-point operations} -returnCodes error -body {
    expr {27 % 4.0}
} -result {can't use floating-point value "4.0" as operand of "%"}
test expr-old-3.3 {illegal floating-point operations} -returnCodes error -body {
    expr {27.0 % 4}
} -result {can't use floating-point value "27.0" as operand of "%"}
test expr-old-3.4 {illegal floating-point operations} -returnCodes error -body {
    expr {1.0 << 3}
} -result {can't use floating-point value "1.0" as operand of "<<"}
test expr-old-3.5 {illegal floating-point operations} -returnCodes error -body {
    expr {3 << 1.0}
} -result {can't use floating-point value "1.0" as operand of "<<"}
test expr-old-3.6 {illegal floating-point operations} -returnCodes error -body {
    expr {24.0 >> 3}
} -result {can't use floating-point value "24.0" as operand of ">>"}
test expr-old-3.7 {illegal floating-point operations} -returnCodes error -body {
    expr {24 >> 3.0}
} -result {can't use floating-point value "3.0" as operand of ">>"}
test expr-old-3.8 {illegal floating-point operations} -returnCodes error -body {
    expr {24 & 3.0}
} -result {can't use floating-point value "3.0" as operand of "&"}
test expr-old-3.9 {illegal floating-point operations} -returnCodes error -body {
    expr {24.0 | 3}
} -result {can't use floating-point value "24.0" as operand of "|"}
test expr-old-3.10 {illegal floating-point operations} -returnCodes error -body {
    expr {24.0 ^ 3}
} -result {can't use floating-point value "24.0" as operand of "^"}

# Check the string operators individually.

test expr-old-4.1 {string operators} {expr {"abc" > "def"}} 0
test expr-old-4.2 {string operators} {expr {"def" > "def"}} 0
test expr-old-4.3 {string operators} {expr {"g" > "def"}} 1
test expr-old-4.4 {string operators} {expr {"abc" < "abd"}} 1
................................................................................
test expr-old-4.29 {string operators} {expr {"0" == "+"}} 0
test expr-old-4.30 {string operators} {expr {"0" == "-"}} 0
test expr-old-4.31 {string operators} {expr {1?"foo":"bar"}} foo
test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar

# Operators that aren't legal on string operands.

test expr-old-5.1 {illegal string operations} -returnCodes error -body {
    expr {-"a"}
} -result {can't use non-numeric string "a" as operand of "-"}
test expr-old-5.2 {illegal string operations} -returnCodes error -body {
    expr {+"a"}
} -result {can't use non-numeric string "a" as operand of "+"}
test expr-old-5.3 {illegal string operations} -returnCodes error -body {
    expr {~"a"}
} -result {can't use non-numeric string "a" as operand of "~"}
test expr-old-5.4 {illegal string operations} -returnCodes error -body {
    expr {!"a"}
} -result {can't use non-numeric string "a" as operand of "!"}
test expr-old-5.5 {illegal string operations} -returnCodes error -body {
    expr {"a" * "b"}
} -result {can't use non-numeric string "a" as operand of "*"}
test expr-old-5.6 {illegal string operations} -returnCodes error -body {
    expr {"a" / "b"}
} -result {can't use non-numeric string "a" as operand of "/"}
test expr-old-5.7 {illegal string operations} -returnCodes error -body {
    expr {"a" % "b"}
} -result {can't use non-numeric string "a" as operand of "%"}
test expr-old-5.8 {illegal string operations} -returnCodes error -body {
    expr {"a" + "b"}
} -result {can't use non-numeric string "a" as operand of "+"}
test expr-old-5.9 {illegal string operations} -returnCodes error -body {
    expr {"a" - "b"}
} -result {can't use non-numeric string "a" as operand of "-"}
test expr-old-5.10 {illegal string operations} -returnCodes error -body {
    expr {"a" << "b"}
} -result {can't use non-numeric string "a" as operand of "<<"}
test expr-old-5.11 {illegal string operations} -returnCodes error -body {
    expr {"a" >> "b"}
} -result {can't use non-numeric string "a" as operand of ">>"}
test expr-old-5.12 {illegal string operations} -returnCodes error -body {
    expr {"a" & "b"}
} -result {can't use non-numeric string "a" as operand of "&"}
test expr-old-5.13 {illegal string operations} -returnCodes error -body {
    expr {"a" ^ "b"}
} -result {can't use non-numeric string "a" as operand of "^"}
test expr-old-5.14 {illegal string operations} -returnCodes error -body {
    expr {"a" | "b"}
} -result {can't use non-numeric string "a" as operand of "|"}
test expr-old-5.15 {illegal string operations} -returnCodes error -body {
    expr {"a" && "b"}
} -result {expected boolean value but got "a"}
test expr-old-5.16 {illegal string operations} -returnCodes error -body {
    expr {"a" || "b"}
} -result {expected boolean value but got "a"}
test expr-old-5.17 {illegal string operations} -returnCodes error -body {
    expr {"a" ? 4 : 2}
} -result {expected boolean value but got "a"}

# Check precedence pairwise.

test expr-old-6.1 {precedence checks} {expr {-~3}} 4
test expr-old-6.2 {precedence checks} {expr {-!3}} 0
test expr-old-6.3 {precedence checks} {expr {-~0}} 1

test expr-old-7.1 {precedence checks} {expr {2 * 4 / 6}} 1
test expr-old-7.2 {precedence checks} {expr {24 / 6 * 3}} 12
test expr-old-7.3 {precedence checks} {expr {24 / 6 / 2}} 2

test expr-old-8.1 {precedence checks} {expr {-2+4}} 2
test expr-old-8.2 {precedence checks} {expr {-2-4}} -6
test expr-old-8.3 {precedence checks} {expr {+2-4}} -2

test expr-old-9.1 {precedence checks} {expr {2*3+4}} 10
test expr-old-9.2 {precedence checks} {expr {8/2+4}} 8
test expr-old-9.3 {precedence checks} {expr {8%3+4}} 6
test expr-old-9.4 {precedence checks} {expr {2*3-1}} 5
test expr-old-9.5 {precedence checks} {expr {8/2-1}} 3
test expr-old-9.6 {precedence checks} {expr {8%3-1}} 1

test expr-old-10.1 {precedence checks} {expr {6-3-2}} 1

test expr-old-11.1 {precedence checks} {expr {7+1>>2}} 2
test expr-old-11.2 {precedence checks} {expr {7+1<<2}} 32
test expr-old-11.3 {precedence checks} {expr {7>>3-2}} 3
test expr-old-11.4 {precedence checks} {expr {7<<3-2}} 14

test expr-old-12.1 {precedence checks} {expr {6>>1>4}} 0
test expr-old-12.2 {precedence checks} {expr {6>>1<2}} 0
test expr-old-12.3 {precedence checks} {expr {6>>1>=3}} 1
test expr-old-12.4 {precedence checks} {expr {6>>1<=2}} 0
test expr-old-12.5 {precedence checks} {expr {6<<1>5}} 1
test expr-old-12.6 {precedence checks} {expr {6<<1<5}} 0
test expr-old-12.7 {precedence checks} {expr {5<=6<<1}} 1
test expr-old-12.8 {precedence checks} {expr {5>=6<<1}} 0

test expr-old-13.1 {precedence checks} {expr {2<3<4}} 1
test expr-old-13.2 {precedence checks} {expr {0<4>2}} 0
test expr-old-13.3 {precedence checks} {expr {4>2<1}} 0
test expr-old-13.4 {precedence checks} {expr {4>3>2}} 0
test expr-old-13.5 {precedence checks} {expr {4>3>=2}} 0
test expr-old-13.6 {precedence checks} {expr {4>=3>2}} 0
test expr-old-13.7 {precedence checks} {expr {4>=3>=2}} 0
test expr-old-13.8 {precedence checks} {expr {0<=4>=2}} 0
test expr-old-13.9 {precedence checks} {expr {4>=2<=0}} 0
test expr-old-13.10 {precedence checks} {expr {2<=3<=4}} 1

test expr-old-14.1 {precedence checks} {expr {1==4>3}} 1
test expr-old-14.2 {precedence checks} {expr {0!=4>3}} 1
test expr-old-14.3 {precedence checks} {expr {1==3<4}} 1
test expr-old-14.4 {precedence checks} {expr {0!=3<4}} 1
test expr-old-14.5 {precedence checks} {expr {1==4>=3}} 1
test expr-old-14.6 {precedence checks} {expr {0!=4>=3}} 1
test expr-old-14.7 {precedence checks} {expr {1==3<=4}} 1
test expr-old-14.8 {precedence checks} {expr {0!=3<=4}} 1
test expr-old-14.9 {precedence checks} {expr {1eq4>3}} 1
test expr-old-14.10 {precedence checks} {expr {0ne4>3}} 1
test expr-old-14.11 {precedence checks} {expr {1eq3<4}} 1
test expr-old-14.12 {precedence checks} {expr {0ne3<4}} 1
test expr-old-14.13 {precedence checks} {expr {1eq4>=3}} 1
test expr-old-14.14 {precedence checks} {expr {0ne4>=3}} 1
test expr-old-14.15 {precedence checks} {expr {1eq3<=4}} 1
test expr-old-14.16 {precedence checks} {expr {0ne3<=4}} 1

test expr-old-15.1 {precedence checks} {expr {1==3==3}} 0
test expr-old-15.2 {precedence checks} {expr {3==3!=2}} 1
test expr-old-15.3 {precedence checks} {expr {2!=3==3}} 0
test expr-old-15.4 {precedence checks} {expr {2!=1!=1}} 0
test expr-old-15.5 {precedence checks} {expr {1eq3eq3}} 0
test expr-old-15.6 {precedence checks} {expr {3eq3ne2}} 1
test expr-old-15.7 {precedence checks} {expr {2ne3eq3}} 0
test expr-old-15.8 {precedence checks} {expr {2ne1ne1}} 0

test expr-old-16.1 {precedence checks} {expr {2&3eq2}} 0
test expr-old-16.2 {precedence checks} {expr {1&3ne3}} 0
test expr-old-16.3 {precedence checks} {expr {2&3eq2}} 0
test expr-old-16.4 {precedence checks} {expr {1&3ne3}} 0

test expr-old-17.1 {precedence checks} {expr {7&3^0x10}} 19
test expr-old-17.2 {precedence checks} {expr {7^0x10&3}} 7

test expr-old-18.1 {precedence checks} {expr {7^0x10|3}} 23
test expr-old-18.2 {precedence checks} {expr {7|0x10^3}} 23

test expr-old-19.1 {precedence checks} {expr {7|3&&1}} 1
test expr-old-19.2 {precedence checks} {expr {1&&3|7}} 1
test expr-old-19.3 {precedence checks} {expr {0&&1||1}} 1
test expr-old-19.4 {precedence checks} {expr {1||1&&0}} 1

test expr-old-20.1 {precedence checks} {expr {1||0?3:4}} 3
test expr-old-20.2 {precedence checks} {expr {1?0:4||1}} 0
test expr-old-20.3 {precedence checks} {expr {1?2:0?3:4}} 2
test expr-old-20.4 {precedence checks} {expr {0?2:0?3:4}} 4
test expr-old-20.5 {precedence checks} {expr {1?2?3:4:0}} 3
test expr-old-20.6 {precedence checks} {expr {0?2?3:4:0}} 0

# Parentheses.

test expr-old-21.1 {parenthesization} {expr {(2+4)*6}} 36
test expr-old-21.2 {parenthesization} {expr {(1?0:4)||1}} 1
test expr-old-21.3 {parenthesization} {expr {+(3-4)}} -1

# Embedded commands and variable names.

set a 16
test expr-old-22.1 {embedded variables} {expr {2*$a}} 32
test expr-old-22.2 {embedded variables} {
    set x -5
................................................................................
} {5}
test expr-old-22.3 {embedded variables} {
    set x "  -5"
    set y "  +10"
    expr {$x + $y}
} {5}
test expr-old-22.4 {embedded commands and variables} {expr {[set a] - 14}} 2
test expr-old-22.5 {embedded commands and variables} -returnCodes error -body {
    expr {12 - [bad_command_name]}
} -result {invalid command name "bad_command_name"}

# Double-quotes and things inside them.

test expr-old-23.1 {double quotes} {expr {"abc"}} abc
test expr-old-23.2 {double quotes} {
    set a 189
    expr {"$a.bc"}
................................................................................
} {1 Testing}
test expr-old-23.8 {double quotes} {
    list [catch {expr {"12398712938788234-1298379" != ""}} msg] $msg
} {0 1}

# Numbers in various bases.

test expr-old-24.1 {numbers in different bases} {expr {0x20}} 32
test expr-old-24.2 {numbers in different bases} {expr {0o15}} 13

# Conversions between various data types.

test expr-old-25.1 {type conversions} {expr {2+2.5}} 4.5
test expr-old-25.2 {type conversions} {expr {2.5+2}} 4.5
test expr-old-25.3 {type conversions} {expr {2-2.5}} -0.5
test expr-old-25.4 {type conversions} {expr {2/2.5}} 0.8
test expr-old-25.5 {type conversions} {expr {2>2.5}} 0
test expr-old-25.6 {type conversions} {expr {2.5>2}} 1
test expr-old-25.7 {type conversions} {expr {2<2.5}} 1
test expr-old-25.8 {type conversions} {expr {2>=2.5}} 0
test expr-old-25.9 {type conversions} {expr {2<=2.5}} 1
test expr-old-25.10 {type conversions} {expr {2==2.5}} 0
test expr-old-25.11 {type conversions} {expr {2!=2.5}} 1
test expr-old-25.12 {type conversions} {expr {2>"ab"}} 0
test expr-old-25.13 {type conversions} {expr {2>" "}} 1
test expr-old-25.14 {type conversions} {expr {"24.1a" > 24.1}} 1
test expr-old-25.15 {type conversions} {expr {24.1 > "24.1a"}} 0
test expr-old-25.16 {type conversions} {expr {2+2.5}} 4.5
test expr-old-25.17 {type conversions} {expr {2+2.5}} 4.5
test expr-old-25.18 {type conversions} {expr {2.0e2}} 200.0
test expr-old-25.19 {type conversions} {expr {2.0e15}} 2000000000000000.0
test expr-old-25.20 {type conversions} {expr {10.0}} 10.0

# Various error conditions.

test expr-old-26.1 {error conditions} -returnCodes error -body {
    expr {2 + "a"}
} -result {can't use non-numeric string "a" as operand of "+"}
test expr-old-26.2 {error conditions} -body {
    expr {2 + 4 *}
} -returnCodes error -match glob -result *
test expr-old-26.3 {error conditions} -body {
    expr {2 + 4 * (}
} -returnCodes error -match glob -result *
unset -nocomplain _non_existent_
test expr-old-26.4 {error conditions} -returnCodes error -body {
    expr {2 + $_non_existent_}
} -result {can't read "_non_existent_": no such variable}
set a xx
test expr-old-26.5 {error conditions} -returnCodes error -body {
    expr {2+$a}
} -result {can't use non-numeric string "xx" as operand of "+"}
test expr-old-26.6 {error conditions} -returnCodes error -body {
    expr {2+[set a]}
} -result {can't use non-numeric string "xx" as operand of "+"}
test expr-old-26.7 {error conditions} -body {
    expr {2+(4}
} -returnCodes error -match glob -result *
test expr-old-26.8 {error conditions} {
    list [catch {expr {2 / 0}} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
test expr-old-26.9 {error conditions} {
    list [catch {expr {2 % 0}} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
test expr-old-26.10a {error conditions} !ieeeFloatingPoint {
    list [catch {expr {2.0 / 0.0}} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
test expr-old-26.10b {error conditions} ieeeFloatingPoint {
    list [catch {expr {2.0 / 0.0}} msg] $msg
} {0 Inf}
test expr-old-26.11 {error conditions} -body {
    expr {2#}
} -returnCodes error -match glob -result *
test expr-old-26.12 {error conditions} -body {
    expr {a.b}
} -returnCodes error -match glob -result *
test expr-old-26.13 {error conditions} -returnCodes error -body {
    expr {"a"/"b"}
} -result {can't use non-numeric string "a" as operand of "/"}
test expr-old-26.14 {error conditions} -body {
    expr {2:3}
} -returnCodes error -match glob -result *
test expr-old-26.15 {error conditions} -body {
    expr {[email protected]}
} -returnCodes error -match glob -result *
test expr-old-26.16 {error conditions} -returnCodes error -body {
    expr "\$a+\[b"
} -match glob -result {missing close-bracket*}
test expr-old-26.17 {error conditions} -body {
    expr {a`b}
} -returnCodes error -match glob -result *
test expr-old-26.18 {error conditions} -body {
    expr \"a\"\{b
} -returnCodes error -match glob -result *
test expr-old-26.19 {error conditions} -body {
    expr a
} -returnCodes error -match glob -result *
test expr-old-26.20 {error conditions} -returnCodes error -body {
    expr
} -result {wrong # args: should be "expr expression"}
test expr-old-26.21 {error conditions} -returnCodes error -body {
    expr +1 +2
} -result {wrong # args: should be "expr expression"}

# Cancelled evaluation.

test expr-old-27.1 {cancelled evaluation} {
    set a 1
    expr {0&&[set a 2]}
    set a
................................................................................
test expr-old-30.2 {long values} {
    set a "000000000000000000000000000000"
    set a "$a$a$a$a$a$a$a$a$a$a$a$a$a$a$a$a${a}5"
    expr $a
} 5

# Expressions spanning multiple arguments













# TIP 526: expr-old-31.* now irrelevant

# Math functions

test expr-old-32.1 {math functions in expressions} {
    format %.6g [expr {acos(0.5)}]
} {1.0472}
test expr-old-32.2 {math functions in expressions} {
    format %.6g [expr {asin(0.5)}]
} {0.523599}
test expr-old-32.3 {math functions in expressions} {
    format %.6g [expr {atan(1.0)}]
} {0.785398}
test expr-old-32.4 {math functions in expressions} {
    format %.6g [expr {atan2(2.0, 2.0)}]
} {0.785398}
test expr-old-32.5 {math functions in expressions} {
    format %.6g [expr {ceil(1.999)}]
} {2}
test expr-old-32.6 {math functions in expressions} {
    format %.6g [expr {cos(.1)}]
} {0.995004}
test expr-old-32.7 {math functions in expressions} {
    format %.6g [expr {cosh(.1)}]
} {1.005}
test expr-old-32.8 {math functions in expressions} {
    format %.6g [expr {exp(1.0)}]
} {2.71828}
test expr-old-32.9 {math functions in expressions} {
    format %.6g [expr {floor(2.000)}]
} {2}
test expr-old-32.10 {math functions in expressions} {
    format %.6g [expr {floor(2.001)}]
} {2}
test expr-old-32.11 {math functions in expressions} {
    format %.6g [expr {fmod(7.3, 3.2)}]
} {0.9}
test expr-old-32.12 {math functions in expressions} {
    format %.6g [expr {hypot(3.0, 4.0)}]
} {5}
test expr-old-32.13 {math functions in expressions} {
    format %.6g [expr {log(2.8)}]
} {1.02962}
test expr-old-32.14 {math functions in expressions} {
    format %.6g [expr {log10(2.8)}]
} {0.447158}
test expr-old-32.15 {math functions in expressions} {
    format %.6g [expr {pow(2.1, 3.1)}]
} {9.97424}
test expr-old-32.16 {math functions in expressions} {
    format %.6g [expr {sin(.1)}]
} {0.0998334}
test expr-old-32.17 {math functions in expressions} {
    format %.6g [expr {sinh(.1)}]
} {0.100167}
test expr-old-32.18 {math functions in expressions} {
    format %.6g [expr {sqrt(2.0)}]
} {1.41421}
test expr-old-32.19 {math functions in expressions} {
    format %.6g [expr {tan(0.8)}]
} {1.02964}
test expr-old-32.20 {math functions in expressions} {
    format %.6g [expr {tanh(0.8)}]
} {0.664037}
test expr-old-32.21 {math functions in expressions} {
    format %.6g [expr {abs(-1.8)}]
} {1.8}
test expr-old-32.22 {math functions in expressions} {
    expr {abs(10.0)}
} {10.0}
test expr-old-32.23 {math functions in expressions} {
    format %.6g [expr {abs(-4)}]
} {4}
test expr-old-32.24 {math functions in expressions} {
    format %.6g [expr {abs(66)}]
} {66}

test expr-old-32.25a {math functions in expressions} {
    expr {abs(0x8000000000000000)}
} [expr {1 << 63}]

test expr-old-32.25b {math functions in expressions} {
    expr {abs(0x80000000)}
} 2147483648

test expr-old-32.26 {math functions in expressions} {
    expr {double(1)}
} {1.0}
test expr-old-32.27 {math functions in expressions} {
    expr {double(1.1)}
} {1.1}
test expr-old-32.28 {math functions in expressions} {
    expr {int(1)}
} {1}
test expr-old-32.29 {math functions in expressions} {
    expr {int(1.4)}
} {1}
test expr-old-32.30 {math functions in expressions} {
    expr {int(1.6)}
} {1}
test expr-old-32.31 {math functions in expressions} {
    expr {int(-1.4)}
} {-1}
test expr-old-32.32 {math functions in expressions} {
    expr {int(-1.6)}
} {-1}
test expr-old-32.33 {math functions in expressions} {
    expr {int(1e60)}
} 999999999999999949387135297074018866963645011013410073083904
test expr-old-32.34 {math functions in expressions} {
    expr {int(-1e60)}
} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.35 {math functions in expressions} {
    expr {round(1.49)}
} {1}
test expr-old-32.36 {math functions in expressions} {
    expr {round(1.51)}
} {2}
test expr-old-32.37 {math functions in expressions} {
    expr {round(-1.49)}
} {-1}
test expr-old-32.38 {math functions in expressions} {
    expr {round(-1.51)}
} {-2}
test expr-old-32.39 {math functions in expressions} {
    expr {round(1e60)}
} 999999999999999949387135297074018866963645011013410073083904
test expr-old-32.40 {math functions in expressions} {
    expr {round(-1e60)}
} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.41 {math functions in expressions} {
    list [catch {expr {pow(1.0 + 3.0 - 2, .8 * 5)}} msg] $msg
} {0 16.0}
test expr-old-32.42 {math functions in expressions} {
    list [catch {expr {hypot(5*.8, 3)}} msg] $msg
} {0 5.0}
test expr-old-32.45 {math functions in expressions} {
    expr {(0 <= rand()) && (rand() < 1)}
} {1}
test expr-old-32.46 {math functions in expressions} -body {
    list [catch {expr rand(24)} msg] $msg
} -match glob -result {1 {too many arguments for math function*}}
test expr-old-32.47 {math functions in expressions} -body {
    list [catch {expr srand()} msg] $msg
} -match glob -result {1 {not enough arguments for math function*}}
test expr-old-32.48 {math functions in expressions} -body {
    expr {srand(3.79)}
} -returnCodes error -match glob -result *
test expr-old-32.49 {math functions in expressions} -body {
    expr {srand("")}
} -returnCodes error -match glob -result *
test expr-old-32.50 {math functions in expressions} {
    set result [expr {round(srand(12345) * 1000)}]
    for {set i 0} {$i < 10} {incr i} {
	lappend result [expr {round(rand() * 1000)}]
    }
    set result
} {97 834 948 36 12 51 766 585 914 784 333}
test expr-old-32.51 {math functions in expressions} -body {
    expr {srand([lindex "6ty" 0])}
} -returnCodes error -match glob -result *
test expr-old-32.52 {math functions in expressions} {
................................................................................
    expr {srand(int(1<<37)) < 1}
} {1}
test expr-old-32.53 {math functions in expressions} {
    expr {srand((1<<31) - 1) > 0}
} {1}

test expr-old-33.1 {conversions and fancy args to math functions} {
    expr {hypot ( 3 , 4 )}
} 5.0
test expr-old-33.2 {conversions and fancy args to math functions} {
    expr {hypot ( (2.0+1.0) , 4 )}
} 5.0
test expr-old-33.3 {conversions and fancy args to math functions} {
    expr {hypot ( 3 , (3.0 + 1.0) )}
} 5.0
test expr-old-33.4 {conversions and fancy args to math functions} {
    format %.6g [expr {cos(acos(0.1))}]
} 0.1

test expr-old-34.1 {errors in math functions} -returnCodes error -body {
    expr {func_2(1.0)}
} -match glob -result {* "*func_2"}
test expr-old-34.2 {errors in math functions} -body {
    expr {func|(1.0)}
} -returnCodes error -match glob -result *
test expr-old-34.3 {errors in math functions} -returnCodes error -body {
    expr {hypot("a b", 2.0)}
} -result {expected floating-point number but got "a b"}
test expr-old-34.4 {errors in math functions} -body {
    expr {hypot(1.0 2.0)}
} -returnCodes error -match glob -result *
test expr-old-34.5 {errors in math functions} -body {
    expr {hypot(1.0, 2.0}
} -returnCodes error -match glob -result *
test expr-old-34.6 {errors in math functions} -body {
    expr {hypot(1.0 ,}
} -returnCodes error -match glob -result *
test expr-old-34.7 {errors in math functions} -body {
    list [catch {expr hypot(1.0)} msg] $msg
} -match glob -result {1 {not enough arguments for math function*}}
test expr-old-34.8 {errors in math functions} -body {
    list [catch {expr {hypot(1.0, 2.0, 3.0)}} msg] $msg
} -match glob -result {1 {too many arguments for math function*}}
test expr-old-34.9 {errors in math functions} {
    list [catch {expr {acos(-2.0)}} msg] $msg $errorCode
} {1 {domain error: argument not in valid range} {ARITH DOMAIN {domain error: argument not in valid range}}}
test expr-old-34.10 {errors in math functions} {
    list [catch {expr {pow(-3, 1000001)}} msg] $msg
} {0 -Inf}
test expr-old-34.11a {errors in math functions} !ieeeFloatingPoint {
    list [catch {expr {pow(3, 1000001)}} msg] $msg $errorCode
} {1 {floating-point value too large to represent} {ARITH OVERFLOW {floating-point value too large to represent}}}
test expr-old-34.11b {errors in math functions} ieeeFloatingPoint {
    list [catch {expr {pow(3, 1000001)}} msg] $msg
} {0 Inf}
test expr-old-34.12a {errors in math functions} !ieeeFloatingPoint {
    list [catch {expr {-14.0 * exp(100000)}} msg] $msg $errorCode
} {1 {floating-point value too large to represent} {ARITH OVERFLOW {floating-point value too large to represent}}}
test expr-old-34.12b {errors in math functions} ieeeFloatingPoint {
    list [catch {expr {-14.0 * exp(100000)}} msg] $msg
} {0 -Inf}
test expr-old-34.13 {errors in math functions} {
    expr {wide(1.0e30)}
} 5076964154930102272
test expr-old-34.14 {errors in math functions} {
    expr {wide(-1.0e30)}
} -5076964154930102272
test expr-old-34.15 {errors in math functions} {
    expr {round(1.0e30)}
} 1000000000000000019884624838656
test expr-old-34.16 {errors in math functions} {
    expr {round(-1.0e30)}
} -1000000000000000019884624838656

test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
    expr {0o289}
} -returnCodes error -match glob -result {*invalid octal number*}
test expr-old-36.2 {ExprLooksLikeInt procedure} -returnCodes error -body {
    set x 0o289
    expr {$x + 1}
} -result {can't use non-numeric string "0o289" as operand of "+"}
test expr-old-36.3 {ExprLooksLikeInt procedure} {
    expr {0289.1}
} 289.1
test expr-old-36.4 {ExprLooksLikeInt procedure} {
    set x 0289.1
    expr {$x + 1}
} 290.1
test expr-old-36.5 {ExprLooksLikeInt procedure} {
    set x {  +22}
    expr {$x+1}
} 23
test expr-old-36.6 {ExprLooksLikeInt procedure} {
    set x {	-22}
    expr {$x + 1}
} -21
test expr-old-36.7 {ExprLooksLikeInt procedure} -returnCodes error -body {
    expr {nan}
} -result {domain error: argument not in valid range}
test expr-old-36.8 {ExprLooksLikeInt procedure} {
    expr {78e1}
} 780.0
test expr-old-36.9 {ExprLooksLikeInt procedure} {
    expr {24E1}
} 240.0
test expr-old-36.10 {ExprLooksLikeInt procedure} -body {
    expr {78e}
} -returnCodes error -match glob -result *

# test for [Bug #542588]
test expr-old-36.11 {ExprLooksLikeInt procedure} {
    # define a "too large integer"; this one works also for 64bit arith
    set x 665802003400000000000000
    expr {$x+1}
} 665802003400000000000001

# tests for [Bug #587140]
test expr-old-36.12 {ExprLooksLikeInt procedure} -returnCodes error -body {
    set x "10;"
    expr {$x + 1}
} -result {can't use non-numeric string "10;" as operand of "+"}
test expr-old-36.13 {ExprLooksLikeInt procedure} -returnCodes error -body {
    set x " +"
    expr {$x + 1}
} -result {can't use non-numeric string " +" as operand of "+"}
test expr-old-36.14 {ExprLooksLikeInt procedure} {
    set x "123456789012345678901234567890 "
    expr {$x + 1}
} 123456789012345678901234567891
test expr-old-36.15 {ExprLooksLikeInt procedure} -returnCodes error -body {
    set x "0o99 "
    expr {$x + 1}
} -result {can't use non-numeric string "0o99 " as operand of "+"}
test expr-old-36.16 {ExprLooksLikeInt procedure} {
    set x " 0xffffffffffffffffffffffffffffffffffffff  "
    expr {$x + 1}
} [expr {0x100000000000000000000000000000000000000}]

test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} testexprlong {
    testexprlong 4+1
} {This is a result: 5}
#Check for [Bug 1109484]
test expr-old-37.2 {Tcl_ExprLong handles wide ints gracefully} testexprlong {
    testexprlong wide(1)+2
................................................................................
#
# Test for bug #908375: rounding numbers that do not fit in a
# long but do fit in a wide
#

test expr-old-39.1 {Rounding with wide result} {
    set x 1.0e10
    set y [expr {$x + 0.1}]
    catch {
	set x [list [expr {$x == round($y)}] [expr {$x == -round(-$y)}]]
    }
    set x
} {1 1}
unset -nocomplain x y

#
# TIP #255 min and max math functions
................................................................................
test expr-old-40.5 {min math function} -body {
    expr {min("a", 0)}
} -returnCodes error -match glob -result *
test expr-old-40.6 {min math function} -body {
    expr {min(300, "0xFF")}
} -result 255
test expr-old-40.7 {min math function} -body {
    expr {min("1[string repeat 0 10000]", 1e300)}
} -result 1e+300
test expr-old-40.8 {min math function} -body {
    expr {min(0, "a")}
} -returnCodes error -match glob -result *

test expr-old-41.1 {max math function} -body {
    expr {max(0)}
................................................................................
test expr-old-41.5 {max math function} -body {
    expr {max("a", 0)}
} -returnCodes error -match glob -result *
test expr-old-41.6 {max math function} -body {
    expr {max(200, "0xFF")}
} -result 255
test expr-old-41.7 {max math function} -body {
    expr {max("1[string repeat 0 10000]", 1e300)}
} -result 1[string repeat 0 10000]
test expr-old-41.8 {max math function} -body {
    expr {max(0, "a")}
} -returnCodes error -match glob -result *

# Special test for Pentium arithmetic bug of 1994:

    return $result
}
 
# start of tests

catch {unset a b i x}

test expr-1.1 {TclCompileExprCmd: no expression} {
    list [catch {expr  } msg] $msg
} {1 {wrong # args: should be "expr arg ?arg ...?"}}
test expr-1.2 {TclCompileExprCmd: one expression word} {
    expr -25
} -25
test expr-1.3 {TclCompileExprCmd: two expression words} {
    expr -8.2   -6
} -14.2
test expr-1.4 {TclCompileExprCmd: five expression words} {
    expr 20 - 5 +10 -7
} 18
test expr-1.5 {TclCompileExprCmd: quoted expression word} {
    expr "0005"
} 5
test expr-1.6 {TclCompileExprCmd: quoted expression word} {
    catch {expr "0005"zxy} msg
    set msg
} {extra characters after close-quote}
................................................................................
test expr-1.13 {TclCompileExprCmd: second level of substitutions in expr not in braces with single var reference} {
    set a xxx
    set x 27;  set bool {$x};  if $bool {set a foo}
    set a
} foo
test expr-1.14 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} {
    set a xxx
    set x 2;  set b {$x};  set a [expr $b == 2]
    set a
} 1
test expr-1.15 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} {
    set a xxx
    set x 2;  set b {$x};  set a [expr $b eq 2]
    set a
} 1

test expr-2.1 {TclCompileExpr: are builtin functions registered?} {
    expr double(5*[llength "6 2"])
} 10.0
test expr-2.2 {TclCompileExpr: error in expr} -body {
................................................................................
    list [catch {expr 1?{$a}:0} msg] $msg
} {1 {can't read "a": no such variable}}
test expr-20.5 {proper double evaluation compilation, working case} {
    set a yellow
    expr 1?{$a}:0
} yellow
test expr-20.6 {handling of compile error in trial compile} {
    list [catch {expr + {[incr]}} msg] $msg
} {1 {wrong # args: should be "incr varName ?increment?"}}
test expr-20.7 {handling of compile error in runtime case} {
    list [catch {expr + {[error foo]}} msg] $msg
} {1 foo}

# Test for non-numeric boolean literal handling
test expr-21.1 	{non-numeric boolean literals} {expr false } false
test expr-21.2 	{non-numeric boolean literals} {expr true  } true
test expr-21.3 	{non-numeric boolean literals} {expr off   } off
test expr-21.4 	{non-numeric boolean literals} {expr on    } on
................................................................................
	test expr-31.$i.5.$j {boolean conversion} {
	    expr bool("[string range $s 0 $j]")
	} 0
	incr j
    }
    incr i
}
test expr-31.3.4.0 {boolean conversion} {expr bool(n)} 0
test expr-31.3.5.0 {boolean conversion} {expr bool("n")} 0
test expr-31.4.4.0 {boolean conversion} {expr bool(f)} 0
test expr-31.4.5.0 {boolean conversion} {expr bool("f")} 0
test expr-31.6  {boolean conversion} {expr bool(-1 + 1)} 0
test expr-31.7  {boolean conversion} {expr bool(0 + 1)} 1
test expr-31.8  {boolean conversion} {expr bool(0.0)} 0
test expr-31.9  {boolean conversion} {expr bool(0x0)} 0
test expr-31.10 {boolean conversion} {expr bool(wide(0))} 0
test expr-31.11 {boolean conversion} {expr bool(5.0)} 1
test expr-31.12 {boolean conversion} {expr bool(5)} 1
test expr-31.13 {boolean conversion} {expr bool(0x5)} 1
test expr-31.14 {boolean conversion} {expr bool(wide(5))} 1
test expr-31.15 {boolean conversion} -body {
    expr bool("fred")
} -returnCodes error -match glob -result *

test expr-32.1 {expr mod basics} {
    set mod_nums [list \
        {-3 1} {-3 2} {-3 3} {-3 4} {-3 5} \
        {-3 -1} {-3 -2} {-3 -3} {-3 -4} {-3 -5} \
        {-2 1} {-2 2} {-2 3} {-2 4} {-2 5} \

    return $result
}
 
# start of tests

catch {unset a b i x}

test expr-1.1 {TclCompileExprCmd: no expression} -body {
    expr
} -returnCodes error -result {wrong # args: should be "expr expression"}
test expr-1.2 {TclCompileExprCmd: one expression word} {
    expr +25
} 25
test expr-1.3 {TclCompileExprCmd: two arguments} -body {
    expr +1 +2
} -returnCodes error -result {wrong # args: should be "expr expression"}
# 1.4 no longer applies


test expr-1.5 {TclCompileExprCmd: quoted expression word} {
    expr "0005"
} 5
test expr-1.6 {TclCompileExprCmd: quoted expression word} {
    catch {expr "0005"zxy} msg
    set msg
} {extra characters after close-quote}
................................................................................
test expr-1.13 {TclCompileExprCmd: second level of substitutions in expr not in braces with single var reference} {
    set a xxx
    set x 27;  set bool {$x};  if $bool {set a foo}
    set a
} foo
test expr-1.14 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} {
    set a xxx
    set x 2;  set b {$x};  set a [expr $b==2]
    set a
} 1
test expr-1.15 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} {
    set a xxx
    set x 2;  set b {$x};  set a [expr "$b eq 2"]
    set a
} 1

test expr-2.1 {TclCompileExpr: are builtin functions registered?} {
    expr double(5*[llength "6 2"])
} 10.0
test expr-2.2 {TclCompileExpr: error in expr} -body {
................................................................................
    list [catch {expr 1?{$a}:0} msg] $msg
} {1 {can't read "a": no such variable}}
test expr-20.5 {proper double evaluation compilation, working case} {
    set a yellow
    expr 1?{$a}:0
} yellow
test expr-20.6 {handling of compile error in trial compile} {
    list [catch {expr {+[incr]}} msg] $msg
} {1 {wrong # args: should be "incr varName ?increment?"}}
test expr-20.7 {handling of compile error in runtime case} {
    list [catch {expr {+[error foo]}} msg] $msg
} {1 foo}

# Test for non-numeric boolean literal handling
test expr-21.1 	{non-numeric boolean literals} {expr false } false
test expr-21.2 	{non-numeric boolean literals} {expr true  } true
test expr-21.3 	{non-numeric boolean literals} {expr off   } off
test expr-21.4 	{non-numeric boolean literals} {expr on    } on
................................................................................
	test expr-31.$i.5.$j {boolean conversion} {
	    expr bool("[string range $s 0 $j]")
	} 0
	incr j
    }
    incr i
}
test expr-31.3.4.0 {boolean conversion} {expr {bool(n)}} 0
test expr-31.3.5.0 {boolean conversion} {expr {bool("n")}} 0
test expr-31.4.4.0 {boolean conversion} {expr {bool(f)}} 0
test expr-31.4.5.0 {boolean conversion} {expr {bool("f")}} 0
test expr-31.6  {boolean conversion} {expr {bool(-1 + 1)}} 0
test expr-31.7  {boolean conversion} {expr {bool(0 + 1)}} 1
test expr-31.8  {boolean conversion} {expr {bool(0.0)}} 0
test expr-31.9  {boolean conversion} {expr {bool(0x0)}} 0
test expr-31.10 {boolean conversion} {expr {bool(wide(0))}} 0
test expr-31.11 {boolean conversion} {expr {bool(5.0)}} 1
test expr-31.12 {boolean conversion} {expr {bool(5)}} 1
test expr-31.13 {boolean conversion} {expr {bool(0x5)}} 1
test expr-31.14 {boolean conversion} {expr {bool(wide(5))}} 1
test expr-31.15 {boolean conversion} -body {
    expr {bool("fred")}
} -returnCodes error -match glob -result *

test expr-32.1 {expr mod basics} {
    set mod_nums [list \
        {-3 1} {-3 2} {-3 3} {-3 4} {-3 5} \
        {-3 -1} {-3 -2} {-3 -3} {-3 -4} {-3 -5} \
        {-2 1} {-2 2} {-2 3} {-2 4} {-2 5} \

}

# Check "for" and its use of continue and break.

catch {unset a i}
test for-old-1.1 {for tests} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} {
	set a [concat $a $i]
    }
    set a
} {1 2 3 4 5}
test for-old-1.2 {for tests} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==4 continue
	set a [concat $a $i]
    }
    set a
} {1 2 3 5}
test for-old-1.3 {for tests} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==4 break
	set a [concat $a $i]
    }
    set a
} {1 2 3}
test for-old-1.4 {for tests} {catch {for 1 2 3} msg} 1
test for-old-1.5 {for tests} {
    catch {for 1 2 3} msg
................................................................................
test for-old-1.6 {for tests} {catch {for 1 2 3 4 5} msg} 1
test for-old-1.7 {for tests} {
    catch {for 1 2 3 4 5} msg
    set msg
} {wrong # args: should be "for start test next command"}
test for-old-1.8 {for tests} {
    set a {xyz}
    for {set i 1} {$i<6} {set i [expr $i+1]} {}
    set a
} xyz
test for-old-1.9 {for tests} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]; if $i==4 break} {
	set a [concat $a $i]
    }
    set a
} {1 2 3}

# cleanup
::tcltest::cleanupTests
return

}

# Check "for" and its use of continue and break.

catch {unset a i}
test for-old-1.1 {for tests} {
    set a {}
    for {set i 1} {$i<6} {incr i} {
	set a [concat $a $i]
    }
    set a
} {1 2 3 4 5}
test for-old-1.2 {for tests} {
    set a {}
    for {set i 1} {$i<6} {incr i} {
	if {$i==4} continue
	set a [concat $a $i]
    }
    set a
} {1 2 3 5}
test for-old-1.3 {for tests} {
    set a {}
    for {set i 1} {$i<6} {incr i} {
	if {$i==4} break
	set a [concat $a $i]
    }
    set a
} {1 2 3}
test for-old-1.4 {for tests} {catch {for 1 2 3} msg} 1
test for-old-1.5 {for tests} {
    catch {for 1 2 3} msg
................................................................................
test for-old-1.6 {for tests} {catch {for 1 2 3 4 5} msg} 1
test for-old-1.7 {for tests} {
    catch {for 1 2 3 4 5} msg
    set msg
} {wrong # args: should be "for start test next command"}
test for-old-1.8 {for tests} {
    set a {xyz}
    for {set i 1} {$i<6} {incr i} {}
    set a
} xyz
test for-old-1.9 {for tests} {
    set a {}
    for {set i 1} {$i<6} {incr i; if {$i==4} break} {
	set a [concat $a $i]
    }
    set a
} {1 2 3}

# cleanup
::tcltest::cleanupTests
return

    set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
catch {unset a}
test for-1.9 {TclCompileForCmd: simple command body} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==4 break
	set a [concat $a $i]
    }
    set a
} {1 2 3}
test for-1.10 {TclCompileForCmd: command body in quotes} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
    set a
} {xxxxx}
test for-1.11 {TclCompileForCmd: computed command body} {
    catch {unset x1}
    catch {unset bb}
    catch {unset x2}
    set x1 {append a x1; }
    set bb {break}
    set x2 {; append a x2}
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
    set a
} {x1}
test for-1.12 {TclCompileForCmd: error in "next" command} -body {
    catch {for {set i 0} {$i < 5} {set} {format $i}} msg
    set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
test for-1.13 {TclCompileForCmd: long command body} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==4 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
    set a
} {1 2 3}
test for-1.14 {TclCompileForCmd: for command result} {
    set a [for {set i 0} {$i < 5} {incr i} {}]
    set a
} {}
test for-1.15 {TclCompileForCmd: for command result} {
    set a [for {set i 0} {$i < 5} {incr i} {if $i==3 break}]
    set a
} {}

# Check "for" and "continue".

test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
    catch {continue foo} msg
................................................................................
    set msg
} {wrong # args: should be "continue"}
test for-2.2 {TclCompileContinueCmd: continue result} {
    catch continue
} 4
test for-2.3 {continue tests} {
    set a {}
    for {set i 1} {$i <= 4} {set i [expr $i+1]} {
	if {$i == 2} continue
	set a [concat $a $i]
    }
    set a
} {1 3 4}
test for-2.4 {continue tests} {
    set a {}
    for {set i 1} {$i <= 4} {set i [expr $i+1]} {
	if {$i != 2} continue
	set a [concat $a $i]
    }
    set a
} {2}
test for-2.5 {continue tests, nested loops} {
    set msg {}
................................................................................
            set msg [concat $msg "$i.$a"]
        }
    }
    set msg
} {1.1 1.2 2.1 3.1 4.1}
test for-2.6 {continue tests, long command body} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==2 continue
	if $i==4 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
            set msg [concat $msg "$i.$a"]
        }
    }
    set msg
} {1.1 1.2 2.1 3.1 4.1}
test for-3.5 {break tests, long command body} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==2 continue
	if $i==5 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if $i==4 break
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
	    if {[regexp {^[ 	]*$} $line] || [regexp {^--+} $line]} {
		set inheaders 0
	    }
	    if {[regexp -nocase {^x-mailer:} $line]} {
		continue
	    }
	}
	if $inheaders {
	    set limit 55
	} else {
	    set limit 55
	    # Decide whether or not to break the body line
	    if {$plen > 0} {
		if {[string first {> } $line] == 0} {
		    # This is quoted text from previous message, don't reformat
................................................................................
		append result $line $NL
		if {[string length $F1] == 0} {
		    set F1 -1
		}
		continue
	    }
	}
	set climit [expr $limit-1]
	set cutoff 50
	set continuation 0

	while {[string length $line] > $limit} {
	    for {set c [expr $limit-1]} {$c >= $cutoff} {incr c -1} {
		set char [string index $line $c]
		if {$char == " " || $char == "\t"} {
		    break
		}
		if {$char == ">"} {	;# Hack for enriched formatting
		    break
		}
	    }
	    if {$c < $cutoff} {
		if {! $inheaders} {
		    set c [expr $limit-1]
		} else {
		    set c [string length $line]
		}
	    }
	    set newline [string trimright [string range $line 0 $c]]
	    if {! $continuation} {
		append result $newline $NL
................................................................................
}

# Check that "break" resets the interpreter's result

test for-4.1 {break must reset the interp result} {
    catch {
        set z GLOBTESTDIR/dir2/file2.c
        if [string match GLOBTESTDIR/dir2/* $z] {
            break
        }
    } j
    set j
} {}

# Test for incorrect "double evaluation" semantics
................................................................................
"set"
    ("for" body line 1)
    invoked from within
"$z {set i 0} {$i < 5} {incr i} {set}"}
test for-6.10 {Tcl_ForObjCmd: simple command body} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==4 break
	set a [concat $a $i]
    }
    set a
} {1 2 3}
test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
    set a
} {xxxxx}
test for-6.12 {Tcl_ForObjCmd: computed command body} {
    set z for
    catch {unset x1}
    catch {unset bb}
    catch {unset x2}
    set x1 {append a x1; }
    set bb {break}
    set x2 {; append a x2}
    set a {}
    $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
    set a
} {x1}
test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body {
    set z for
    catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg
    set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
................................................................................
"set"
    ("for" loop-end command)
    invoked from within
"$z {set i 0} {$i < 5} {set} {set j 4}"}
test for-6.14 {Tcl_ForObjCmd: long command body} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==4 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg

    set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
catch {unset a}
test for-1.9 {TclCompileForCmd: simple command body} {
    set a {}
    for {set i 1} {$i<6} {incr i} {
	if {$i==4} break
	set a [concat $a $i]
    }
    set a
} {1 2 3}
test for-1.10 {TclCompileForCmd: command body in quotes} {
    set a {}
    for {set i 1} {$i<6} {incr i} "append a x"
    set a
} {xxxxx}
test for-1.11 {TclCompileForCmd: computed command body} {
    catch {unset x1}
    catch {unset bb}
    catch {unset x2}
    set x1 {append a x1; }
    set bb {break}
    set x2 {; append a x2}
    set a {}
    for {set i 1} {$i<6} {incr i} $x1$bb$x2
    set a
} {x1}
test for-1.12 {TclCompileForCmd: error in "next" command} -body {
    catch {for {set i 0} {$i < 5} {set} {format $i}} msg
    set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
test for-1.13 {TclCompileForCmd: long command body} {
    set a {}
    for {set i 1} {$i<6} {incr i} {
	if {$i==4} break
	if {$i>5} continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
    set a
} {1 2 3}
test for-1.14 {TclCompileForCmd: for command result} {
    set a [for {set i 0} {$i < 5} {incr i} {}]
    set a
} {}
test for-1.15 {TclCompileForCmd: for command result} {
    set a [for {set i 0} {$i < 5} {incr i} {if {$i==3} break}]
    set a
} {}

# Check "for" and "continue".

test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
    catch {continue foo} msg
................................................................................
    set msg
} {wrong # args: should be "continue"}
test for-2.2 {TclCompileContinueCmd: continue result} {
    catch continue
} 4
test for-2.3 {continue tests} {
    set a {}
    for {set i 1} {$i <= 4} {incr i} {
	if {$i == 2} continue
	set a [concat $a $i]
    }
    set a
} {1 3 4}
test for-2.4 {continue tests} {
    set a {}
    for {set i 1} {$i <= 4} {incr i} {
	if {$i != 2} continue
	set a [concat $a $i]
    }
    set a
} {2}
test for-2.5 {continue tests, nested loops} {
    set msg {}
................................................................................
            set msg [concat $msg "$i.$a"]
        }
    }
    set msg
} {1.1 1.2 2.1 3.1 4.1}
test for-2.6 {continue tests, long command body} {
    set a {}
    for {set i 1} {$i<6} {incr i} {
	if {$i==2} continue
	if {$i==4} break
	if {$i>5} continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
            set msg [concat $msg "$i.$a"]
        }
    }
    set msg
} {1.1 1.2 2.1 3.1 4.1}
test for-3.5 {break tests, long command body} {
    set a {}
    for {set i 1} {$i<6} {incr i} {
	if {$i==2} continue
	if {$i==5} break
	if {$i>5} continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i==4} break
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
	    if {[regexp {^[ 	]*$} $line] || [regexp {^--+} $line]} {
		set inheaders 0
	    }
	    if {[regexp -nocase {^x-mailer:} $line]} {
		continue
	    }
	}
	if {$inheaders} {
	    set limit 55
	} else {
	    set limit 55
	    # Decide whether or not to break the body line
	    if {$plen > 0} {
		if {[string first {> } $line] == 0} {
		    # This is quoted text from previous message, don't reformat
................................................................................
		append result $line $NL
		if {[string length $F1] == 0} {
		    set F1 -1
		}
		continue
	    }
	}
	set climit [expr {$limit-1}]
	set cutoff 50
	set continuation 0

	while {[string length $line] > $limit} {
	    for {set c [expr {$limit-1}]} {$c >= $cutoff} {incr c -1} {
		set char [string index $line $c]
		if {$char == " " || $char == "\t"} {
		    break
		}
		if {$char == ">"} {	;# Hack for enriched formatting
		    break
		}
	    }
	    if {$c < $cutoff} {
		if {! $inheaders} {
		    set c [expr {$limit-1}]
		} else {
		    set c [string length $line]
		}
	    }
	    set newline [string trimright [string range $line 0 $c]]
	    if {! $continuation} {
		append result $newline $NL
................................................................................
}

# Check that "break" resets the interpreter's result

test for-4.1 {break must reset the interp result} {
    catch {
        set z GLOBTESTDIR/dir2/file2.c
        if {[string match GLOBTESTDIR/dir2/* $z]} {
            break
        }
    } j
    set j
} {}

# Test for incorrect "double evaluation" semantics
................................................................................
"set"
    ("for" body line 1)
    invoked from within
"$z {set i 0} {$i < 5} {incr i} {set}"}
test for-6.10 {Tcl_ForObjCmd: simple command body} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {incr i} {
	if {$i==4} break
	set a [concat $a $i]
    }
    set a
} {1 2 3}
test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {incr i} "append a x"
    set a
} {xxxxx}
test for-6.12 {Tcl_ForObjCmd: computed command body} {
    set z for
    catch {unset x1}
    catch {unset bb}
    catch {unset x2}
    set x1 {append a x1; }
    set bb {break}
    set x2 {; append a x2}
    set a {}
    $z {set i 1} {$i<6} {incr i} $x1$bb$x2
    set a
} {x1}
test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body {
    set z for
    catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg
    set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
................................................................................
"set"
    ("for" loop-end command)
    invoked from within
"$z {set i 0} {$i < 5} {set} {set j 4}"}
test for-6.14 {Tcl_ForObjCmd: long command body} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {incr i} {
	if {$i==4} break
	if {$i>5} continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg

    lsort [foo x]
} [lsort {{0 zero} {1 one} {2 two} {3 three}}]

test foreach-4.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
    catch {unset x}
    foreach {12.0} {a b c} {
        set x 12.0
        set x [expr $x + 1]
    }
    set x
} 13.0

# Check "continue".

test foreach-5.1 {continue tests} {catch continue} 4

    lsort [foo x]
} [lsort {{0 zero} {1 one} {2 two} {3 three}}]

test foreach-4.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
    catch {unset x}
    foreach {12.0} {a b c} {
        set x 12.0
        set x [expr [concat $x + 1]]
    }
    set x
} 13.0

# Check "continue".

test foreach-5.1 {continue tests} {catch continue} 4

    set msg
} {expected integer but got "xyz"}
# Since "%zd" and "%td" are equivalent to "%lld" in 64-bit platforms and
# equivalent to "%d" in 32-bit platforms, they are really not useful in
# scripts, therefore they are not documented. It's intended use is through
# the function Tcl_AppendPrintfToObj (et al).
test format-8.24 {Undocumented formats} -body {
    format "%zd %td %d" [expr 2**30] [expr 2**30] [expr 2**30]
} -result {1073741824 1073741824 1073741824}
test format-8.25 {Undocumented formats} -constraints pointerIs64bit -body {
    format "%zd %td %lld" [expr 2**33] [expr 2**33] [expr 2**33]
} -result {8589934592 8589934592 8589934592}
# Since "%p" is equivalent to "%#llx" in 64-bit platforms and equivalent
# to "%#x" in 32-bit platforms, it are really not useful in scripts,
# therefore they are not documented. It's intended use is through the
# function Tcl_AppendPrintfToObj (et al).
test format-8.26 {Undocumented formats} -body {
    format "%p %#x" [expr 2**31] [expr 2**31]
} -result {0x80000000 0x80000000}
test format-8.27 {Undocumented formats} -constraints pointerIs64bit -body {
    format "%p %#llx" [expr 2**33] [expr 2**33]
} -result {0x200000000 0x200000000}

test format-9.1 {long result} {
    set a {1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
    format {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG %s %s} $a $a
} {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}

................................................................................
    catch {unset a}
    catch {unset b}
    catch {unset c}
    catch {unset d}
    set a 0.0000000000001
    set b 0.00000000000001
    set c 0.00000000000000001
    set d [expr $a + $b + $c]
    format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d
} {0.0000000000 0.000000000000 0.000000000000110 0.00000000000011001}
test format-13.2 {tcl_precision fuzzy comparison} {
    catch {unset a}
    catch {unset b}
    catch {unset c}
    catch {unset d}
    set a 0.000000000001
    set b 0.000000000000005
    set c 0.0000000000000008
    set d [expr $a + $b + $c]
    format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d
} {0.0000000000 0.000000000001 0.000000000001006 0.00000000000100580}
test format-13.3 {tcl_precision fuzzy comparison} {
    catch {unset a}
    catch {unset b}
    catch {unset c}
    set a 0.00000000000099
    set b 0.000000000000011
    set c [expr $a + $b]
    format {%0.10f %0.12f %0.15f %0.17f} $c $c $c $c
} {0.0000000000 0.000000000001 0.000000000001001 0.00000000000100100}
test format-13.4 {tcl_precision fuzzy comparison} {
    catch {unset a}
    catch {unset b}
    catch {unset c}
    set a 0.444444444444
    set b 0.33333333333333
    set c [expr $a + $b]
    format {%0.10f %0.12f %0.15f %0.16f} $c $c $c $c
} {0.7777777778 0.777777777777 0.777777777777330 0.7777777777773300}
test format-13.5 {tcl_precision fuzzy comparison} {
    catch {unset a}
    catch {unset b}
    catch {unset c}
    set a 0.444444444444
    set b 0.99999999999999
    set c [expr $a + $b]
    format {%0.10f %0.12f %0.15f} $c $c $c
} {1.4444444444 1.444444444444 1.444444444443990}

test format-14.1 {testing MAX_FLOAT_SIZE for 0 and 1} {
    format {%s} ""
} {}
test format-14.2 {testing MAX_FLOAT_SIZE for 0 and 1} {
................................................................................

set a "0123456789"
set b ""
for {set i 0} {$i < 290} {incr i} {
    append b $a
}
for {set i 290} {$i < 400} {incr i} {
    test format-16.[expr $i -289] {testing MAX_FLOAT_SIZE} {
        format {%s} $b
    } $b
    append b "x"
}

test format-17.1 {testing %d with wide} {longIs32bit wideIs64bit} {
    format %d 7810179016327718216

    set msg
} {expected integer but got "xyz"}
# Since "%zd" and "%td" are equivalent to "%lld" in 64-bit platforms and
# equivalent to "%d" in 32-bit platforms, they are really not useful in
# scripts, therefore they are not documented. It's intended use is through
# the function Tcl_AppendPrintfToObj (et al).
test format-8.24 {Undocumented formats} -body {
    format "%zd %td %d" [expr {2**30}] [expr {2**30}] [expr {2**30}]
} -result {1073741824 1073741824 1073741824}
test format-8.25 {Undocumented formats} -constraints pointerIs64bit -body {
    format "%zd %td %lld" [expr {2**33}] [expr {2**33}] [expr {2**33}]
} -result {8589934592 8589934592 8589934592}
# Since "%p" is equivalent to "%#llx" in 64-bit platforms and equivalent
# to "%#x" in 32-bit platforms, it are really not useful in scripts,
# therefore they are not documented. It's intended use is through the
# function Tcl_AppendPrintfToObj (et al).
test format-8.26 {Undocumented formats} -body {
    format "%p %#x" [expr {2**31}] [expr {2**31}]
} -result {0x80000000 0x80000000}
test format-8.27 {Undocumented formats} -constraints pointerIs64bit -body {
    format "%p %#llx" [expr {2**33}] [expr {2**33}]
} -result {0x200000000 0x200000000}

test format-9.1 {long result} {
    set a {1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
    format {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG %s %s} $a $a
} {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}

................................................................................
    catch {unset a}
    catch {unset b}
    catch {unset c}
    catch {unset d}
    set a 0.0000000000001
    set b 0.00000000000001
    set c 0.00000000000000001
    set d [expr {$a + $b + $c}]
    format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d
} {0.0000000000 0.000000000000 0.000000000000110 0.00000000000011001}
test format-13.2 {tcl_precision fuzzy comparison} {
    catch {unset a}
    catch {unset b}
    catch {unset c}
    catch {unset d}
    set a 0.000000000001
    set b 0.000000000000005
    set c 0.0000000000000008
    set d [expr {$a + $b + $c}]
    format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d
} {0.0000000000 0.000000000001 0.000000000001006 0.00000000000100580}
test format-13.3 {tcl_precision fuzzy comparison} {
    catch {unset a}
    catch {unset b}
    catch {unset c}
    set a 0.00000000000099
    set b 0.000000000000011
    set c [expr {$a + $b}]
    format {%0.10f %0.12f %0.15f %0.17f} $c $c $c $c
} {0.0000000000 0.000000000001 0.000000000001001 0.00000000000100100}
test format-13.4 {tcl_precision fuzzy comparison} {
    catch {unset a}
    catch {unset b}
    catch {unset c}
    set a 0.444444444444
    set b 0.33333333333333
    set c [expr {$a + $b}]
    format {%0.10f %0.12f %0.15f %0.16f} $c $c $c $c
} {0.7777777778 0.777777777777 0.777777777777330 0.7777777777773300}
test format-13.5 {tcl_precision fuzzy comparison} {
    catch {unset a}
    catch {unset b}
    catch {unset c}
    set a 0.444444444444
    set b 0.99999999999999
    set c [expr {$a + $b}]
    format {%0.10f %0.12f %0.15f} $c $c $c
} {1.4444444444 1.444444444444 1.444444444443990}

test format-14.1 {testing MAX_FLOAT_SIZE for 0 and 1} {
    format {%s} ""
} {}
test format-14.2 {testing MAX_FLOAT_SIZE for 0 and 1} {
................................................................................

set a "0123456789"
set b ""
for {set i 0} {$i < 290} {incr i} {
    append b $a
}
for {set i 290} {$i < 400} {incr i} {
    test format-16.[expr {$i - 289}] {testing MAX_FLOAT_SIZE} {
        format {%s} $b
    } $b
    append b "x"
}

test format-17.1 {testing %d with wide} {longIs32bit wideIs64bit} {
    format %d 7810179016327718216

 
# "history event"

test history-1.1 {event option} history {history event -1} \
	{set b [format {A test %s} string]}
test history-1.2 {event option} history {history event $num} \
	{set a 12345}
test history-1.3 {event option} history {history event [expr $num+2]} \
	{Another test}
test history-1.4 {event option} history {history event set} \
	{set b [format {A test %s} string]}
test history-1.5 {event option} history {history e "* a*"} \
	{set a 12345}
test history-1.6 {event option} history {catch {history event *gorp} msg} 1
test history-1.7 {event option} history {
................................................................................
    history add set\ c\ {a\nb\nc}
}
test history-5.1 {info option} history {history info} [format {%6d  set a {b
	c d e}
%6d  set b 1234
%6d  set c {a
	b
	c}} $num [expr $num+1] [expr $num+2]]
test history-5.2 {info option} history {history i 2} [format {%6d  set b 1234
%6d  set c {a
	b
	c}} [expr $num+1] [expr $num+2]]
test history-5.3 {info option} history {catch {history i 2 3}} 1
test history-5.4 {info option} history {
    catch {history i 2 3} msg
    set msg
} {wrong # args: should be "history info ?count?"}
test history-5.5 {info option} history {history} [format {%6d  set a {b
	c d e}
%6d  set b 1234
%6d  set c {a
	b
	c}} $num [expr $num+1] [expr $num+2]]

# "history keep"

if {[testConstraint history]} {
    history add "foo1"
    history add "foo2"
    history add "foo3"
    history keep 2
}
test history-6.1 {keep option} history {history event [expr [history n]-1]} foo3


test history-6.2 {keep option} history {history event -1} foo2
test history-6.3 {keep option} history {catch {history event -3}} 1
test history-6.4 {keep option} history {
    catch {history event -3} msg
    set msg
} {event "-3" is too far in the past}
if {[testConstraint history]} {
................................................................................

if {[testConstraint history]} {
    set num [history n]
    history add "Testing"
    history add "Testing2"
}
test history-7.1 {nextid option} history {history event} "Testing"
test history-7.2 {nextid option} history {history next} [expr $num+2]
test history-7.3 {nextid option} history {catch {history nextid garbage}} 1
test history-7.4 {nextid option} history {
    catch {history nextid garbage} msg
    set msg
} {wrong # args: should be "history nextid"}

# "history clear"
................................................................................
	    # Ignore the references due to calling this procedure
	    return [expr {$rc - 3}]
	}
    }
} -body {
    histtest eval {
	# A fresh object, refcount 1 from the variable we write it to
	set obj [expr rand()]
	set baseline [refcount $obj]
	lappend result [refcount $obj]
	history add [list list $obj]
	lappend result [refcount $obj]
	history clear
	lappend result [refcount $obj]
    }
................................................................................
	    # Ignore the references due to calling this procedure
	    return [expr {$rc - 3}]
	}
    }
} -body {
    histtest eval {
	# A fresh object, refcount 1 from the variable we write it to
	set obj [expr rand()]
	set baseline [refcount $obj]
	lappend result [refcount $obj]
	history add [list list $obj]
	lappend result [refcount $obj]
	rename history {}
	lappend result [refcount $obj]
    }

 
# "history event"

test history-1.1 {event option} history {history event -1} \
	{set b [format {A test %s} string]}
test history-1.2 {event option} history {history event $num} \
	{set a 12345}
test history-1.3 {event option} history {history event [expr {$num+2}]} \
	{Another test}
test history-1.4 {event option} history {history event set} \
	{set b [format {A test %s} string]}
test history-1.5 {event option} history {history e "* a*"} \
	{set a 12345}
test history-1.6 {event option} history {catch {history event *gorp} msg} 1
test history-1.7 {event option} history {
................................................................................
    history add set\ c\ {a\nb\nc}
}
test history-5.1 {info option} history {history info} [format {%6d  set a {b
	c d e}
%6d  set b 1234
%6d  set c {a
	b
	c}} $num [expr {$num+1}] [expr {$num+2}]]
test history-5.2 {info option} history {history i 2} [format {%6d  set b 1234
%6d  set c {a
	b
	c}} [expr {$num+1}] [expr {$num+2}]]
test history-5.3 {info option} history {catch {history i 2 3}} 1
test history-5.4 {info option} history {
    catch {history i 2 3} msg
    set msg
} {wrong # args: should be "history info ?count?"}
test history-5.5 {info option} history {history} [format {%6d  set a {b
	c d e}
%6d  set b 1234
%6d  set c {a
	b
	c}} $num [expr {$num+1}] [expr {$num+2}]]

# "history keep"

if {[testConstraint history]} {
    history add "foo1"
    history add "foo2"
    history add "foo3"
    history keep 2
}
test history-6.1 {keep option} history {
    history event [expr {[history n]-1}]
} foo3
test history-6.2 {keep option} history {history event -1} foo2
test history-6.3 {keep option} history {catch {history event -3}} 1
test history-6.4 {keep option} history {
    catch {history event -3} msg
    set msg
} {event "-3" is too far in the past}
if {[testConstraint history]} {
................................................................................

if {[testConstraint history]} {
    set num [history n]
    history add "Testing"
    history add "Testing2"
}
test history-7.1 {nextid option} history {history event} "Testing"
test history-7.2 {nextid option} history {history next} [expr {$num+2}]
test history-7.3 {nextid option} history {catch {history nextid garbage}} 1
test history-7.4 {nextid option} history {
    catch {history nextid garbage} msg
    set msg
} {wrong # args: should be "history nextid"}

# "history clear"
................................................................................
	    # Ignore the references due to calling this procedure
	    return [expr {$rc - 3}]
	}
    }
} -body {
    histtest eval {
	# A fresh object, refcount 1 from the variable we write it to
	set obj [expr {rand()}]
	set baseline [refcount $obj]
	lappend result [refcount $obj]
	history add [list list $obj]
	lappend result [refcount $obj]
	history clear
	lappend result [refcount $obj]
    }
................................................................................
	    # Ignore the references due to calling this procedure
	    return [expr {$rc - 3}]
	}
    }
} -body {
    histtest eval {
	# A fresh object, refcount 1 from the variable we write it to
	set obj [expr {rand()}]
	set baseline [refcount $obj]
	lappend result [refcount $obj]
	history add [list list $obj]
	lappend result [refcount $obj]
	rename history {}
	lappend result [refcount $obj]
    }

test http-3.1 {http::geturl} -returnCodes error -body {
    http::geturl -bogus flag
} -result {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate}
test http-3.2 {http::geturl} -returnCodes error -body {
    http::geturl http:junk
} -result {Unsupported URL: http:junk}
set url //${::HOST}:$port
set badurl //${::HOST}:[expr $port+1]
test http-3.3 {http::geturl} -body {
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>

test http-3.1 {http::geturl} -returnCodes error -body {
    http::geturl -bogus flag
} -result {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate}
test http-3.2 {http::geturl} -returnCodes error -body {
    http::geturl http:junk
} -result {Unsupported URL: http:junk}
set url //${::HOST}:$port
set badurl //${::HOST}:[expr {$port+1}]
test http-3.3 {http::geturl} -body {
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>

		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    }
    return $a
} -cleanup {
    unset a
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    } elseif 1<2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 6
    }
    return $a
} -cleanup {
    unset a
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    } elseif 1==2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 6
    } else {
	set a 7
	while {$a != "xxx"} {
	    break;
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 8
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 9
    }
    return $a
} -cleanup {
    unset a
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    }
    return $a
} -cleanup {
    unset a z
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    } elseif 1<2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 6
    }
    return $a
} -cleanup {
    unset a z
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    } elseif 1==2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 6
    } else {
	set a 7
	while {$a != "xxx"} {
	    break;
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 8
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 9
    }
    return $a
} -cleanup {
    unset a z

		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 3
    }
    return $a
} -cleanup {
    unset a
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 3
    } elseif 1<2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 6
    }
    return $a
} -cleanup {
    unset a
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 3
    } elseif 1==2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 6
    } else {
	set a 7
	while {$a != "xxx"} {
	    break;
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 8
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 9
    }
    return $a
} -cleanup {
    unset a
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 3
    }
    return $a
} -cleanup {
    unset a z
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 3
    } elseif 1<2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 6
    }
    return $a
} -cleanup {
    unset a z
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 3
    } elseif 1==2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 6
    } else {
	set a 7
	while {$a != "xxx"} {
	    break;
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 8
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
................................................................................
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 9
    }
    return $a
} -cleanup {
    unset a z

        set y [info level 1]
        list $x $y
    }
    t1 146 testString
} {1 {t1 146 testString}}
test info-9.3 {info level option} {
    proc t1 {a b} {
        t2 [expr $a*2] $b
    }
    proc t2 {x y} {
        list [info level] [info level 1] [info level 2] [info level -1] \
                [info level 0]
    }
    t1 146 {a {b c} {{{c}}}}
} {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}}

        set y [info level 1]
        list $x $y
    }
    t1 146 testString
} {1 {t1 146 testString}}
test info-9.3 {info level option} {
    proc t1 {a b} {
        t2 [expr {$a*2}] $b
    }
    proc t2 {x y} {
        list [info level] [info level 1] [info level 2] [info level -1] \
                [info level 0]
    }
    t1 146 {a {b c} {{{c}}}}
} {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}}

test interp-2.11 {anonymous interps vs existing procs} {
    set x [interp create]
    regexp "interp(\[0-9]+)" $x dummy thenum
    interp delete $x
    proc interp$thenum {} {}
    set x [interp create]
    regexp "interp(\[0-9]+)" $x dummy anothernum
    expr $anothernum > $thenum
} 1
test interp-2.12 {anonymous interps vs existing procs} {
    set x [interp create -safe]
    regexp "interp(\[0-9]+)" $x dummy thenum
    interp delete $x
    proc interp$thenum {} {}
    set x [interp create -safe]
    regexp "interp(\[0-9]+)" $x dummy anothernum
    expr $anothernum - $thenum
} 1
test interp-2.13 {correct default when no $path arg is given} -body {
    interp create --
} -match regexp -result {interp[0-9]+}

foreach i [interp children] {
    interp delete $i
................................................................................
} 0

# Recreate interpreter "a"
interp create a

# Part 5: Testing eval in interpreter object command and with interp command
test interp-6.1 {testing eval} {
    a eval expr 3 + 5
} 8
test interp-6.2 {testing eval} -returnCodes error -body {
    a eval foo
} -result {invalid command name "foo"}
test interp-6.3 {testing eval} {
    a eval {proc foo {} {expr 3 + 5}}
    a eval foo
} 8
catch {a eval {proc foo {} {expr 3 + 5}}}
test interp-6.4 {testing eval} {
    interp eval a foo
} 8
test interp-6.5 {testing eval} {
    interp create {a x2}
    interp eval {a x2} {proc frob {} {expr 4 * 9}}
    interp eval {a x2} frob
} 36
catch {interp create {a x2}}
test interp-6.6 {testing eval} -returnCodes error -body {
    interp eval {a x2} foo
} -result {invalid command name "foo"}

................................................................................
} ""
test interp-16.5 {testing deletion order, bgerror} {
    catch {interp delete xxx}
    interp create xxx
    xxx eval {proc bgerror {args} {exit}}
    xxx alias exit kill xxx
    proc kill {i} {interp delete $i}
    xxx eval after 100 expr a + b
    after 200
    update
    interp exists xxx
} 0

#
# Alias loop prevention testing.
................................................................................
    set l
} {foo {}}
test interp-19.9 {alias deletion, renaming} {
    catch {interp delete a}
    interp create a
    interp alias a foo a bar
    interp eval a rename foo blotz
    interp eval a {proc foo {} {expr 34 * 34}}
    interp alias a foo {}
    set l [interp eval a foo]
    interp delete a
    set l
} 1156

test interp-20.1 {interp hide, interp expose and interp invokehidden} {
................................................................................
	    set while while
	    $while {1} {
		# No bytecode at all here...
	    }
	}
    }
    # We use a time limit here; command limits don't trap this case
    $i limit time -seconds [expr {[clock seconds]+2}]
    $i eval foobar
} -returnCodes error -result {time limit exceeded} -cleanup {
    interp delete $i
}
test interp-34.4 {limits with callbacks: extending limits} -setup {
    set i [interp create]
    set a 0
................................................................................
	global c i
	set c b
	$i limit command -value $newlimit
    }
} -body {
    interp alias $i foo {} cb1
    set curlim [$i eval info cmdcount]
    $i limit command -command "cb2 [expr $curlim+100]" \
	    -value [expr {$curlim+10}]
    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
    list $a $b $c
} -result {6 4 b} -cleanup {
    interp delete $i
    rename cb1 {}
    rename cb2 {}
}
................................................................................
	global c i
	set c b
	$i limit command -value $newlimit
    }
} -body {
    interp alias $i foo {} cb1
    set curlim [$i eval info cmdcount]
    $i limit command -command "cb2 {}" -value [expr {$curlim+10}]
    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
    list $a $b $c
} -result {6 4 b} -cleanup {
    interp delete $i
    rename cb1 {}
    rename cb2 {}
}
................................................................................
	global c i
	set c b
	$i limit command -value {} -command {}
    }
} -body {
    interp alias $i foo {} cb1
    set curlim [$i eval info cmdcount]
    $i limit command -command cb2 -value [expr {$curlim+10}]
    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
    list $a $b $c
} -result {6 4 b} -cleanup {
    interp delete $i
    rename cb1 {}
    rename cb2 {}
}
................................................................................
	proc cb1 {} {
	    global c
	    incr ::$c
	}
	proc cb2 {args} {
	    global c i curlim
	    set c b
	    $i limit command -value [expr {$curlim+1000}]
	    trapToParent
	}
    }
    proc cb3 {} {
	global i subi
	interp alias [list $i $subi] foo {} cb4
	interp delete $i
................................................................................
    set n 0
    $i eval {
	set a 0
	set b 0
	set c a
	interp alias $i foo {} cb1
	set curlim [$i eval info cmdcount]
	$i limit command -command cb2 -value [expr {$curlim+10}]
    }
    $i eval {
	$i eval {
	    for {set i 0} {$i<10} {incr i} {foo}
	}
    }
    list $n [interp exists $i]
................................................................................
} -result {4 0} -cleanup {
    rename cb3 {}
    rename cb4 {}
}
# Bug 1085023
test interp-34.8 {time limits trigger in vwaits} -body {
    set i [interp create]
    interp limit $i time -seconds [expr {[clock seconds]+1}] -granularity 1
    $i eval {
	set x {}
	vwait x
    }
} -cleanup {
    interp delete $i
} -returnCodes error -result {limit exceeded}
................................................................................
    proc cb2 {} {
	global result
	lappend result cb2
    }
} -body {
    set i [interp create]
    set t0 [clock seconds]
    $i limit time -seconds [expr {$t0+1}] -granularity 1 \
	-command "cb1 $i [expr {$t0+2}]"
    set ::result {}
    lappend ::result [catch {
	$i eval {
	    for {set i 0} {$i<30} {incr i} {
		after 100
	    }
	}
................................................................................
	lappend result cb1
	set times [lassign $times t]
	$i limit time -seconds $t
    }
} -body {
    set i [interp create]
    set t0 [clock seconds]
    set ::times "[expr {$t0+2}] [expr {$t0+100}]"
    $i limit time -seconds [expr {$t0+1}] -granularity 1 -command "cb1 $i"
    set ::result {}
    lappend ::result [catch {
	$i eval {
	    for {set i 0} {$i<30} {incr i} {
		after 100
	    }
	}
................................................................................

test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup {
    catch {interp delete a}
    interp create a
    set result {}
} -body {
    interp create {a b} -safe
    lappend result [interp eval a {expr min(5,2,3)*max(7,13,11)}]
    lappend result [interp eval {a b} {expr min(5,2,3)*max(7,13,11)}]
} -cleanup {
    unset -nocomplain result
    interp delete a
} -result {26 26}

test interp-38.1 {interp debug one-way switch} -setup {
    catch {interp delete a}

test interp-2.11 {anonymous interps vs existing procs} {
    set x [interp create]
    regexp "interp(\[0-9]+)" $x dummy thenum
    interp delete $x
    proc interp$thenum {} {}
    set x [interp create]
    regexp "interp(\[0-9]+)" $x dummy anothernum
    expr {$anothernum > $thenum}
} 1
test interp-2.12 {anonymous interps vs existing procs} {
    set x [interp create -safe]
    regexp "interp(\[0-9]+)" $x dummy thenum
    interp delete $x
    proc interp$thenum {} {}
    set x [interp create -safe]
    regexp "interp(\[0-9]+)" $x dummy anothernum
    expr {$anothernum - $thenum}
} 1
test interp-2.13 {correct default when no $path arg is given} -body {
    interp create --
} -match regexp -result {interp[0-9]+}

foreach i [interp children] {
    interp delete $i
................................................................................
} 0

# Recreate interpreter "a"
interp create a

# Part 5: Testing eval in interpreter object command and with interp command
test interp-6.1 {testing eval} {
    a eval expr {{3 + 5}}
} 8
test interp-6.2 {testing eval} -returnCodes error -body {
    a eval foo
} -result {invalid command name "foo"}
test interp-6.3 {testing eval} {
    a eval {proc foo {} {expr {3 + 5}}}
    a eval foo
} 8
catch {a eval {proc foo {} {expr {3 + 5}}}}
test interp-6.4 {testing eval} {
    interp eval a foo
} 8
test interp-6.5 {testing eval} {
    interp create {a x2}
    interp eval {a x2} {proc frob {} {expr {4 * 9}}}
    interp eval {a x2} frob
} 36
catch {interp create {a x2}}
test interp-6.6 {testing eval} -returnCodes error -body {
    interp eval {a x2} foo
} -result {invalid command name "foo"}

................................................................................
} ""
test interp-16.5 {testing deletion order, bgerror} {
    catch {interp delete xxx}
    interp create xxx
    xxx eval {proc bgerror {args} {exit}}
    xxx alias exit kill xxx
    proc kill {i} {interp delete $i}
    xxx eval after 100 expr {a + b}
    after 200
    update
    interp exists xxx
} 0

#
# Alias loop prevention testing.
................................................................................
    set l
} {foo {}}
test interp-19.9 {alias deletion, renaming} {
    catch {interp delete a}
    interp create a
    interp alias a foo a bar
    interp eval a rename foo blotz
    interp eval a {proc foo {} {expr {34 * 34}}}
    interp alias a foo {}
    set l [interp eval a foo]
    interp delete a
    set l
} 1156

test interp-20.1 {interp hide, interp expose and interp invokehidden} {
................................................................................
	    set while while
	    $while {1} {
		# No bytecode at all here...
	    }
	}
    }
    # We use a time limit here; command limits don't trap this case
    $i limit time -seconds [expr {[clock seconds] + 2}]
    $i eval foobar
} -returnCodes error -result {time limit exceeded} -cleanup {
    interp delete $i
}
test interp-34.4 {limits with callbacks: extending limits} -setup {
    set i [interp create]
    set a 0
................................................................................
	global c i
	set c b
	$i limit command -value $newlimit
    }
} -body {
    interp alias $i foo {} cb1
    set curlim [$i eval info cmdcount]
    $i limit command -command "cb2 [expr {$curlim + 100}]" \
	    -value [expr {$curlim + 10}]
    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
    list $a $b $c
} -result {6 4 b} -cleanup {
    interp delete $i
    rename cb1 {}
    rename cb2 {}
}
................................................................................
	global c i
	set c b
	$i limit command -value $newlimit
    }
} -body {
    interp alias $i foo {} cb1
    set curlim [$i eval info cmdcount]
    $i limit command -command "cb2 {}" -value [expr {$curlim + 10}]
    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
    list $a $b $c
} -result {6 4 b} -cleanup {
    interp delete $i
    rename cb1 {}
    rename cb2 {}
}
................................................................................
	global c i
	set c b
	$i limit command -value {} -command {}
    }
} -body {
    interp alias $i foo {} cb1
    set curlim [$i eval info cmdcount]
    $i limit command -command cb2 -value [expr {$curlim + 10}]
    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
    list $a $b $c
} -result {6 4 b} -cleanup {
    interp delete $i
    rename cb1 {}
    rename cb2 {}
}
................................................................................
	proc cb1 {} {
	    global c
	    incr ::$c
	}
	proc cb2 {args} {
	    global c i curlim
	    set c b
	    $i limit command -value [expr {$curlim + 1000}]
	    trapToParent
	}
    }
    proc cb3 {} {
	global i subi
	interp alias [list $i $subi] foo {} cb4
	interp delete $i
................................................................................
    set n 0
    $i eval {
	set a 0
	set b 0
	set c a
	interp alias $i foo {} cb1
	set curlim [$i eval info cmdcount]
	$i limit command -command cb2 -value [expr {$curlim + 10}]
    }
    $i eval {
	$i eval {
	    for {set i 0} {$i<10} {incr i} {foo}
	}
    }
    list $n [interp exists $i]
................................................................................
} -result {4 0} -cleanup {
    rename cb3 {}
    rename cb4 {}
}
# Bug 1085023
test interp-34.8 {time limits trigger in vwaits} -body {
    set i [interp create]
    interp limit $i time -seconds [expr {[clock seconds] + 1}] -granularity 1
    $i eval {
	set x {}
	vwait x
    }
} -cleanup {
    interp delete $i
} -returnCodes error -result {limit exceeded}
................................................................................
    proc cb2 {} {
	global result
	lappend result cb2
    }
} -body {
    set i [interp create]
    set t0 [clock seconds]
    $i limit time -seconds [expr {$t0 + 1}] -granularity 1 \
	-command "cb1 $i [expr {$t0 + 2}]"
    set ::result {}
    lappend ::result [catch {
	$i eval {
	    for {set i 0} {$i<30} {incr i} {
		after 100
	    }
	}
................................................................................
	lappend result cb1
	set times [lassign $times t]
	$i limit time -seconds $t
    }
} -body {
    set i [interp create]
    set t0 [clock seconds]
    set ::times "[expr {$t0 + 2}] [expr {$t0 + 100}]"
    $i limit time -seconds [expr {$t0 + 1}] -granularity 1 -command "cb1 $i"
    set ::result {}
    lappend ::result [catch {
	$i eval {
	    for {set i 0} {$i<30} {incr i} {
		after 100
	    }
	}
................................................................................

test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup {
    catch {interp delete a}
    interp create a
    set result {}
} -body {
    interp create {a b} -safe
    lappend result [interp eval a {expr {min(5,2,3)*max(7,13,11)}}]
    lappend result [interp eval {a b} {expr {min(5,2,3)*max(7,13,11)}}]
} -cleanup {
    unset -nocomplain result
    interp delete a
} -result {26 26}

test interp-38.1 {interp debug one-way switch} -setup {
    catch {interp delete a}

# channels are added to the channel table of the interpreter.

test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
    set l1 [testchannel refcount stdin]
    eof stdin
    interp create x
    set l ""
    lappend l [expr [testchannel refcount stdin] - $l1]
    x eval {eof stdin}
    lappend l [expr [testchannel refcount stdin] - $l1]
    interp delete x
    lappend l [expr [testchannel refcount stdin] - $l1]
    set l
} {0 1 0}
test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
    set l1 [testchannel refcount stdout]
    eof stdin
    interp create x
    set l ""
    lappend l [expr [testchannel refcount stdout] - $l1]
    x eval {eof stdout}
    lappend l [expr [testchannel refcount stdout] - $l1]
    interp delete x
    lappend l [expr [testchannel refcount stdout] - $l1]
    set l
} {0 1 0}
test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
    set l1 [testchannel refcount stderr]
    eof stdin
    interp create x
    set l ""
    lappend l [expr [testchannel refcount stderr] - $l1]
    x eval {eof stderr}
    lappend l [expr [testchannel refcount stderr] - $l1]
    interp delete x
    lappend l [expr [testchannel refcount stderr] - $l1]
    set l
} {0 1 0}

test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
    file delete -force $path(test1)
    set l ""
    set f [open $path(test1) w]
................................................................................
} {6 6 0 6}

test io-26.1 {Tcl_GetChannelInstanceData} stdio {
    # "pid" command uses Tcl_GetChannelInstanceData
    # Don't care what pid is (but must be a number), just want to exercise it.

    set f [open "|[list [interpreter] << exit]"]
    expr [pid $f]
    close $f
} {}

# Test flushing. The functions tested here are FlushChannel.

test io-27.1 {FlushChannel, no output buffered} {
    file delete $path(test1)
................................................................................
    }
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation auto
    set c [read $f]
    close $f
    string length $c
} [expr 700*15+1]
test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
................................................................................
    }
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation crlf
    set c [read $f]
    close $f
    string length $c
} [expr 700*15+1]
test io-30.15 {Tcl_Write mixed, Tcl_Read auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\rhere
    close $f
    set f [open $path(test1) r]
................................................................................
    fconfigure $f -translation crlf
    set c ""
    while {[gets $f line] >= 0} {
	append c $line\n
    }
    close $f
    string length $c
} [expr 700*15+1]
test io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
................................................................................
    fconfigure $f -translation auto
    set c ""
    while {[gets $f line] >= 0} {
	append c $line\n
    }
    close $f
    string length $c
} [expr 700*15+1]

# Test Tcl_Read and buffering.

test io-32.1 {Tcl_Read, channel not readable} {
    list [catch {read stdout} msg] $msg
} {1 {channel "stdout" wasn't opened for reading}}
test io-32.2 {Tcl_Read, zero byte count} {
................................................................................
    close $f
    set x
} {zzy abzzy}
test io-40.2 {POSIX open access modes: CREAT} {unix} {
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT} 0o600]
    file stat $path(test3) stats
    set x [format "%#o" [expr $stats(mode)&0o777]]
    puts $f "line 1"
    close $f
    set f [open $path(test3) r]
    lappend x [gets $f]
    close $f
    set x
} {0o600 {line 1}}
test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
    # This test only works if your umask is 2, like ouster's.
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT}]
    close $f
    file stat $path(test3) stats
    format "%#o" [expr $stats(mode)&0o777]
} [format %#5o [expr {0o666 & ~ $umaskValue}]]
test io-40.4 {POSIX open access modes: CREAT} {
    file delete $path(test3)
    set f [open $path(test3) w]
    fconfigure $f -eofchar {}
    puts $f xyzzy
    close $f
................................................................................
} {0 0 ok}
test io-52.6 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation lf -blocking 0
    set s0 [fcopy $f1 $f2 -size [expr [file size $thisScript] + 5]]
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {("$s1" == "$s2") && ($s0 == $s1)} {
        lappend result ok
................................................................................
    set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
    set in [open $thisScript]	;# 126 K
    set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
    catch {unset fcopyTestDone}
    close $listen	;# This means the socket open never really succeeds
    fcopy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    if ![info exists fcopyTestDone] {
	vwait [namespace which -variable fcopyTestDone]		;# The error occurs here in the b.g.
    }
    close $in
    close $out
    set fcopyTestDone	;# 1 for error condition
} 1
test io-53.6 {CopyData: error during fcopy} {stdio fcopy} {
................................................................................
    set f1 [open $path(pipe) w]
    puts $f1 "exit 1"
    close $f1
    set in [open "|[list [interpreter] $path(pipe)]" r+]
    set out [open $path(test1) w]
    fcopy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    if ![info exists fcopyTestDone] {
	vwait [namespace which -variable fcopyTestDone]
    }
    catch {close $in}
    close $out
    set fcopyTestDone	;# 0 for plain end of file
} {0}
proc doFcopy {in out {bytes 0} {error {}}} {
................................................................................
	exit 0
    }
    close $f1
    set in [open "|[list [interpreter] $path(pipe) &]" r+]
    set out [open $path(test1) w]
    doFcopy $in $out
    variable fcopyTestDone
    if ![info exists fcopyTestDone] {
	vwait [namespace which -variable fcopyTestDone]
    }
    catch {close $in}
    close $out
    # -1=error 0=script error N=number of bytes
    expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
} {3450}
test io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
    # copy progress callback. errors out intentionally
    proc ::cmd args {
	lappend ::RES "CMD $args"
	error !STOP
    }

# channels are added to the channel table of the interpreter.

test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
    set l1 [testchannel refcount stdin]
    eof stdin
    interp create x
    set l ""
    lappend l [expr {[testchannel refcount stdin] - $l1}]
    x eval {eof stdin}
    lappend l [expr {[testchannel refcount stdin] - $l1}]
    interp delete x
    lappend l [expr {[testchannel refcount stdin] - $l1}]
    set l
} {0 1 0}
test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
    set l1 [testchannel refcount stdout]
    eof stdin
    interp create x
    set l ""
    lappend l [expr {[testchannel refcount stdout] - $l1}]
    x eval {eof stdout}
    lappend l [expr {[testchannel refcount stdout] - $l1}]
    interp delete x
    lappend l [expr {[testchannel refcount stdout] - $l1}]
    set l
} {0 1 0}
test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
    set l1 [testchannel refcount stderr]
    eof stdin
    interp create x
    set l ""
    lappend l [expr {[testchannel refcount stderr] - $l1}]
    x eval {eof stderr}
    lappend l [expr {[testchannel refcount stderr] - $l1}]
    interp delete x
    lappend l [expr {[testchannel refcount stderr] - $l1}]
    set l
} {0 1 0}

test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
    file delete -force $path(test1)
    set l ""
    set f [open $path(test1) w]
................................................................................
} {6 6 0 6}

test io-26.1 {Tcl_GetChannelInstanceData} stdio {
    # "pid" command uses Tcl_GetChannelInstanceData
    # Don't care what pid is (but must be a number), just want to exercise it.

    set f [open "|[list [interpreter] << exit]"]
    expr {[pid $f] | 0}
    close $f
} {}

# Test flushing. The functions tested here are FlushChannel.

test io-27.1 {FlushChannel, no output buffered} {
    file delete $path(test1)
................................................................................
    }
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation auto
    set c [read $f]
    close $f
    string length $c
} [expr {700*15 + 1}]
test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
................................................................................
    }
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation crlf
    set c [read $f]
    close $f
    string length $c
} [expr {700*15 + 1}]
test io-30.15 {Tcl_Write mixed, Tcl_Read auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts $f hello\nthere\nand\rhere
    close $f
    set f [open $path(test1) r]
................................................................................
    fconfigure $f -translation crlf
    set c ""
    while {[gets $f line] >= 0} {
	append c $line\n
    }
    close $f
    string length $c
} [expr {700*15 + 1}]
test io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
................................................................................
    fconfigure $f -translation auto
    set c ""
    while {[gets $f line] >= 0} {
	append c $line\n
    }
    close $f
    string length $c
} [expr {700*15 + 1}]

# Test Tcl_Read and buffering.

test io-32.1 {Tcl_Read, channel not readable} {
    list [catch {read stdout} msg] $msg
} {1 {channel "stdout" wasn't opened for reading}}
test io-32.2 {Tcl_Read, zero byte count} {
................................................................................
    close $f
    set x
} {zzy abzzy}
test io-40.2 {POSIX open access modes: CREAT} {unix} {
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT} 0o600]
    file stat $path(test3) stats
    set x [format "%#o" [expr {$stats(mode) & 0o777}]]
    puts $f "line 1"
    close $f
    set f [open $path(test3) r]
    lappend x [gets $f]
    close $f
    set x
} {0o600 {line 1}}
test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
    # This test only works if your umask is 2, like ouster's.
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT}]
    close $f
    file stat $path(test3) stats
    format "%#o" [expr {$stats(mode) & 0o777}]
} [format %#5o [expr {0o666 & ~ $umaskValue}]]
test io-40.4 {POSIX open access modes: CREAT} {
    file delete $path(test3)
    set f [open $path(test3) w]
    fconfigure $f -eofchar {}
    puts $f xyzzy
    close $f
................................................................................
} {0 0 ok}
test io-52.6 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation lf -blocking 0
    set s0 [fcopy $f1 $f2 -size [expr {[file size $thisScript] + 5}]]
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {("$s1" == "$s2") && ($s0 == $s1)} {
        lappend result ok
................................................................................
    set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
    set in [open $thisScript]	;# 126 K
    set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
    catch {unset fcopyTestDone}
    close $listen	;# This means the socket open never really succeeds
    fcopy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    if {![info exists fcopyTestDone]} {
	vwait [namespace which -variable fcopyTestDone]		;# The error occurs here in the b.g.
    }
    close $in
    close $out
    set fcopyTestDone	;# 1 for error condition
} 1
test io-53.6 {CopyData: error during fcopy} {stdio fcopy} {
................................................................................
    set f1 [open $path(pipe) w]
    puts $f1 "exit 1"
    close $f1
    set in [open "|[list [interpreter] $path(pipe)]" r+]
    set out [open $path(test1) w]
    fcopy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    if {![info exists fcopyTestDone]} {
	vwait [namespace which -variable fcopyTestDone]
    }
    catch {close $in}
    close $out
    set fcopyTestDone	;# 0 for plain end of file
} {0}
proc doFcopy {in out {bytes 0} {error {}}} {
................................................................................
	exit 0
    }
    close $f1
    set in [open "|[list [interpreter] $path(pipe) &]" r+]
    set out [open $path(test1) w]
    doFcopy $in $out
    variable fcopyTestDone
    if {![info exists fcopyTestDone]} {
	vwait [namespace which -variable fcopyTestDone]
    }
    catch {close $in}
    close $out
    # -1=error 0=script error N=number of bytes
    expr {($fcopyTestDone == 0) ? $fcopyTestCount : -1}
} {3450}
test io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
    # copy progress callback. errors out intentionally
    proc ::cmd args {
	lappend ::RES "CMD $args"
	error !STOP
    }

concat {}

# Check that tclListObj.c's SetListFromAny handles possible overlarge
# string rep lengths in the source object.

proc slowsort list {
    set result {}
    set last [expr [llength $list] - 1]
    while {$last > 0} {
	set minIndex [expr [llength $list] - 1]
	set min [lindex $list $last]
	set i [expr $minIndex-1]
	while {$i >= 0} {
	    if {[string compare [lindex $list $i] $min] < 0} {
		set minIndex $i
		set min [lindex $list $i]
	    }
	    set i [expr $i-1]
	}
	set result [concat $result [list $min]]
	if {$minIndex == 0} {
	    set list [lrange $list 1 end]
	} else {
	    set list [concat [lrange $list 0 [expr $minIndex-1]] \
			  [lrange $list [expr $minIndex+1] end]]
	}
	set last [expr $last-1]
    }
    return [concat $result $list]
}
test list-3.1 {SetListFromAny and lrange/concat results} {
    slowsort {fred julie alex carol bill annie}
} {alex annie bill carol fred julie}

concat {}

# Check that tclListObj.c's SetListFromAny handles possible overlarge
# string rep lengths in the source object.

proc slowsort list {
    set result {}
    set last [expr {[llength $list] - 1}]
    while {$last > 0} {
	set minIndex [expr {[llength $list] - 1}]
	set min [lindex $list $last]
	set i [expr {$minIndex - 1}]
	while {$i >= 0} {
	    if {[string compare [lindex $list $i] $min] < 0} {
		set minIndex $i
		set min [lindex $list $i]
	    }
	    incr i -1
	}
	set result [concat $result [list $min]]
	if {$minIndex == 0} {
	    set list [lrange $list 1 end]
	} else {
	    set list [concat [lrange $list 0 [expr {$minIndex - 1}]] \
			  [lrange $list [expr {$minIndex + 1}] end]]
	}
	set last [expr {$last - 1}]
    }
    return [concat $result $list]
}
test list-3.1 {SetListFromAny and lrange/concat results} {
    slowsort {fred julie alex carol bill annie}
} {alex annie bill carol fred julie}

    }} x]
} -result [lsort {{0 zero} {1 one} {2 two} {3 three}}]
test lmap-7.2 {noncompiled lmap and shared variable or value list objects that are converted to another type} -setup {
    unset -nocomplain x
} -body {
    lmap {12.0} {a b c} {
        set x 12.0
        set x [expr $x + 1]
    }
} -result {13.0 13.0 13.0}
# Test for incorrect "double evaluation" semantics
test lmap-7.3 {delayed substitution of body} {
    apply {{} {
       set a 0
       lmap a [list 1 2 3] "

    }} x]
} -result [lsort {{0 zero} {1 one} {2 two} {3 three}}]
test lmap-7.2 {noncompiled lmap and shared variable or value list objects that are converted to another type} -setup {
    unset -nocomplain x
} -body {
    lmap {12.0} {a b c} {
        set x 12.0
        set x [expr [concat $x + 1]]
    }
} -result {13.0 13.0 13.0}
# Test for incorrect "double evaluation" semantics
test lmap-7.3 {delayed substitution of body} {
    apply {{} {
       set a 0
       lmap a [list 1 2 3] "

testConstraint teststaticpkg [llength [info commands teststaticpkg]]

# Test load-10.1 requires the 'testsimplefilesystem' command from tcltest

testConstraint testsimplefilesystem \
	[llength [info commands testsimplefilesystem]]
 
test load-1.1 {basic errors} {} {
    list [catch {load} msg] $msg
} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}"
test load-1.2 {basic errors} {} {
    list [catch {load a b c d} msg] $msg
} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}"
test load-1.3 {basic errors} {} {
    list [catch {load a b foobar} msg] $msg
} {1 {could not find interpreter "foobar"}}
test load-1.4 {basic errors} {} {
    list [catch {load -global {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.5 {basic errors} {} {
    list [catch {load -lazy {} {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.6 {basic errors} {} {
    list [catch {load {} Unknown} msg] $msg
} {1 {package "Unknown" isn't loaded statically}}
test load-1.7 {basic errors} {} {
    list [catch {load -abc foo} msg] $msg
} "1 {bad option \"-abc\": must be -global, -lazy, or --}"
test load-1.8 {basic errors} {} {
    list [catch {load -global} msg] $msg
} "1 {couldn't figure out package name for -global}"

test load-2.1 {basic loading, with guess for package name} \
	[list $dll $loaded] {
    load -global [file join $testDir pkga$ext]
    list [pkga_eq abc def] [lsort [info commands pkga_*]]
} {0 {pkga_eq pkga_quote}}
interp create -safe child
................................................................................
} {0 {}}
test load-4.2 {reloading package into same interpreter} -setup {
    catch {load [file join $testDir pkga$ext] pkga}
} -constraints [list $dll $loaded] -returnCodes error -body {
    load [file join $testDir pkga$ext] pkgb
} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""

test load-5.1 {file name not specified and no static package: pick default} \
	[list $dll $loaded] {
    catch {interp delete x}
    interp create x


    load -global [file join $testDir pkga$ext] pkga
    load {} pkga x
    set result [info loaded x]

    interp delete x
    set result
} [list [list [file join $testDir pkga$ext] Pkga]]

# On some platforms, like SunOS 4.1.3, these tests can't be run because
# they cause the process to exit.
#
# As of 2005, such ancient broken systems no longer matter.

test load-6.1 {errors loading file} [list $dll $loaded] {
................................................................................
    teststaticpkg More 0 1
} -constraints [list teststaticpkg $dll $loaded] -body {
    teststaticpkg Double 0 1
    teststaticpkg Double 0 1
    info loaded
} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]

testConstraint teststaticpkg_8.x \
    [if {[testConstraint teststaticpkg]} {

	teststaticpkg Test 1 1
	teststaticpkg Another 0 1
	teststaticpkg More 0 1
	teststaticpkg Double 0 1
	expr 1
    } else {
	expr 0
    }]

test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    lsort -index 1 [info loaded]
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]]
test load-8.2 {TclGetLoadedPackages procedure} -constraints {teststaticpkg_8.x} -body {
    info loaded gorp
} -returnCodes error -result {could not find interpreter "gorp"}
................................................................................
} [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
test load-8.4 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    load [file join $testDir pkgb$ext] pkgb
    list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]]
} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}]
interp delete child

test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} \
    -constraints {teststaticpkg} \
    -setup {
	interp create child1
	interp create child2
	load {} Tcltest child1
	load {} Tcltest child2
    } \
    -body {

	child1 eval { teststaticpkg Loadninepointone 0 1 }
	child2 eval { teststaticpkg Loadninepointone 0 1 }
	list \
	    [child1 eval { info loaded {} }] \
	    [child2 eval { info loaded {} }]
    } \



    -match glob -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}} \
    -cleanup { interp delete child1 ; interp delete child2 }

test load-10.1 {load from vfs} \



    -constraints [list $dll $loaded testsimplefilesystem] \
    -setup {set dir [pwd]; cd $testDir; testsimplefilesystem 1} \
    -body {list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg} \
    -result {0 {}} \
    -cleanup {testsimplefilesystem 0; cd $dir; unset dir}




test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \
	[list $dll $loaded] {
    load [file join $testDir pkgooa$ext]
    list [pkgooa_stubsok] [lsort [info commands pkgooa_*]]
} {1 pkgooa_stubsok}
 

testConstraint teststaticpkg [llength [info commands teststaticpkg]]

# Test load-10.1 requires the 'testsimplefilesystem' command from tcltest

testConstraint testsimplefilesystem \
	[llength [info commands testsimplefilesystem]]
 
test load-1.1 {basic errors} -returnCodes error -body {
    load
} -result {wrong # args: should be "load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?"}
test load-1.2 {basic errors} -returnCodes error -body {
    load a b c d
} -result {wrong # args: should be "load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?"}
test load-1.3 {basic errors} -returnCodes error -body {
    load a b foobar
} -result {could not find interpreter "foobar"}
test load-1.4 {basic errors} -returnCodes error -body {
    load -global {}
} -result {must specify either file name or package name}
test load-1.5 {basic errors} -returnCodes error -body {
    load -lazy {} {}
} -result {must specify either file name or package name}
test load-1.6 {basic errors} -returnCodes error -body {
    load {} Unknown
} -result {package "Unknown" isn't loaded statically}
test load-1.7 {basic errors} -returnCodes error -body {
    load -abc foo
} -result {bad option "-abc": must be -global, -lazy, or --}
test load-1.8 {basic errors} -returnCodes error -body {
    load -global
} -result {couldn't figure out package name for -global}

test load-2.1 {basic loading, with guess for package name} \
	[list $dll $loaded] {
    load -global [file join $testDir pkga$ext]
    list [pkga_eq abc def] [lsort [info commands pkga_*]]
} {0 {pkga_eq pkga_quote}}
interp create -safe child
................................................................................
} {0 {}}
test load-4.2 {reloading package into same interpreter} -setup {
    catch {load [file join $testDir pkga$ext] pkga}
} -constraints [list $dll $loaded] -returnCodes error -body {
    load [file join $testDir pkga$ext] pkgb
} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""

test load-5.1 {file name not specified and no static package: pick default} -setup {

    catch {interp delete x}
    interp create x
} -constraints [list $dll $loaded] -body {
} -constraints [list $dll $loaded] -body {
    load -global [file join $testDir pkga$ext] pkga
    load {} pkga x
    info loaded x
} -cleanup {
    interp delete x

} -result [list [list [file join $testDir pkga$ext] Pkga]]

# On some platforms, like SunOS 4.1.3, these tests can't be run because
# they cause the process to exit.
#
# As of 2005, such ancient broken systems no longer matter.

test load-6.1 {errors loading file} [list $dll $loaded] {
................................................................................
    teststaticpkg More 0 1
} -constraints [list teststaticpkg $dll $loaded] -body {
    teststaticpkg Double 0 1
    teststaticpkg Double 0 1
    info loaded
} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]

testConstraint teststaticpkg_8.x 0
if {[testConstraint teststaticpkg]} {
    catch {
	teststaticpkg Test 1 1
	teststaticpkg Another 0 1
	teststaticpkg More 0 1
	teststaticpkg Double 0 1
	testConstraint teststaticpkg_8.x 1
    }
}


test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    lsort -index 1 [info loaded]
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]]
test load-8.2 {TclGetLoadedPackages procedure} -constraints {teststaticpkg_8.x} -body {
    info loaded gorp
} -returnCodes error -result {could not find interpreter "gorp"}
................................................................................
} [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
test load-8.4 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    load [file join $testDir pkgb$ext] pkgb
    list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]]
} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}]
interp delete child

test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} -setup {


    interp create child1
    interp create child2
    load {} Tcltest child1
    load {} Tcltest child2


} -constraints {teststaticpkg} -body {
    child1 eval { teststaticpkg Loadninepointone 0 1 }
    child2 eval { teststaticpkg Loadninepointone 0 1 }

    list [child1 eval { info loaded {} }] \
	[child2 eval { info loaded {} }]

} -match glob -cleanup {
    interp delete child1
    interp delete child2
} -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}}


test load-10.1 {load from vfs} -setup {
    set dir [pwd]
    cd $testDir
    testsimplefilesystem 1
} -constraints [list $dll $loaded testsimplefilesystem] -body {

    list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg
} -result {0 {}} -cleanup {
    testsimplefilesystem 0
    cd $dir
    unset dir
}

test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \
	[list $dll $loaded] {
    load [file join $testDir pkgooa$ext]
    list [pkgooa_stubsok] [lsort [info commands pkgooa_*]]
} {1 pkgooa_stubsok}
 

    lsearch -start 2 -all -not -glob {a1 b2 a3 c4 a5 d6} a*
} {3 5}
test lsearch-14.8 {combinations: -start, -inline and -not} {
    lsearch -start 2 -inline -not -glob {a1 b2 a3 c4 a5 d6} a*
} {c4}

test lsearch-15.1 {make sure no shimmering occurs} {
    set x [expr int(sin(0))]
    lsearch -start $x $x $x
} 0

test lsearch-16.1 {lsearch -regexp shared object} {
    set str a
    lsearch -regexp $str $str
} 0

    lsearch -start 2 -all -not -glob {a1 b2 a3 c4 a5 d6} a*
} {3 5}
test lsearch-14.8 {combinations: -start, -inline and -not} {
    lsearch -start 2 -inline -not -glob {a1 b2 a3 c4 a5 d6} a*
} {c4}

test lsearch-15.1 {make sure no shimmering occurs} {
    set x [expr {int(sin(0))}]
    lsearch -start $x $x $x
} 0

test lsearch-16.1 {lsearch -regexp shared object} {
    set str a
    lsearch -regexp $str $str
} 0

        foreach op {& | ^} {
            lappend res [TestOp $op {*}$vals]
        }
    }
    set exp {}
    foreach d {5 7 2  1 D C  1 F E  0 -D -D  8 -9 -1  -0 -E E} {
        if {[string match "-*" $d]} {
            set d [format %X [expr 15-0x[string range $d 1 end]]]
            set val [expr -0x[string repeat $d $dig]-1]
        } else {
            set val [expr 0x[string repeat $d $dig]]
        }
        lappend exp $val
    }
    expr {$exp eq $res ? 1 : "($res != $exp"}
} 1
test mathop-22.3 { bitwise ops } {
    set big1      12135435435354435435342423948763867876

        foreach op {& | ^} {
            lappend res [TestOp $op {*}$vals]
        }
    }
    set exp {}
    foreach d {5 7 2  1 D C  1 F E  0 -D -D  8 -9 -1  -0 -E E} {
        if {[string match "-*" $d]} {
            set d [format %X [expr {15-"0x[string range $d 1 end]"}]]
            set val [expr {-"0x[string repeat $d $dig]"-1}]
        } else {
            set val [expr {"0x[string repeat $d $dig]"}]
        }
        lappend exp $val
    }
    expr {$exp eq $res ? 1 : "($res != $exp"}
} 1
test mathop-22.3 { bitwise ops } {
    set big1      12135435435354435435342423948763867876

test namespace-old-9.14 {imported commands can be removed} {
    namespace forget test_ns_import::cmd?
    list [lsort [info commands cmd?]] \
         [catch {cmd1 another test} msg] $msg
} {{} 1 {invalid command name "cmd1"}}
test namespace-old-9.15 {existing commands can't be overwritten} {
    proc cmd1 {x y} {
        return [expr $x+$y]
    }
    list [catch {namespace import test_ns_import::cmd?} msg] $msg \
         [cmd1 3 5]
} {1 {can't import command "cmd1": already exists} 8}
test namespace-old-9.16 {use "-force" option to override existing commands} {
    proc cmd1 {x y} { return [expr $x+$y] }
    list [cmd1 3 5] \
         [namespace import -force test_ns_import::cmd?] \
         [cmd1 3 5]
} {8 {} {cmd1: 3 5}}
test namespace-old-9.17 {commands can be imported into many namespaces} {
    namespace eval test_ns_import_use {
        namespace import ::test_ns_import::* ::test_ns_import2::ncmd?

test namespace-old-9.14 {imported commands can be removed} {
    namespace forget test_ns_import::cmd?
    list [lsort [info commands cmd?]] \
         [catch {cmd1 another test} msg] $msg
} {{} 1 {invalid command name "cmd1"}}
test namespace-old-9.15 {existing commands can't be overwritten} {
    proc cmd1 {x y} {
        return [expr {$x+$y}]
    }
    list [catch {namespace import test_ns_import::cmd?} msg] $msg \
         [cmd1 3 5]
} {1 {can't import command "cmd1": already exists} 8}
test namespace-old-9.16 {use "-force" option to override existing commands} {
    proc cmd1 {x y} { return [expr {$x+$y}] }
    list [cmd1 3 5] \
         [namespace import -force test_ns_import::cmd?] \
         [cmd1 3 5]
} {8 {} {cmd1: 3 5}}
test namespace-old-9.17 {commands can be imported into many namespaces} {
    namespace eval test_ns_import_use {
        namespace import ::test_ns_import::* ::test_ns_import2::ncmd?

test oo-13.5 {OO: changing an object's class: non-class to class} -setup {
    oo::object create fooObj
} -body {
    oo::objdefine fooObj {
	class oo::class
    }
    oo::define fooObj {
	method x {} {expr 1+2+3}
    }
    [fooObj new] x
} -cleanup {
    fooObj destroy
} -result 6
test oo-13.6 {OO: changing an object's class: class to non-class} -setup {
    oo::class create foo
    unset -nocomplain ::result
} -body {
    set result dangling
    oo::define foo {
	method x {} {expr 1+2+3}
    }
    oo::class create boo {
	superclass foo
	destructor {set ::result "ok"}
    }
    boo new
    foo create bar
................................................................................
test oo-13.7 {OO: changing an object's class} -setup {
    oo::class create foo
    oo::class create bar
    unset -nocomplain result
} -body {
    oo::define bar method x {} {return ok}
    oo::define foo {
	method x {} {expr 1+2+3}
	self mixin foo
    }
    lappend result [foo x]
    oo::objdefine foo class bar
    lappend result [foo x]
} -cleanup {
    foo destroy
    bar destroy
} -result {6 ok}
test oo-13.8 {OO: changing an object's class to itself} -setup {
    oo::class create foo
} -body {
    oo::define foo {
	method x {} {expr 1+2+3}
    }
    oo::objdefine foo class foo
} -cleanup {
    foo destroy
} -returnCodes error -result {may not change classes into an instance of themselves}
test oo-13.9 {OO: changing an object's class: roots are special} -setup {
    set i [interp create]

test oo-13.5 {OO: changing an object's class: non-class to class} -setup {
    oo::object create fooObj
} -body {
    oo::objdefine fooObj {
	class oo::class
    }
    oo::define fooObj {
	method x {} {expr {1+2+3}}
    }
    [fooObj new] x
} -cleanup {
    fooObj destroy
} -result 6
test oo-13.6 {OO: changing an object's class: class to non-class} -setup {
    oo::class create foo
    unset -nocomplain ::result
} -body {
    set result dangling
    oo::define foo {
	method x {} {expr {1+2+3}}
    }
    oo::class create boo {
	superclass foo
	destructor {set ::result "ok"}
    }
    boo new
    foo create bar
................................................................................
test oo-13.7 {OO: changing an object's class} -setup {
    oo::class create foo
    oo::class create bar
    unset -nocomplain result
} -body {
    oo::define bar method x {} {return ok}
    oo::define foo {
	method x {} {expr {1+2+3}}
	self mixin foo
    }
    lappend result [foo x]
    oo::objdefine foo class bar
    lappend result [foo x]
} -cleanup {
    foo destroy
    bar destroy
} -result {6 ok}
test oo-13.8 {OO: changing an object's class to itself} -setup {
    oo::class create foo
} -body {
    oo::define foo {
	method x {} {expr {1+2+3}}
    }
    oo::objdefine foo class foo
} -cleanup {
    foo destroy
} -returnCodes error -result {may not change classes into an instance of themselves}
test oo-13.9 {OO: changing an object's class: roots are special} -setup {
    set i [interp create]

#### functions tests #####

set n $::tcl::OptDescN

test opt-1.1 {OptKeyRegister / check that auto allocation is skipping existing keys} {
    list [::tcl::OptKeyRegister {} $n] [::tcl::OptKeyRegister {} [expr $n+1]] [::tcl::OptKeyRegister {}]
} "$n [expr $n+1] [expr $n+2]"

test opt-2.1 {OptKeyDelete} {
    list [::tcl::OptKeyRegister {} testkey] \
	    [info exists ::tcl::OptDesc(testkey)] \
	    [::tcl::OptKeyDelete testkey] \
	    [info exists ::tcl::OptDesc(testkey)]
} {testkey 1 {} 0}

#### functions tests #####

set n $::tcl::OptDescN

test opt-1.1 {OptKeyRegister / check that auto allocation is skipping existing keys} {
    list [::tcl::OptKeyRegister {} $n] [::tcl::OptKeyRegister {} [expr {$n+1}]] [::tcl::OptKeyRegister {}]
} "$n [expr {$n+1}] [expr {$n+2}]"

test opt-2.1 {OptKeyDelete} {
    list [::tcl::OptKeyRegister {} testkey] \
	    [info exists ::tcl::OptDesc(testkey)] \
	    [::tcl::OptKeyDelete testkey] \
	    [info exists ::tcl::OptDesc(testkey)]
} {testkey 1 {} 0}

test parse-10.1 {Tcl_EvalTokens, simple text} testevalex {
    testevalex {concat test}
} {test}
test parse-10.2 {Tcl_EvalTokens, backslash sequences} testevalex {
    testevalex {concat test\063\062test}
} {test32test}
test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex {
    testevalex {concat [expr 2 + 6]}
} {8}
test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex {
    unset -nocomplain a
    list [catch {testevalex {concat xxx[expr $a]}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex {
    set a hello
................................................................................
    unset -nocomplain a
    set a(12) 46
    testevalex {concat $a(12)}
} {46}
test parse-10.7 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
    set a(12) 46
    testevalex {concat $a(1[expr 3 - 1])}
} {46}
test parse-10.8 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
    list [catch {testevalex {concat $x($a)}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-10.9 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a

test parse-10.1 {Tcl_EvalTokens, simple text} testevalex {
    testevalex {concat test}
} {test}
test parse-10.2 {Tcl_EvalTokens, backslash sequences} testevalex {
    testevalex {concat test\063\062test}
} {test32test}
test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex {
    testevalex {concat [expr {2 + 6}]}
} {8}
test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex {
    unset -nocomplain a
    list [catch {testevalex {concat xxx[expr $a]}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex {
    set a hello
................................................................................
    unset -nocomplain a
    set a(12) 46
    testevalex {concat $a(12)}
} {46}
test parse-10.7 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
    set a(12) 46
    testevalex {concat $a(1[expr {3 - 1}])}
} {46}
test parse-10.8 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
    list [catch {testevalex {concat $x($a)}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-10.9 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a

format %s $b

]b
    set a
} a22b
test parseOld-4.4 {command substitution} {
    set a 7.7
    if [catch {expr int($a)}] {set a foo}
    set a
} 7.7

# Variable substitution.

test parseOld-5.1 {variable substitution} {
    set a 123

format %s $b

]b
    set a
} a22b
test parseOld-4.4 {command substitution} {
    set a 7.7
    if {[catch {expr {int($a)}}]} {set a foo}
    set a
} 7.7

# Variable substitution.

test parseOld-5.1 {variable substitution} {
    set a 123

#  This package is split into two files, to test packages that are split over
#  multiple files.
package provide pkg2 1.0
namespace eval pkg2 {
    namespace export p2-1
}
proc pkg2::p2-1 { num } {
    return [expr $num * 2]
}
} [file join pkg pkg2_a.tcl]

makeFile {
#  This package is required by pkg1.
#  This package is split into two files, to test packages that are split over
#  multiple files.
package provide pkg2 1.0
namespace eval pkg2 {
    namespace export p2-2
}
proc pkg2::p2-2 { num } {
    return [expr $num * 3]
}
} [file join pkg pkg2_b.tcl]

test pkgMkIndex-4.1 {split package} {
    pkgtest::runIndex -lazy $fullPkgPath pkg2_a.tcl pkg2_b.tcl
} {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}}}}

................................................................................

makeFile {
package provide pkg3 1.0
namespace eval pkg3 {
    namespace export p3-1 p3-2
}
proc pkg3::p3-1 { num } {
    return {[expr $num * 2]}
}
proc pkg3::p3-2 { num } {
    return {[expr $num * 3]}
}
} [file join pkg pkg3.tcl]

test pkgMkIndex-6.1 {pkg1 requires pkg3} {
    pkgtest::runIndex -lazy $fullPkgPath pkg1.tcl pkg3.tcl
} {0 {{pkg1:1.0 {tclPkgSetup {pkg1.tcl source {::pkg1::p1-1 ::pkg1::p1-2}}}} {pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}}}}

................................................................................
#  requires circ1 to give us a circularity.
package require circ3 1.0
package provide circ2 1.0
namespace eval circ2 {
    namespace export c2-1 c2-2
}
proc circ2::c2-1 { num } {
    return [expr $num * [circ3::c3-1]]
}
proc circ2::c2-2 { num } {
    return [expr $num * [circ3::c3-2]]
}
} [file join pkg circ2.tcl]

makeFile {
#  This package is required by circ2, and in turn requires circ1. This closes
#  the circularity.
package require circ1 1.0

#  This package is split into two files, to test packages that are split over
#  multiple files.
package provide pkg2 1.0
namespace eval pkg2 {
    namespace export p2-1
}
proc pkg2::p2-1 { num } {
    return [expr {$num * 2}]
}
} [file join pkg pkg2_a.tcl]

makeFile {
#  This package is required by pkg1.
#  This package is split into two files, to test packages that are split over
#  multiple files.
package provide pkg2 1.0
namespace eval pkg2 {
    namespace export p2-2
}
proc pkg2::p2-2 { num } {
    return [expr {$num * 3}]
}
} [file join pkg pkg2_b.tcl]

test pkgMkIndex-4.1 {split package} {
    pkgtest::runIndex -lazy $fullPkgPath pkg2_a.tcl pkg2_b.tcl
} {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}}}}

................................................................................

makeFile {
package provide pkg3 1.0
namespace eval pkg3 {
    namespace export p3-1 p3-2
}
proc pkg3::p3-1 { num } {
    return {[expr {$num * 2}]}
}
proc pkg3::p3-2 { num } {
    return {[expr {$num * 3}]}
}
} [file join pkg pkg3.tcl]

test pkgMkIndex-6.1 {pkg1 requires pkg3} {
    pkgtest::runIndex -lazy $fullPkgPath pkg1.tcl pkg3.tcl
} {0 {{pkg1:1.0 {tclPkgSetup {pkg1.tcl source {::pkg1::p1-1 ::pkg1::p1-2}}}} {pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}}}}

................................................................................
#  requires circ1 to give us a circularity.
package require circ3 1.0
package provide circ2 1.0
namespace eval circ2 {
    namespace export c2-1 c2-2
}
proc circ2::c2-1 { num } {
    return [expr {$num * [circ3::c3-1]}]
}
proc circ2::c2-2 { num } {
    return [expr {$num * [circ3::c3-2]}]
}
} [file join pkg circ2.tcl]

makeFile {
#  This package is required by circ2, and in turn requires circ1. This closes
#  the circularity.
package require circ1 1.0

catch {rename t1 ""}
catch {rename foo ""}

proc tproc {} {return a; return b}
test proc-old-1.1 {simple procedure call and return} {tproc} a
proc tproc x {
    set x [expr $x+1]
    return $x
}
test proc-old-1.2 {simple procedure call and return} {tproc 2} 3
test proc-old-1.3 {simple procedure call and return} {
    proc tproc {} {return foo}
} {}
test proc-old-1.4 {simple procedure call and return} {
................................................................................
    set x {}
    proc tproc {} {}   ;# body is shared with x
    list [tproc] [append x foo]
} {{} foo}

test proc-old-2.1 {local and global variables} {
    proc tproc x {
	set x [expr $x+1]
	return $x
    }
    set x 42
    list [tproc 6] $x
} {7 42}
test proc-old-2.2 {local and global variables} {
    proc tproc x {
	set y [expr $x+1]
	return $y
    }
    set y 18
    list [tproc 6] $y
} {7 18}
test proc-old-2.3 {local and global variables} {
    proc tproc x {
	global y
	set y [expr $x+1]
	return $y
    }
    set y 189
    list [tproc 6] $y
} {7 7}
test proc-old-2.4 {local and global variables} {
    proc tproc x {
	global y
	return [expr $x+$y]
    }
    set y 189
    list [tproc 6] $y
} {195 189}
catch {unset _undefined_}
test proc-old-2.5 {local and global variables} {
    proc tproc x {
................................................................................
} 1

test proc-old-10.1 {ByteCode epoch change during recursive proc execution} {
    proc t1 x {
        set y 20
        rename expr expr.old
        rename expr.old expr
        if $x then {t1 0} ;# recursive call after foo's code is invalidated
        return 20
    }
    t1 1
} 20

# cleanup
catch {rename t1 ""}
catch {rename foo ""}
::tcltest::cleanupTests
return

catch {rename t1 ""}
catch {rename foo ""}

proc tproc {} {return a; return b}
test proc-old-1.1 {simple procedure call and return} {tproc} a
proc tproc x {
    set x [expr {$x + 1}]
    return $x
}
test proc-old-1.2 {simple procedure call and return} {tproc 2} 3
test proc-old-1.3 {simple procedure call and return} {
    proc tproc {} {return foo}
} {}
test proc-old-1.4 {simple procedure call and return} {
................................................................................
    set x {}
    proc tproc {} {}   ;# body is shared with x
    list [tproc] [append x foo]
} {{} foo}

test proc-old-2.1 {local and global variables} {
    proc tproc x {
	set x [expr {$x + 1}]
	return $x
    }
    set x 42
    list [tproc 6] $x
} {7 42}
test proc-old-2.2 {local and global variables} {
    proc tproc x {
	set y [expr {$x + 1}]
	return $y
    }
    set y 18
    list [tproc 6] $y
} {7 18}
test proc-old-2.3 {local and global variables} {
    proc tproc x {
	global y
	set y [expr {$x + 1}]
	return $y
    }
    set y 189
    list [tproc 6] $y
} {7 7}
test proc-old-2.4 {local and global variables} {
    proc tproc x {
	global y
	return [expr {$x + $y}]
    }
    set y 189
    list [tproc 6] $y
} {195 189}
catch {unset _undefined_}
test proc-old-2.5 {local and global variables} {
    proc tproc x {
................................................................................
} 1

test proc-old-10.1 {ByteCode epoch change during recursive proc execution} {
    proc t1 x {
        set y 20
        rename expr expr.old
        rename expr.old expr
        if {$x} then {t1 0} ;# recursive call after foo's code is invalidated
        return 20
    }
    t1 1
} 20

# cleanup
catch {rename t1 ""}
catch {rename foo ""}
::tcltest::cleanupTests
return

         [namespace eval test_ns_1 {namespace which q:}] \
         [namespace eval test_ns_1 {namespace which value:at:}]
} -result {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:}
test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} -setup {
    catch {rename p ""}
} -returnCodes error -body {
    proc p {a(1) a(2)} {
	set z [expr $a(1)+$a(2)]
	puts "$z=z, $a(1)=$a(1)"
    }
} -result {formal parameter "a(1)" is an array element}
test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup {
    catch {rename p ""}
} -body {
    proc p {b:a b::a} {

         [namespace eval test_ns_1 {namespace which q:}] \
         [namespace eval test_ns_1 {namespace which value:at:}]
} -result {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:}
test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} -setup {
    catch {rename p ""}
} -returnCodes error -body {
    proc p {a(1) a(2)} {
	set z [expr {$a(1)+$a(2)}]
	puts "$z=z, $a(1)=$a(1)"
    }
} -result {formal parameter "a(1)" is an array element}
test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup {
    catch {rename p ""}
} -body {
    proc p {b:a b::a} {

    namespace import -force ::tcltest::*
}

test pwd-1.1 {simple pwd} {
    catch pwd
} 0
test pwd-1.2 {simple pwd} {
    expr [string length pwd]>0
} 1

test pwd-1.3 {pwd takes no args} -body {
    pwd foobar
} -returnCodes error -result "wrong \# args: should be \"pwd\""

# cleanup
::tcltest::cleanupTests
return

    namespace import -force ::tcltest::*
}

test pwd-1.1 {simple pwd} {
    catch pwd
} 0
test pwd-1.2 {simple pwd} {
    expr {[string length [pwd]]>0}
} 1

test pwd-2.1 {pwd takes no args} -body {
    pwd foobar
} -returnCodes error -result "wrong \# args: should be \"pwd\""

# cleanup
::tcltest::cleanupTests
return

    if {[info exists env(serverPort)]} {
	set serverPort $env(serverPort)
    }
}
if {![info exists serverPort]} {
    for {set i 0} {$i < $argc} {incr i} {
	if {[string compare -port [lindex $argv $i]] == 0} {
	    if {$i < [expr $argc - 1]} {
		set serverPort [lindex $argv [expr $i + 1]]
	    }
	    break
	}
    }
}
if {![info exists serverPort]} {
    set serverPort 2048
................................................................................
    if {[info exists env(serverAddress)]} {
	set serverAddress $env(serverAddress)
    }
}
if {![info exists serverAddress]} {
    for {set i 0} {$i < $argc} {incr i} {
	if {[string compare -address [lindex $argv $i]] == 0} {
	    if {$i < [expr $argc - 1]} {
		set serverAddress [lindex $argv [expr $i + 1]]
	    }
	    break
	}
    }
}
if {![info exists serverAddress]} {
    set serverAddress 0.0.0.0

    if {[info exists env(serverPort)]} {
	set serverPort $env(serverPort)
    }
}
if {![info exists serverPort]} {
    for {set i 0} {$i < $argc} {incr i} {
	if {[string compare -port [lindex $argv $i]] == 0} {
	    if {$i < $argc - 1} {
		set serverPort [lindex $argv [expr {$i + 1}]]
	    }
	    break
	}
    }
}
if {![info exists serverPort]} {
    set serverPort 2048
................................................................................
    if {[info exists env(serverAddress)]} {
	set serverAddress $env(serverAddress)
    }
}
if {![info exists serverAddress]} {
    for {set i 0} {$i < $argc} {incr i} {
	if {[string compare -address [lindex $argv $i]] == 0} {
	    if {$i < $argc - 1} {
		set serverAddress [lindex $argv [expr {$i + 1}]]
	    }
	    break
	}
    }
}
if {![info exists serverAddress]} {
    set serverAddress 0.0.0.0

    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
::tcltest::loadTestedCommands

if {[expr {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]} {
    return
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

# 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]]
................................................................................
    puts $f [list set localhost $localhost]
    puts $f {
	gets stdin port
	socket $localhost $port
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r+]
    proc accept {s a p} {expr 10 / 0}
    set s [socket -server accept -myaddr $localhost 0]
    puts $f [lindex [fconfigure $s -sockname] 2]
    close $f
    set timer [after 10000 "set x timed_out"]
    vwait x
    after cancel $timer
    close $s

    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
::tcltest::loadTestedCommands

if {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]} {
    return
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

# 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]]
................................................................................
    puts $f [list set localhost $localhost]
    puts $f {
	gets stdin port
	socket $localhost $port
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r+]
    proc accept {s a p} {expr {10 / 0}}
    set s [socket -server accept -myaddr $localhost 0]
    puts $f [lindex [fconfigure $s -sockname] 2]
    close $f
    set timer [after 10000 "set x timed_out"]
    vwait x
    after cancel $timer
    close $s

test string-6.26.$noComp {string is digit, false} {
    list [run {string is digit -fail var +123567}] $var
} {0 0}
test string-6.27.$noComp {string is double, true} {
    run {string is double 1}
} 1
test string-6.28.$noComp {string is double, true} {
    run {string is double [expr double(1)]}
} 1
test string-6.29.$noComp {string is double, true} {
    run {string is double 1.0}
} 1
test string-6.30.$noComp {string is double, true} {
    run {string is double [run {string compare a a}]}
} 1
................................................................................
    catch {unset var}
    list [run {string is false -fail var offensive}] $var
} {0 0}
test string-6.48.$noComp {string is integer, true} {
    run {string is integer +1234567890}
} 1
test string-6.49.$noComp {string is integer, true on type} {
    run {string is integer [expr int(50.0)]}
} 1
test string-6.50.$noComp {string is integer, true} {
    run {string is integer [list -10]}
} 1
test string-6.51.$noComp {string is integer, true as hex} {
    run {string is integer 0xabcdef}
} 1
................................................................................
test string-6.54.$noComp {string is integer, false} {
    list [run {string is integer -fail var 123abc}] $var
} {0 3}
test string-6.55.$noComp {string is integer, no overflow possible} {
    run {string is integer +[largest_int]0}
} 1
test string-6.56.$noComp {string is integer, false} {
    list [run {string is integer -fail var [expr double(1)]}] $var
} {0 1}
test string-6.57.$noComp {string is integer, false} {
    list [run {string is integer -fail var "    "}] $var
} {0 0}
test string-6.58.$noComp {string is integer, false on bad octal} {
    list [run {string is integer -fail var 0o36963}] $var
} {0 4}
................................................................................
    set x 0x10000000000000000
    run {string is integer [expr {$x}]}
} 1
test string-6.95.$noComp {string is wideinteger, true} {
    run {string is wideinteger +1234567890}
} 1
test string-6.96.$noComp {string is wideinteger, true on type} {
    run {string is wideinteger [expr wide(50.0)]}
} 1
test string-6.97.$noComp {string is wideinteger, true} {
    run {string is wideinteger [list -10]}
} 1
test string-6.98.$noComp {string is wideinteger, true as hex} {
    run {string is wideinteger 0xabcdef}
} 1
................................................................................
test string-6.101.$noComp {string is wideinteger, false} {
    list [run {string is wideinteger -fail var 123abc}] $var
} {0 3}
test string-6.102.$noComp {string is wideinteger, false on overflow} {
    list [run {string is wideinteger -fail var +[largest_int]0}] $var
} {0 -1}
test string-6.103.$noComp {string is wideinteger, false} {
    list [run {string is wideinteger -fail var [expr double(1)]}] $var
} {0 1}
test string-6.104.$noComp {string is wideinteger, false} {
    list [run {string is wideinteger -fail var "    "}] $var
} {0 0}
test string-6.105.$noComp {string is wideinteger, false on bad octal} {
    list [run {string is wideinteger -fail var 0o36963}] $var
} {0 4}
................................................................................
test string-6.109.$noComp {string is double, Bug 1360532} {
    run {string is double 1\xA0}
} 0
test string-6.110.$noComp {string is entier, true} {
    run {string is entier +1234567890}
} 1
test string-6.111.$noComp {string is entier, true on type} {
    run {string is entier [expr wide(50.0)]}
} 1
test string-6.112.$noComp {string is entier, true} {
    run {string is entier [list -10]}
} 1
test string-6.113.$noComp {string is entier, true as hex} {
    run {string is entier 0xabcdef}
} 1
................................................................................
test string-6.116.$noComp {string is entier, false} {
    list [run {string is entier -fail var 123abc}] $var
} {0 3}
test string-6.117.$noComp {string is entier, false} {
    list [run {string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc}] $var
} {0 84}
test string-6.118.$noComp {string is entier, false} {
    list [run {string is entier -fail var [expr double(1)]}] $var
} {0 1}
test string-6.119.$noComp {string is entier, false} {
    list [run {string is entier -fail var "    "}] $var
} {0 0}
test string-6.120.$noComp {string is entier, false on bad octal} {
    list [run {string is entier -fail var 0o36963}] $var
} {0 4}

test string-6.26.$noComp {string is digit, false} {
    list [run {string is digit -fail var +123567}] $var
} {0 0}
test string-6.27.$noComp {string is double, true} {
    run {string is double 1}
} 1
test string-6.28.$noComp {string is double, true} {
    run {string is double [expr {double(1)}]}
} 1
test string-6.29.$noComp {string is double, true} {
    run {string is double 1.0}
} 1
test string-6.30.$noComp {string is double, true} {
    run {string is double [run {string compare a a}]}
} 1
................................................................................
    catch {unset var}
    list [run {string is false -fail var offensive}] $var
} {0 0}
test string-6.48.$noComp {string is integer, true} {
    run {string is integer +1234567890}
} 1
test string-6.49.$noComp {string is integer, true on type} {
    run {string is integer [expr {int(50.0)}]}
} 1
test string-6.50.$noComp {string is integer, true} {
    run {string is integer [list -10]}
} 1
test string-6.51.$noComp {string is integer, true as hex} {
    run {string is integer 0xabcdef}
} 1
................................................................................
test string-6.54.$noComp {string is integer, false} {
    list [run {string is integer -fail var 123abc}] $var
} {0 3}
test string-6.55.$noComp {string is integer, no overflow possible} {
    run {string is integer +[largest_int]0}
} 1
test string-6.56.$noComp {string is integer, false} {
    list [run {string is integer -fail var [expr {double(1)}]}] $var
} {0 1}
test string-6.57.$noComp {string is integer, false} {
    list [run {string is integer -fail var "    "}] $var
} {0 0}
test string-6.58.$noComp {string is integer, false on bad octal} {
    list [run {string is integer -fail var 0o36963}] $var
} {0 4}
................................................................................
    set x 0x10000000000000000
    run {string is integer [expr {$x}]}
} 1
test string-6.95.$noComp {string is wideinteger, true} {
    run {string is wideinteger +1234567890}
} 1
test string-6.96.$noComp {string is wideinteger, true on type} {
    run {string is wideinteger [expr {wide(50.0)}]}
} 1
test string-6.97.$noComp {string is wideinteger, true} {
    run {string is wideinteger [list -10]}
} 1
test string-6.98.$noComp {string is wideinteger, true as hex} {
    run {string is wideinteger 0xabcdef}
} 1
................................................................................
test string-6.101.$noComp {string is wideinteger, false} {
    list [run {string is wideinteger -fail var 123abc}] $var
} {0 3}
test string-6.102.$noComp {string is wideinteger, false on overflow} {
    list [run {string is wideinteger -fail var +[largest_int]0}] $var
} {0 -1}
test string-6.103.$noComp {string is wideinteger, false} {
    list [run {string is wideinteger -fail var [expr {double(1)}]}] $var
} {0 1}
test string-6.104.$noComp {string is wideinteger, false} {
    list [run {string is wideinteger -fail var "    "}] $var
} {0 0}
test string-6.105.$noComp {string is wideinteger, false on bad octal} {
    list [run {string is wideinteger -fail var 0o36963}] $var
} {0 4}
................................................................................
test string-6.109.$noComp {string is double, Bug 1360532} {
    run {string is double 1\xA0}
} 0
test string-6.110.$noComp {string is entier, true} {
    run {string is entier +1234567890}
} 1
test string-6.111.$noComp {string is entier, true on type} {
    run {string is entier [expr {wide(50.0)}]}
} 1
test string-6.112.$noComp {string is entier, true} {
    run {string is entier [list -10]}
} 1
test string-6.113.$noComp {string is entier, true as hex} {
    run {string is entier 0xabcdef}
} 1
................................................................................
test string-6.116.$noComp {string is entier, false} {
    list [run {string is entier -fail var 123abc}] $var
} {0 3}
test string-6.117.$noComp {string is entier, false} {
    list [run {string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc}] $var
} {0 84}
test string-6.118.$noComp {string is entier, false} {
    list [run {string is entier -fail var [expr {double(1)}]}] $var
} {0 1}
test string-6.119.$noComp {string is entier, false} {
    list [run {string is entier -fail var "    "}] $var
} {0 0}
test string-6.120.$noComp {string is entier, false on bad octal} {
    list [run {string is entier -fail var 0o36963}] $var
} {0 4}

    subst -no bar
} -result {ambiguous option "-no": must be -nobackslashes, -nocommands, or -novariables}
test subst-7.3 {switches} -returnCodes error -body {
    subst -bogus bar
} -result {bad option "-bogus": must be -nobackslashes, -nocommands, or -novariables}
test subst-7.4 {switches} {
    set x 123
    subst -nobackslashes {abc $x [expr 1+2] \\\x41}
} {abc 123 3 \\\x41}
test subst-7.5 {switches} {
    set x 123
    subst -nocommands {abc $x [expr 1+2] \\\x41}
} {abc 123 [expr 1+2] \A}
test subst-7.6 {switches} {
    set x 123
    subst -novariables {abc $x [expr 1+2] \\\x41}
} {abc $x 3 \A}
test subst-7.7 {switches} {
    set x 123
    subst -nov -nob -noc {abc $x [expr 1+2] \\\x41}
} {abc $x [expr 1+2] \\\x41}

test subst-8.1 {return in a subst} {
    subst {foo [return {x}; bogus code] bar}
} {foo x bar}
test subst-8.2 {return in a subst} {
    subst {foo [return x ; bogus code] bar}
} {foo x bar}

    subst -no bar
} -result {ambiguous option "-no": must be -nobackslashes, -nocommands, or -novariables}
test subst-7.3 {switches} -returnCodes error -body {
    subst -bogus bar
} -result {bad option "-bogus": must be -nobackslashes, -nocommands, or -novariables}
test subst-7.4 {switches} {
    set x 123
    subst -nobackslashes {abc $x [expr {1 + 2}] \\\x41}
} {abc 123 3 \\\x41}
test subst-7.5 {switches} {
    set x 123
    subst -nocommands {abc $x [expr {1 + 2}] \\\x41}
} {abc 123 [expr {1 + 2}] \A}
test subst-7.6 {switches} {
    set x 123
    subst -novariables {abc $x [expr {1 + 2}] \\\x41}
} {abc $x 3 \A}
test subst-7.7 {switches} {
    set x 123
    subst -nov -nob -noc {abc $x [expr {1 + 2}] \\\x41}
} {abc $x [expr {1 + 2}] \\\x41}

test subst-8.1 {return in a subst} {
    subst {foo [return {x}; bogus code] bar}
} {foo x bar}
test subst-8.2 {return in a subst} {
    subst {foo [return x ; bogus code] bar}
} {foo x bar}

}
test tcltest-23.2 {removeFile} {
    -setup {
	set mfdir [file join [temporaryDirectory] mfdir]
	file mkdir $mfdir
	makeFile {} t1.tmp
	makeFile {} et1.tmp $mfdir
	if  {![file exists [file join [temporaryDirectory] t1.tmp]] || \
		![file exists [file join $mfdir et1.tmp]]} {
	    error "file creation didn't work"
	}
    }
    -body {
	removeFile t1.tmp
	removeFile et1.tmp $mfdir

}
test tcltest-23.2 {removeFile} {
    -setup {
	set mfdir [file join [temporaryDirectory] mfdir]
	file mkdir $mfdir
	makeFile {} t1.tmp
	makeFile {} et1.tmp $mfdir
	if {![file exists [file join [temporaryDirectory] t1.tmp]] || \
		![file exists [file join $mfdir et1.tmp]]} {
	    error "file creation didn't work"
	}
    }
    -body {
	removeFile t1.tmp
	removeFile et1.tmp $mfdir

} {1 {unknown command "thisdoesntexist"}}

test trace-28.10 {exec trace info nonsense} {
    list [catch {trace remove execution} res] $res
} {1 {wrong # args: should be "trace remove execution name opList command"}}

test trace-29.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
    testcmdtrace tracetest {set stuff [expr 14 + 16]}
} {{expr 14 + 16} {expr 14 + 16} {set stuff [expr 14 + 16]} {set stuff 30}}
test trace-29.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
    testcmdtrace tracetest {set stuff [info tclversion]}
} [concat {{info tclversion} {info tclversion} ::tcl::info::tclversion {::tcl::info::tclversion} {set stuff [info tclversion]}} [list "set stuff [info tclversion]"]]
test trace-29.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
    testcmdtrace deletetest {set stuff [info tclversion]}
} [info tclversion]
test trace-29.4 {Tcl_CreateTrace, check that tracing doesn't cause memory faults} {testcmdtrace} {

} {1 {unknown command "thisdoesntexist"}}

test trace-28.10 {exec trace info nonsense} {
    list [catch {trace remove execution} res] $res
} {1 {wrong # args: should be "trace remove execution name opList command"}}

test trace-29.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
    testcmdtrace tracetest {set stuff [expr {14 + 16}]}
} {{expr {14 + 16}} {expr {14 + 16}} {set stuff [expr {14 + 16}]} {set stuff 30}}
test trace-29.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
    testcmdtrace tracetest {set stuff [info tclversion]}
} [concat {{info tclversion} {info tclversion} ::tcl::info::tclversion {::tcl::info::tclversion} {set stuff [info tclversion]}} [list "set stuff [info tclversion]"]]
test trace-29.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
    testcmdtrace deletetest {set stuff [info tclversion]}
} [info tclversion]
test trace-29.4 {Tcl_CreateTrace, check that tracing doesn't cause memory faults} {testcmdtrace} {

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

proc a {x y} {
    newset z [expr $x+$y]
    return $z
}
proc newset {name value} {
    uplevel set $name $value
    uplevel 1 {uplevel 1 {set xyz 22}}
}
 

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

proc a {x y} {
    newset z [expr {$x + $y}]
    return $z
}
proc newset {name value} {
    uplevel set $name $value
    uplevel 1 {uplevel 1 {set xyz 22}}
}
 

    return $result
}

proc verdonk_test {sig binexp shouldbe exp} {
    regexp {([-+]?)([0-9a-f]+)} $sig -> signum sig
    scan $sig %llx sig
    if {$signum eq {-}} {
	set signum [expr 1<<63]
    } else {
	set signum 0
    }
    regexp {E([-+]?[0-9]+)} $binexp -> binexp
    set word [expr {$signum | (($binexp + 0x3ff)<<52)|($sig & ~(1<<52))}]
    binary scan [binary format w $word] q double
    regexp {([-+])(\d+)_(\d+)\&} $shouldbe -> signum digits1 digits2
................................................................................
	incr digits1
    }
    if {$outsign != $signum || $outdigits != $digits1 || $decpt != $decexp} {
	return -code error "result is ${outsign}0.${outdigits}E$decpt\
                            should be ${signum}0.${digits1}E$decexp"
    }
}

test util-1.1 {TclFindElement procedure - binary element in middle of list} {
    lindex {0 foo\x00help 1} 1
} "foo\x00help"
test util-1.2 {TclFindElement procedure - binary element at end of list} {
    lindex {0 foo\x00help} 1
} "foo\x00help"

................................................................................
test util-14.1 {funky NaN} {*}{
    -constraints {ieeeFloatingPoint controversialNaN}
    -body {
	set ieeeValues(-NaN)
    }
    -result -NaN
}

test util-14.2 {funky NaN} {*}{
    -constraints {ieeeFloatingPoint controversialNaN}
    -body {
	set ieeeValues(-NaN(3456789abcdef))
    }
    -result -NaN(3456789abcdef)
}
................................................................................
test util-15.1 {largest subnormal} {*}{
    -body {
	binary scan [binary format w 0x000fffffffffffff] q x
	set x
    }
    -result 2.225073858507201e-308
    -cleanup {
	unset x
    }
}

test util-15.2 {largest subnormal} {*}{
    -body {
	binary scan [binary format w 0x800fffffffffffff] q x
	set x
    }
    -result -2.225073858507201e-308
    -cleanup {
	unset x
    }
}

test util-15.3 {largest subnormal} {*}{
    -body {
	binary scan [binary format q 2.225073858507201e-308] w x
	format %#lx $x
    }
    -result 0xfffffffffffff
    -cleanup {
	unset x
    }
}

test util-15.4 {largest subnormal} {*}{
    -body {
	binary scan [binary format q -2.225073858507201e-308] w x
	format %#lx $x
    }
    -result 0x800fffffffffffff
    -cleanup {
	unset x
    }
}

test util-15.5 {smallest normal} {*}{
    -body {
	binary scan [binary format w 0x0010000000000000] q x
	set x
    }
    -result 2.2250738585072014e-308
    -cleanup {
	unset x
    }
}

test util-15.6 {smallest normal} {*}{
    -body {
	binary scan [binary format w 0x8010000000000000] q x
	set x
    }
    -result -2.2250738585072014e-308
    -cleanup {
	unset x
    }
}

test util-15.7 {smallest normal} {*}{
    -body {
	binary scan [binary format q 2.2250738585072014e-308] w x
	format %#lx $x
    }
    -result 0x10000000000000
    -cleanup {
	unset x
    }
}

test util-15.8 {smallest normal} {*}{
    -body {
	binary scan [binary format q -2.2250738585072014e-308] w x
	format %#lx $x
    }
    -result 0x8010000000000000
    -cleanup {
	unset x
    }
}

test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} {
    set r {}
    foreach {input} {
	0x1ffffffffffffc000
................................................................................
	0x1ffffffffffffd000
	0x1ffffffffffffd800
	0x1ffffffffffffe000
	0x1ffffffffffffe800
	0x1fffffffffffff000
	0x1fffffffffffff800
    } {
	binary scan [binary format q [expr double($input)]] wu x
	lappend r [format %#llx $x]
	binary scan [binary format q [expr double(-$input)]] wu x
	lappend r [format %#llx $x]
    }
    set r
} [list {*}{
    0x43fffffffffffffc 0xc3fffffffffffffc
    0x43fffffffffffffc 0xc3fffffffffffffc
    0x43fffffffffffffd 0xc3fffffffffffffd
................................................................................
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43ffffffffffffff 0xc3ffffffffffffff
    0x4400000000000000 0xc400000000000000
}]

test util-18.1 {Tcl_ObjPrintf} {testprint} {
    testprint %lld [expr 2**63-1]
} {9223372036854775807}

test util-18.2 {Tcl_ObjPrintf} {testprint} {
    testprint %I64d [expr 2**63-1]
} {9223372036854775807}

test util-18.3 {Tcl_ObjPrintf} {testprint} {
    testprint %qd [expr 2**63-1]
} {9223372036854775807}

test util-18.4 {Tcl_ObjPrintf} {testprint} {
    testprint %jd [expr 2**63-1]
} {9223372036854775807}

test util-18.5 {Tcl_ObjPrintf} {testprint} {
    testprint %lld [expr -2**63]
} {-9223372036854775808}

test util-18.6 {Tcl_ObjPrintf} {testprint} {
    testprint %I64d [expr -2**63]
} {-9223372036854775808}

test util-18.7 {Tcl_ObjPrintf} {testprint} {
    testprint %qd [expr -2**63]
} {-9223372036854775808}

test util-18.8 {Tcl_ObjPrintf} {testprint} {
    testprint %jd [expr -2**63]
} {-9223372036854775808}

test util-18.9 {Tcl_ObjPrintf} {testprint} {
    testprint "%I64d %I32d" [expr -2**63+2]
} {-9223372036854775806 2}

test util-18.10 {Tcl_ObjPrintf} {testprint} {
    testprint "%I64d %p" 65535
} {65535 0xffff}

test util-18.11 {Tcl_ObjPrintf} {testprint} {
    testprint "%I64d %td" 65536
} {65536 65536}

test util-18.12 {Tcl_ObjPrintf} {testprint} {
    testprint "%I64d %Id" 65537
} {65537 65537}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

    return $result
}

proc verdonk_test {sig binexp shouldbe exp} {
    regexp {([-+]?)([0-9a-f]+)} $sig -> signum sig
    scan $sig %llx sig
    if {$signum eq {-}} {
	set signum [expr {1 << 63}]
    } else {
	set signum 0
    }
    regexp {E([-+]?[0-9]+)} $binexp -> binexp
    set word [expr {$signum | (($binexp + 0x3ff)<<52)|($sig & ~(1<<52))}]
    binary scan [binary format w $word] q double
    regexp {([-+])(\d+)_(\d+)\&} $shouldbe -> signum digits1 digits2
................................................................................
	incr digits1
    }
    if {$outsign != $signum || $outdigits != $digits1 || $decpt != $decexp} {
	return -code error "result is ${outsign}0.${outdigits}E$decpt\
                            should be ${signum}0.${digits1}E$decexp"
    }
}
 
test util-1.1 {TclFindElement procedure - binary element in middle of list} {
    lindex {0 foo\x00help 1} 1
} "foo\x00help"
test util-1.2 {TclFindElement procedure - binary element at end of list} {
    lindex {0 foo\x00help} 1
} "foo\x00help"

................................................................................
test util-14.1 {funky NaN} {*}{
    -constraints {ieeeFloatingPoint controversialNaN}
    -body {
	set ieeeValues(-NaN)
    }
    -result -NaN
}

test util-14.2 {funky NaN} {*}{
    -constraints {ieeeFloatingPoint controversialNaN}
    -body {
	set ieeeValues(-NaN(3456789abcdef))
    }
    -result -NaN(3456789abcdef)
}
................................................................................
test util-15.1 {largest subnormal} {*}{
    -body {
	binary scan [binary format w 0x000fffffffffffff] q x
	set x
    }
    -result 2.225073858507201e-308
    -cleanup {
	unset -nocomplain x
    }
}

test util-15.2 {largest subnormal} {*}{
    -body {
	binary scan [binary format w 0x800fffffffffffff] q x
	set x
    }
    -result -2.225073858507201e-308
    -cleanup {
	unset -nocomplain x
    }
}

test util-15.3 {largest subnormal} {*}{
    -body {
	binary scan [binary format q 2.225073858507201e-308] w x
	format %#lx $x
    }
    -result 0xfffffffffffff
    -cleanup {
	unset -nocomplain x
    }
}

test util-15.4 {largest subnormal} {*}{
    -body {
	binary scan [binary format q -2.225073858507201e-308] w x
	format %#lx $x
    }
    -result 0x800fffffffffffff
    -cleanup {
	unset -nocomplain x
    }
}

test util-15.5 {smallest normal} {*}{
    -body {
	binary scan [binary format w 0x0010000000000000] q x
	set x
    }
    -result 2.2250738585072014e-308
    -cleanup {
	unset -nocomplain x
    }
}

test util-15.6 {smallest normal} {*}{
    -body {
	binary scan [binary format w 0x8010000000000000] q x
	set x
    }
    -result -2.2250738585072014e-308
    -cleanup {
	unset -nocomplain x
    }
}

test util-15.7 {smallest normal} {*}{
    -body {
	binary scan [binary format q 2.2250738585072014e-308] w x
	format %#lx $x
    }
    -result 0x10000000000000
    -cleanup {
	unset -nocomplain x
    }
}

test util-15.8 {smallest normal} {*}{
    -body {
	binary scan [binary format q -2.2250738585072014e-308] w x
	format %#lx $x
    }
    -result 0x8010000000000000
    -cleanup {
	unset -nocomplain x
    }
}

test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} {
    set r {}
    foreach {input} {
	0x1ffffffffffffc000
................................................................................
	0x1ffffffffffffd000
	0x1ffffffffffffd800
	0x1ffffffffffffe000
	0x1ffffffffffffe800
	0x1fffffffffffff000
	0x1fffffffffffff800
    } {
	binary scan [binary format q [expr {double($input)}]] wu x
	lappend r [format %#llx $x]
	binary scan [binary format q [expr {double(-$input)}]] wu x
	lappend r [format %#llx $x]
    }
    set r
} [list {*}{
    0x43fffffffffffffc 0xc3fffffffffffffc
    0x43fffffffffffffc 0xc3fffffffffffffc
    0x43fffffffffffffd 0xc3fffffffffffffd
................................................................................
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43ffffffffffffff 0xc3ffffffffffffff
    0x4400000000000000 0xc400000000000000
}]

test util-18.1 {Tcl_ObjPrintf} {testprint} {
    testprint %lld [expr {2**63 - 1}]
} {9223372036854775807}

test util-18.2 {Tcl_ObjPrintf} {testprint} {
    testprint %I64d [expr {2**63 - 1}]
} {9223372036854775807}

test util-18.3 {Tcl_ObjPrintf} {testprint} {
    testprint %qd [expr {2**63 - 1}]
} {9223372036854775807}

test util-18.4 {Tcl_ObjPrintf} {testprint} {
    testprint %jd [expr {2**63 - 1}]
} {9223372036854775807}

test util-18.5 {Tcl_ObjPrintf} {testprint} {
    testprint %lld [expr {-2**63}]
} {-9223372036854775808}

test util-18.6 {Tcl_ObjPrintf} {testprint} {
    testprint %I64d [expr {-2**63}]
} {-9223372036854775808}

test util-18.7 {Tcl_ObjPrintf} {testprint} {
    testprint %qd [expr {-2**63}]
} {-9223372036854775808}

test util-18.8 {Tcl_ObjPrintf} {testprint} {
    testprint %jd [expr {-2**63}]
} {-9223372036854775808}

test util-18.9 {Tcl_ObjPrintf} {testprint} {
    testprint "%I64d %I32d" [expr {-2**63 + 2}]
} {-9223372036854775806 2}

test util-18.10 {Tcl_ObjPrintf} {testprint} {
    testprint "%I64d %p" 65535
} {65535 0xffff}

test util-18.11 {Tcl_ObjPrintf} {testprint} {
    testprint "%I64d %td" 65536
} {65536 65536}

test util-18.12 {Tcl_ObjPrintf} {testprint} {
    testprint "%I64d %Id" 65537
} {65537 65537}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

    catch {namespace delete test_ns_var}
    namespace eval test_ns_var {variable one 1; variable two 2}
} -body {
    namespace eval test_ns_var {
        variable three 3 four 4
    }
    list [lsort [info vars test_ns_var::*]] \
         [namespace eval test_ns_var {expr $three+$four}]
} -result [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup {
    catch {unset a}
    catch {unset five}
    catch {unset six}
} -body {
    set a ""

    catch {namespace delete test_ns_var}
    namespace eval test_ns_var {variable one 1; variable two 2}
} -body {
    namespace eval test_ns_var {
        variable three 3 four 4
    }
    list [lsort [info vars test_ns_var::*]] \
         [namespace eval test_ns_var {expr {$three+$four}}]
} -result [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup {
    catch {unset a}
    catch {unset five}
    catch {unset six}
} -body {
    set a ""

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test while-old-1.1 {basic while loops} {
    set count 0
    while {$count < 10} {set count [expr $count+1]}
    set count
} 10
test while-old-1.2 {basic while loops} {
    set value xxx
    while {2 > 3} {set value yyy}
    set value
} xxx
................................................................................
} {2}

test while-old-2.1 {continue in while loop} {
    set list {1 2 3 4 5}
    set index 0
    set result {}
    while {$index < 5} {
	if {$index == 2} {set index [expr $index+1]; continue}
	set result [concat $result [lindex $list $index]]
	set index [expr $index+1]
    }
    set result
} {1 2 4 5}

test while-old-3.1 {break in while loop} {
    set list {1 2 3 4 5}
    set index 0
    set result {}
    while {$index < 5} {
	if {$index == 3} break
	set result [concat $result [lindex $list $index]]
	set index [expr $index+1]
    }
    set result
} {1 2 3}

test while-old-4.1 {errors in while loops} {
    set err [catch {while} msg]
    list $err $msg

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test while-old-1.1 {basic while loops} {
    set count 0
    while {$count < 10} {set count [expr {$count + 1}]}
    set count
} 10
test while-old-1.2 {basic while loops} {
    set value xxx
    while {2 > 3} {set value yyy}
    set value
} xxx
................................................................................
} {2}

test while-old-2.1 {continue in while loop} {
    set list {1 2 3 4 5}
    set index 0
    set result {}
    while {$index < 5} {
	if {$index == 2} {set index [expr {$index + 1}]; continue}
	set result [concat $result [lindex $list $index]]
	set index [expr {$index + 1}]
    }
    set result
} {1 2 4 5}

test while-old-3.1 {break in while loop} {
    set list {1 2 3 4 5}
    set index 0
    set result {}
    while {$index < 5} {
	if {$index == 3} break
	set result [concat $result [lindex $list $index]]
	set index [expr {$index + 1}]
    }
    set result
} {1 2 3}

test while-old-4.1 {errors in while loops} {
    set err [catch {while} msg]
    list $err $msg

} -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
test while-1.9 {TclCompileWhileCmd: simple command body} -body {
    set a {}
    set i 1
    while {$i<6} {
	if $i==4 break
	set a [concat $a $i]
        incr i
    }
    return $a
} -cleanup {
    unset a i
} -result {1 2 3}
................................................................................
} -cleanup {
    unset x1 bb x2 a i
} -result {x1}
test while-1.12 {TclCompileWhileCmd: long command body} -body {
    set a {}
    set i 1
    while {$i<6} {
	if $i==4 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
    set a [while {$i < 5} {incr i}]
    return $a
} -cleanup {
    unset a i
} -result {}
test while-1.14 {TclCompileWhileCmd: while command result} -body {
    set i 0
    set a [while {$i < 5} {if $i==3 break; incr i}]
    return $a
} -cleanup {
    unset a i
} -result {}

# Check "while" and "continue".

................................................................................
} -cleanup {
    unset a i msg
} -result {2.2 2.3 3.2 4.2 5.2}
test while-2.4 {continue tests, long command body} -body {
    set a {}
    set i 1
    while {$i<6} {
	if $i==2 {incr i; continue}
	if $i==4 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
} -cleanup {
    unset a i msg
} -result {1.1 1.2 2.1 3.1 4.1}
test while-3.3 {break tests, long command body} -body {
    set a {}
    set i 1
    while {$i<6} {
	if $i==2 {incr i; continue}
	if $i==5 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if $i==4 break
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
    invoked from within
"$z {$i < 5} {set}"}
test while-4.10 {while (not compiled): simple command body} -body {
    set a {}
    set i 1
    set z while
    $z {$i<6} {
	if $i==4 break
	set a [concat $a $i]
        incr i
    }
    return $a
} -cleanup {
    unset a i z
} -result {1 2 3}
................................................................................
    unset z x1 bb x2 a i
} -result {x1}
test while-4.13 {while (not compiled): long command body} -body {
    set a {}
    set z while
    set i 1
    $z {$i<6} {
	if $i==4 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
    return $a
} -cleanup {
    unset a i z
} -result {}
test while-4.15 {while (not compiled): while command result} -body {
    set i 0
    set z while
    set a [$z {$i < 5} {if $i==3 break; incr i}]
    return $a
} -cleanup {
    unset a i z
} -result {}

# Check "break" with computed command names.

................................................................................
    unset a i z msg
} -result {1.1 1.2 2.1 3.1 4.1}
test while-5.4 {break tests, long command body with computed command names} -body {
    set a {}
    set i 1
    set z break
    while {$i<6} {
	if $i==2 {incr i; continue}
	if $i==5 $z
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if $i==4 $z
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
    unset a i z msg
} -result {2.2 2.3 3.2 4.2 5.2}
test while-6.5 {continue tests, long command body with computed command names} -body {
    set a {}
    set i 1
    set z continue
    while {$i<6} {
	if $i==2 {incr i; continue}
	if $i==4 break
	if $i>5 $z
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg

} -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
test while-1.9 {TclCompileWhileCmd: simple command body} -body {
    set a {}
    set i 1
    while {$i<6} {
	if {$i==4} break
	set a [concat $a $i]
        incr i
    }
    return $a
} -cleanup {
    unset a i
} -result {1 2 3}
................................................................................
} -cleanup {
    unset x1 bb x2 a i
} -result {x1}
test while-1.12 {TclCompileWhileCmd: long command body} -body {
    set a {}
    set i 1
    while {$i<6} {
	if {$i==4} break
	if {$i>5} continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
    set a [while {$i < 5} {incr i}]
    return $a
} -cleanup {
    unset a i
} -result {}
test while-1.14 {TclCompileWhileCmd: while command result} -body {
    set i 0
    set a [while {$i < 5} {if {$i==3} break; incr i}]
    return $a
} -cleanup {
    unset a i
} -result {}

# Check "while" and "continue".

................................................................................
} -cleanup {
    unset a i msg
} -result {2.2 2.3 3.2 4.2 5.2}
test while-2.4 {continue tests, long command body} -body {
    set a {}
    set i 1
    while {$i<6} {
	if {$i==2} {incr i; continue}
	if {$i==4} break
	if {$i>5} continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
} -cleanup {
    unset a i msg
} -result {1.1 1.2 2.1 3.1 4.1}
test while-3.3 {break tests, long command body} -body {
    set a {}
    set i 1
    while {$i<6} {
	if {$i==2} {incr i; continue}
	if {$i==5} break
	if {$i>5} continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i==4} break
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
    invoked from within
"$z {$i < 5} {set}"}
test while-4.10 {while (not compiled): simple command body} -body {
    set a {}
    set i 1
    set z while
    $z {$i<6} {
	if {$i==4} break
	set a [concat $a $i]
        incr i
    }
    return $a
} -cleanup {
    unset a i z
} -result {1 2 3}
................................................................................
    unset z x1 bb x2 a i
} -result {x1}
test while-4.13 {while (not compiled): long command body} -body {
    set a {}
    set z while
    set i 1
    $z {$i<6} {
	if {$i==4} break
	if {$i>5} continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
    return $a
} -cleanup {
    unset a i z
} -result {}
test while-4.15 {while (not compiled): while command result} -body {
    set i 0
    set z while
    set a [$z {$i < 5} {if {$i==3} break; incr i}]
    return $a
} -cleanup {
    unset a i z
} -result {}

# Check "break" with computed command names.

................................................................................
    unset a i z msg
} -result {1.1 1.2 2.1 3.1 4.1}
test while-5.4 {break tests, long command body with computed command names} -body {
    set a {}
    set i 1
    set z break
    while {$i<6} {
	if {$i==2} {incr i; continue}
	if {$i==5} $z
	if {$i>5} continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i==4} $z
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
................................................................................
    unset a i z msg
} -result {2.2 2.3 3.2 4.2 5.2}
test while-6.5 {continue tests, long command body with computed command names} -body {
    set a {}
    set i 1
    set z continue
    while {$i<6} {
	if {$i==2} {incr i; continue}
	if {$i==4} break
	if {$i>5} $z
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg

} {1.4.3}

test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
    list [dde servername foobar] [dde servername] [dde servername self]
} -result {foobar foobar self}

test winDde-2.1 {Checking for other services} -constraints dde -body {
    expr [llength [dde services {} {}]] >= 0
} -result 1
test winDde-2.2 {Checking for existence, with service and topic specified} \
	-constraints dde -body {
    llength [dde services TclEval self]
} -result 1
test winDde-2.3 {Checking for existence, with only the service specified} \
	-constraints dde -body {
    expr [llength [dde services TclEval {}]] >= 1
} -result 1
test winDde-2.4 {Checking for existence, with only the topic specified} \
	-constraints dde -body {
    expr [llength [dde services {} self]] >= 1
} -result 1

# -------------------------------------------------------------------------

test winDde-3.1 {DDE execute locally} -constraints dde -body {
    set \xe1 ""
    dde execute TclEval self [list set \xe1 foo]

} {1.4.3}

test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
    list [dde servername foobar] [dde servername] [dde servername self]
} -result {foobar foobar self}

test winDde-2.1 {Checking for other services} -constraints dde -body {
    expr {[llength [dde services {} {}]] >= 0}
} -result 1
test winDde-2.2 {Checking for existence, with service and topic specified} \
	-constraints dde -body {
    llength [dde services TclEval self]
} -result 1
test winDde-2.3 {Checking for existence, with only the service specified} \
	-constraints dde -body {
    expr {[llength [dde services TclEval {}]] >= 1}
} -result 1
test winDde-2.4 {Checking for existence, with only the topic specified} \
	-constraints dde -body {
    expr {[llength [dde services {} self]] >= 1}
} -result 1

# -------------------------------------------------------------------------

test winDde-3.1 {DDE execute locally} -constraints dde -body {
    set \xe1 ""
    dde execute TclEval self [list set \xe1 foo]

    set s [zlib stream deflate]
    $s put {}
} -cleanup {
    catch {$s close}
} -result ""
# Also causes Tk Bug 10f2e7872b
test zlib-7.8 {zlib stream: Bug b26e38a3e4} -constraints zlib -setup {
    expr srand(12345)
    set randdata {}
    for {set i 0} {$i<6001} {incr i} {
	append randdata [binary format c [expr {int(256*rand())}]]
    }
} -body {
    set strm [zlib stream compress]
    for {set i 1} {$i<3000} {incr i} {
................................................................................
    catch {close $inSide}
    catch {$strm close}
} -result {358 358}
test zlib-8.16 {Bug 3603553: buffer transfer with large writes} -setup {
    # Actual data isn't very important; needs to be substantially larger than
    # the internal buffer (32kB) and incompressible.
    set largeData {}
    for {set i 0;expr srand(1)} {$i < 100000} {incr i} {
	append largeData [lindex "a b c d e f g h i j k l m n o p" \
		[expr {int(16*rand())}]]
    }
    set file [makeFile {} test.gz]
} -constraints zlib -body {
    set f [open $file wb]
    fconfigure $f -buffering none

    set s [zlib stream deflate]
    $s put {}
} -cleanup {
    catch {$s close}
} -result ""
# Also causes Tk Bug 10f2e7872b
test zlib-7.8 {zlib stream: Bug b26e38a3e4} -constraints zlib -setup {
    expr {srand(12345)}
    set randdata {}
    for {set i 0} {$i<6001} {incr i} {
	append randdata [binary format c [expr {int(256*rand())}]]
    }
} -body {
    set strm [zlib stream compress]
    for {set i 1} {$i<3000} {incr i} {
................................................................................
    catch {close $inSide}
    catch {$strm close}
} -result {358 358}
test zlib-8.16 {Bug 3603553: buffer transfer with large writes} -setup {
    # Actual data isn't very important; needs to be substantially larger than
    # the internal buffer (32kB) and incompressible.
    set largeData {}
    for {set i 0;expr {srand(1)}} {$i < 100000} {incr i} {
	append largeData [lindex "a b c d e f g h i j k l m n o p" \
		[expr {int(16*rand())}]]
    }
    set file [makeFile {} test.gz]
} -constraints zlib -body {
    set f [open $file wb]
    fconfigure $f -buffering none