Compare commits
14
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
 dkf
|
ffa8d1d461 | ||
|
dkf
|
eff08da703 | ||
|
dkf
|
807ed7b13c | ||
|
dkf
|
3ef704b39c | ||
|
dkf
|
346721f3f0 | ||
|
dkf
|
b3e4fc2a04 | ||
|
dkf
|
a22953bb77 | ||
|
dkf
|
20664f1fa1 | ||
|
dkf
|
33955d6933 | ||
|
jan.nijtmans
|
4404292972 | ||
|
jan.nijtmans
|
82ffc550db | ||
|
jan.nijtmans
|
3c53be5e75 | ||
|
jan.nijtmans
|
f163c24b4c | ||
|
jan.nijtmans
|
076a7e2839 |
@@ -0,0 +1,45 @@
|
||||
name: Linux Build and Test
|
||||
on: [push]
|
||||
jobs:
|
||||
gcc:
|
||||
runs-on: ubuntu-latest
|
||||
strategy:
|
||||
matrix:
|
||||
symbols:
|
||||
- "no"
|
||||
- "mem"
|
||||
- "all"
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
working-directory: unix
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
- name: Configure (symbols=${{ matrix.symbols }})
|
||||
run: |
|
||||
mkdir "${HOME}/install dir"
|
||||
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
|
||||
env:
|
||||
CFGOPT: --enable-symbols=${{ matrix.symbols }}
|
||||
- name: Prepare
|
||||
run: touch tclStubInit.c tclOOStubInit.c
|
||||
working-directory: generic
|
||||
- name: Build
|
||||
run: |
|
||||
make all
|
||||
- name: Build Test Harness
|
||||
run: |
|
||||
make tcltest
|
||||
- name: Run Tests
|
||||
run: |
|
||||
make test
|
||||
- name: Test-Drive Installation
|
||||
run: |
|
||||
make install
|
||||
- name: Create Distribution Package
|
||||
run: |
|
||||
make dist
|
||||
- name: Convert Documentation to HTML
|
||||
run: |
|
||||
make html-tcl
|
||||
@@ -0,0 +1,61 @@
|
||||
name: macOS Build and Test
|
||||
on: [push]
|
||||
jobs:
|
||||
with-Xcode:
|
||||
runs-on: macos-latest
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
working-directory: macosx
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
- name: Prepare
|
||||
run: touch tclStubInit.c tclOOStubInit.c
|
||||
working-directory: generic
|
||||
- name: Build
|
||||
run: make all
|
||||
- name: Run Tests
|
||||
run: make test styles=develop
|
||||
env:
|
||||
ERROR_ON_FAILURES: 1
|
||||
MAC_CI: 1
|
||||
Unix-like:
|
||||
runs-on: macos-latest
|
||||
strategy:
|
||||
matrix:
|
||||
symbols:
|
||||
- "no"
|
||||
- "mem"
|
||||
dtrace:
|
||||
- "no"
|
||||
- "yes"
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
working-directory: unix
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
- name: Prepare
|
||||
run: |
|
||||
touch tclStubInit.c tclOOStubInit.c
|
||||
mkdir "$HOME/install dir"
|
||||
working-directory: generic
|
||||
- name: Configure (symbols=${{ matrix.symbols }} dtrace=${{ matrix.dtrace }})
|
||||
# Note that macOS is always a 64 bit platform
|
||||
run: ./configure --enable-64bit ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
|
||||
env:
|
||||
CFGOPT: --enable-symbols=${{ matrix.symbols }} --enable-dtrace=${{ matrix.dtrace }}
|
||||
- name: Build
|
||||
run: |
|
||||
make all tcltest
|
||||
- name: Run Tests
|
||||
run: |
|
||||
make test
|
||||
env:
|
||||
ERROR_ON_FAILURES: 1
|
||||
MAC_CI: 1
|
||||
- name: Trial Installation
|
||||
run: |
|
||||
make install
|
||||
@@ -0,0 +1,71 @@
|
||||
name: Windows Build and Test
|
||||
on: [push]
|
||||
jobs:
|
||||
MSVC:
|
||||
runs-on: windows-latest
|
||||
defaults:
|
||||
run:
|
||||
shell: powershell
|
||||
working-directory: win
|
||||
# Using powershell means we need to explicitly stop on failure
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
- name: Init MSVC
|
||||
uses: ilammy/msvc-dev-cmd@v1
|
||||
- name: Build
|
||||
run: |
|
||||
&nmake -f makefile.vc all
|
||||
if ($lastexitcode -ne 0) {
|
||||
throw "nmake exit code: $lastexitcode"
|
||||
}
|
||||
- name: Build Test Harness
|
||||
run: |
|
||||
&nmake -f makefile.vc tcltest
|
||||
if ($lastexitcode -ne 0) {
|
||||
throw "nmake exit code: $lastexitcode"
|
||||
}
|
||||
- name: Run Tests
|
||||
run: |
|
||||
&nmake -f makefile.vc test
|
||||
if ($lastexitcode -ne 0) {
|
||||
throw "nmake exit code: $lastexitcode"
|
||||
}
|
||||
env:
|
||||
ERROR_ON_FAILURES: 1
|
||||
MSYS-gcc:
|
||||
runs-on: windows-latest
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
working-directory: win
|
||||
strategy:
|
||||
matrix:
|
||||
symbols:
|
||||
- "no"
|
||||
- "mem"
|
||||
- "all"
|
||||
# Using powershell means we need to explicitly stop on failure
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
- name: Install MSYS2 and Make
|
||||
run: choco install msys2 make
|
||||
- name: Prepare
|
||||
run: |
|
||||
touch tclStubInit.c tclOOStubInit.c
|
||||
mkdir "${HOME}/install dir"
|
||||
working-directory: generic
|
||||
- name: Configure (symbols=${{ matrix.symbols }})
|
||||
run: |
|
||||
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
|
||||
env:
|
||||
CFGOPT: --enable-64bit --enable-symbols=${{ matrix.symbols }}
|
||||
- name: Build
|
||||
run: make all
|
||||
- name: Build Test Harness
|
||||
run: make tcltest
|
||||
- name: Run Tests
|
||||
run: make test
|
||||
env:
|
||||
ERROR_ON_FAILURES: 1
|
||||
@@ -216,6 +216,15 @@ jobs:
|
||||
script:
|
||||
- cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest
|
||||
- cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test
|
||||
- name: "Windows/MSVC/StaticPackage"
|
||||
os: windows
|
||||
compiler: cl
|
||||
env: *vcenv
|
||||
before_install: *vcpreinst
|
||||
install: []
|
||||
script:
|
||||
- cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,staticpkg,msvcrt' '-f' makefile.vc all tcltest
|
||||
- cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,staticpkg,msvcrt' '-f' makefile.vc test
|
||||
- name: "Windows/MSVC/Debug"
|
||||
os: windows
|
||||
compiler: cl
|
||||
|
||||
@@ -5,7 +5,20 @@ This is the **Tcl 8.6.10** source distribution.
|
||||
You can get any source release of Tcl from [our distribution
|
||||
site](https://sourceforge.net/projects/tcl/files/Tcl/).
|
||||
|
||||
[](https://travis-ci.org/tcltk/tcl)
|
||||
8.6.10
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Acore-8-6-branch)
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Acore-8-6-branch)
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Acore-8-6-branch)
|
||||
<br>
|
||||
8.7a4
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Acore-8-branch)
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Acore-8-branch)
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Acore-8-branch)
|
||||
<br>
|
||||
9.0a2
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Amain)
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Amain)
|
||||
[](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Amain)
|
||||
|
||||
## Contents
|
||||
1. [Introduction](#intro)
|
||||
|
||||
+5
-4
@@ -107,9 +107,9 @@ will produce the value on the right side of the line:
|
||||
.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 {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
|
||||
.SS OPERATORS
|
||||
@@ -246,7 +246,7 @@ just as in C, which means that operands are not evaluated if they are
|
||||
not needed to determine the outcome. For example, in the command
|
||||
.PP
|
||||
.CS
|
||||
\fBexpr\fR {$v ? [a] : [b]}
|
||||
\fBexpr\fR {$v?[a]:[b]}
|
||||
.CE
|
||||
.PP
|
||||
only one of
|
||||
@@ -496,4 +496,5 @@ Copyright (c) 2005 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
|
||||
.fi
|
||||
'\" Local Variables:
|
||||
'\" mode: nroff
|
||||
'\" fill-column: 78
|
||||
'\" End:
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
if {![package vsatisfies [package provide Tcl] 8.5]} return
|
||||
if {[info sharedlibextension] != ".dll"} return
|
||||
if {[::tcl::pkgconfig get debug]} {
|
||||
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14g.dll] dde]
|
||||
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14g.dll] Dde]
|
||||
} else {
|
||||
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] dde]
|
||||
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] Dde]
|
||||
}
|
||||
|
||||
@@ -2,8 +2,8 @@ if {![package vsatisfies [package provide Tcl] 8.5]} return
|
||||
if {[info sharedlibextension] != ".dll"} return
|
||||
if {[::tcl::pkgconfig get debug]} {
|
||||
package ifneeded registry 1.3.5 \
|
||||
[list load [file join $dir tclreg13g.dll] registry]
|
||||
[list load [file join $dir tclreg13g.dll] Registry]
|
||||
} else {
|
||||
package ifneeded registry 1.3.5 \
|
||||
[list load [file join $dir tclreg13.dll] registry]
|
||||
[list load [file join $dir tclreg13.dll] Registry]
|
||||
}
|
||||
|
||||
+2
-2
@@ -32,7 +32,7 @@ test append-1.3 {append command} {
|
||||
|
||||
test append-2.1 {long appends} {
|
||||
set x ""
|
||||
for {set i 0} {$i < 1000} {set i [expr $i+1]} {
|
||||
for {set i 0} {$i < 1000} {incr i} {
|
||||
append x "foobar "
|
||||
}
|
||||
set y "foobar"
|
||||
@@ -158,7 +158,7 @@ test append-5.1 {long lappends} -setup {
|
||||
if {$l != $size} {
|
||||
return "length mismatch: should have been $size, was $l"
|
||||
}
|
||||
for {set i 0} {$i < $size} {set i [expr $i+1]} {
|
||||
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\""
|
||||
|
||||
@@ -41,7 +41,7 @@ test appendComp-1.3 {append command} {
|
||||
test appendComp-2.1 {long appends} {
|
||||
proc foo {} {
|
||||
set x ""
|
||||
for {set i 0} {$i < 1000} {set i [expr $i+1]} {
|
||||
for {set i 0} {$i < 1000} {incr i} {
|
||||
append x "foobar "
|
||||
}
|
||||
set y "foobar"
|
||||
@@ -223,7 +223,7 @@ test appendComp-5.1 {long lappends} -setup {
|
||||
}
|
||||
} -body {
|
||||
set x ""
|
||||
for {set i 0} {$i < 300} {set i [expr $i+1]} {
|
||||
for {set i 0} {$i < 300} {incr i} {
|
||||
lappend x "item $i"
|
||||
}
|
||||
check $x 300
|
||||
|
||||
+2
-2
@@ -21,7 +21,7 @@ catch [list package require -exact Tcltest [info patchlevel]]
|
||||
|
||||
testConstraint testasync [llength [info commands testasync]]
|
||||
testConstraint threaded [::tcl::pkgconfig get threaded]
|
||||
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
|
||||
testConstraint notWinCI [expr {$::tcl_platform(platform) != "windows" || ![info exists ::env(CI)]}]
|
||||
|
||||
proc async1 {result code} {
|
||||
global aresult acode
|
||||
@@ -204,7 +204,7 @@ test async-4.2 {async interrupting straight bytecode sequence} -constraints {
|
||||
testasync delete $hm
|
||||
}
|
||||
test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
|
||||
testasync threaded knownMsvcBug
|
||||
testasync threaded notWinCI
|
||||
} -setup {
|
||||
set hm [testasync create async3]
|
||||
} -body {
|
||||
|
||||
@@ -40,8 +40,8 @@ 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]}
|
||||
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
|
||||
|
||||
+1
-1
@@ -674,7 +674,7 @@ proc l3 {} {
|
||||
# Do all tests once byte compiled and once with direct string evaluation
|
||||
for {set noComp 0} {$noComp <= 1} {incr noComp} {
|
||||
|
||||
if $noComp {
|
||||
if {$noComp} {
|
||||
interp alias {} run {} testevalex
|
||||
set constraints testevalex
|
||||
} else {
|
||||
|
||||
+14
-13
@@ -42,7 +42,8 @@ namespace eval ::tcl::test::io {
|
||||
testConstraint testchannelevent [llength [info commands testchannelevent]]
|
||||
testConstraint testmainthread [llength [info commands testmainthread]]
|
||||
testConstraint testservicemode [llength [info commands testservicemode]]
|
||||
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
|
||||
testConstraint notWinCI [expr {
|
||||
$::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
|
||||
testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
|
||||
|
||||
# You need a *very* special environment to do some tests. In particular,
|
||||
@@ -1881,7 +1882,7 @@ test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -bod
|
||||
} -result {{{} {}} {auto lf}}
|
||||
test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup {
|
||||
set path(stdout) [makeFile {} stdout]
|
||||
} -constraints {stdio knownMsvcBug} -body {
|
||||
} -constraints {stdio notWinCI} -body {
|
||||
set f [open $path(script) w]
|
||||
chan puts -nonewline $f {
|
||||
chan close stdout
|
||||
@@ -2791,7 +2792,7 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} -s
|
||||
chan puts $s $l
|
||||
}
|
||||
}
|
||||
} -constraints {socket tempNotMac fileevent knownMsvcBug} -body {
|
||||
} -constraints {socket tempNotMac fileevent notWinCI} -body {
|
||||
proc accept {s a p} {
|
||||
variable x
|
||||
chan event $s readable [namespace code [list readit $s]]
|
||||
@@ -3045,7 +3046,7 @@ test chan-io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} -setup {
|
||||
string length [chan read $f]
|
||||
} -cleanup {
|
||||
chan close $f
|
||||
} -result [expr 700*15+1]
|
||||
} -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 {
|
||||
@@ -3062,7 +3063,7 @@ test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} -setup {
|
||||
string length [chan read $f]
|
||||
} -cleanup {
|
||||
chan close $f
|
||||
} -result [expr 700*15+1]
|
||||
} -result [expr {700*15 + 1}]
|
||||
test chan-io-30.15 {Tcl_Write mixed, Tcl_Read auto} -setup {
|
||||
file delete $path(test1)
|
||||
} -body {
|
||||
@@ -3904,7 +3905,7 @@ test chan-io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} -setup {
|
||||
}
|
||||
chan close $f
|
||||
string length $c
|
||||
} -result [expr 700*15+1]
|
||||
} -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 ""
|
||||
@@ -3924,7 +3925,7 @@ test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} -setup {
|
||||
}
|
||||
chan close $f
|
||||
string length $c
|
||||
} -result [expr 700*15+1]
|
||||
} -result [expr {700*15 + 1}]
|
||||
|
||||
# Test Tcl_Read and buffering.
|
||||
|
||||
@@ -5335,7 +5336,7 @@ test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
|
||||
} -constraints {unix} -body {
|
||||
set f [open $path(test3) {WRONLY CREAT} 0600]
|
||||
file stat $path(test3) stats
|
||||
set x [format "%#o" [expr $stats(mode)&0o777]]
|
||||
set x [format "%#o" [expr {$stats(mode) & 0o777}]]
|
||||
chan puts $f "line 1"
|
||||
chan close $f
|
||||
set f [open $path(test3) r]
|
||||
@@ -5349,7 +5350,7 @@ test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
|
||||
# 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]
|
||||
format "%#o" [expr {$stats(mode) & 0o777}]
|
||||
} -result [format %#4o [expr {0o666 & ~ $umaskValue}]]
|
||||
test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
|
||||
file delete $path(test3)
|
||||
@@ -6716,7 +6717,7 @@ test chan-io-52.6 {TclCopyChannel} -setup {
|
||||
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 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
|
||||
@@ -6958,7 +6959,7 @@ test chan-io-53.5 {CopyData: error during chan copy} {socket fcopy} {
|
||||
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] {
|
||||
if {![info exists fcopyTestDone]} {
|
||||
vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g.
|
||||
}
|
||||
chan close $in
|
||||
@@ -6978,7 +6979,7 @@ test chan-io-53.6 {CopyData: error during chan copy} -setup {
|
||||
set out [open $path(test1) w]
|
||||
chan copy $in $out -command [namespace code FcopyTestDone]
|
||||
variable fcopyTestDone
|
||||
if ![info exists fcopyTestDone] {
|
||||
if {![info exists fcopyTestDone]} {
|
||||
vwait [namespace which -variable fcopyTestDone]
|
||||
}
|
||||
return $fcopyTestDone ;# 0 for plain end of file
|
||||
@@ -7031,7 +7032,7 @@ test chan-io-53.7 {CopyData: Flooding chan copy from pipe} -setup {
|
||||
vwait [namespace which -variable fcopyTestDone]
|
||||
}
|
||||
# -1=error 0=script error N=number of bytes
|
||||
expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
|
||||
expr {($fcopyTestDone == 0) ? $fcopyTestCount : -1}
|
||||
} -cleanup {
|
||||
catch {chan close $in}
|
||||
chan close $out
|
||||
|
||||
+3
-3
@@ -35440,7 +35440,7 @@ test clock-32.1 {scan/format across the Gregorian change} {
|
||||
|
||||
# clock clicks
|
||||
test clock-33.1 {clock clicks tests} {
|
||||
expr [clock clicks]+1
|
||||
expr {[clock clicks] + 1}
|
||||
concat {}
|
||||
} {}
|
||||
test clock-33.2 {clock clicks tests} {
|
||||
@@ -35453,7 +35453,7 @@ 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
|
||||
expr {[clock clicks -milliseconds] + 1}
|
||||
concat {}
|
||||
} {}
|
||||
test clock-33.4a {clock milliseconds} {
|
||||
@@ -35909,7 +35909,7 @@ test clock-34.68 {clock scan tests (merid and TZ)} {
|
||||
|
||||
# clock seconds
|
||||
test clock-35.1 {clock seconds tests} {
|
||||
expr [clock seconds]+1
|
||||
expr {[clock seconds] + 1}
|
||||
concat {}
|
||||
} {}
|
||||
test clock-35.2 {clock seconds tests} {
|
||||
|
||||
+1
-1
@@ -1092,7 +1092,7 @@ 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)
|
||||
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] \
|
||||
|
||||
+1
-1
@@ -498,7 +498,7 @@ test cmdIL-5.5 {lsort with list style index and sharing} -body {
|
||||
foreach e $l {lappend n [list [expr {rand()}] $e]}
|
||||
lindex [lsort -real -index $l $n] 1 1
|
||||
}
|
||||
expr srand(1)
|
||||
expr {srand(1)}
|
||||
test_lsort 0
|
||||
} -result 0 -cleanup {
|
||||
rename test_lsort ""
|
||||
|
||||
+2
-2
@@ -314,7 +314,7 @@ test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} {
|
||||
} {0 15}
|
||||
|
||||
test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
|
||||
format %.6g [expr atan2(1.0, 2.0)]
|
||||
format %.6g [expr {atan2(1.0, 2.0)}]
|
||||
} 0.463648
|
||||
test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body {
|
||||
expr {do_it()}
|
||||
@@ -329,7 +329,7 @@ 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)))]
|
||||
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.*)}
|
||||
|
||||
+16
-16
@@ -124,7 +124,7 @@ test compile-3.4 {TclCompileCatchCmd: bcc'ed [return] is caught} {
|
||||
proc foo {} {
|
||||
set fail [catch {
|
||||
return 1
|
||||
}] ; # {}
|
||||
}] ; # {}
|
||||
return 2
|
||||
}
|
||||
foo
|
||||
@@ -134,8 +134,8 @@ test compile-3.5 {TclCompileCatchCmd: recover from error, [Bug 705406]} {
|
||||
catch {
|
||||
if {[a]} {
|
||||
if b {}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
list [catch foo msg] $msg
|
||||
} {0 1}
|
||||
@@ -203,7 +203,7 @@ test compile-4.1 {TclCompileForCmd: command substituted test expression} {
|
||||
set i 0
|
||||
set j 0
|
||||
# Should be "forever"
|
||||
for {} [expr $i < 3] {} {
|
||||
for {} [expr {$i < 3}] {} {
|
||||
set j [incr i]
|
||||
if {$j > 3} break
|
||||
}
|
||||
@@ -277,7 +277,7 @@ test compile-7.1 {TclCompileWhileCmd: command substituted test expression} {
|
||||
set i 0
|
||||
set j 0
|
||||
# Should be "forever"
|
||||
while [expr $i < 3] {
|
||||
while [expr {$i < 3}] {
|
||||
set j [incr i]
|
||||
if {$j > 3} break
|
||||
}
|
||||
@@ -336,7 +336,7 @@ 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 }}
|
||||
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} }}
|
||||
@@ -346,13 +346,13 @@ test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
|
||||
list [catch {p} msg] $msg
|
||||
} -returnCodes error -result {unmatched open brace in list}
|
||||
|
||||
#
|
||||
#
|
||||
# Special section for tests of tclLiteral.c
|
||||
# The following tests check for incorrect memory handling in
|
||||
# TclReleaseLiteral. They are only effective when tcl is compiled with
|
||||
# TCL_MEM_DEBUG
|
||||
#
|
||||
# Special test for leak on interp delete [Bug 467523].
|
||||
# Special test for leak on interp delete [Bug 467523].
|
||||
test compile-12.1 {testing literal leak on interp delete} -setup {
|
||||
proc getbytes {} {
|
||||
set lines [split [memory info] "\n"]
|
||||
@@ -361,10 +361,10 @@ test compile-12.1 {testing literal leak on interp delete} -setup {
|
||||
} -constraints memory -body {
|
||||
set end [getbytes]
|
||||
for {set i 0} {$i < 5} {incr i} {
|
||||
interp create foo
|
||||
foo eval {
|
||||
interp create foo
|
||||
foo eval {
|
||||
namespace eval bar {}
|
||||
}
|
||||
}
|
||||
interp delete foo
|
||||
set tmp $end
|
||||
set end [getbytes]
|
||||
@@ -385,7 +385,7 @@ test compile-12.2 {testing error on literal deletion} -constraints {memory exec}
|
||||
}
|
||||
puts 0
|
||||
} source.file]
|
||||
exec [interpreter] $sourceFile
|
||||
exec [interpreter] $sourceFile
|
||||
} -cleanup {
|
||||
catch {removeFile $sourceFile}
|
||||
} -result 0
|
||||
@@ -510,7 +510,7 @@ test compile-13.3 {TclCompileScript: testing check of max depth by nested script
|
||||
ti eval {set result {}}
|
||||
} -body {
|
||||
# Test different compilation variants (instructions evalStk, invokeStk, etc),
|
||||
# with 500 nested scripts (bodies). It must generate "too many nested compilations"
|
||||
# with 500 nested scripts (bodies). It must generate "too many nested compilations"
|
||||
# error for any variant we're testing here:
|
||||
ti eval {foreach cmd {eval "if 1" try catch} {
|
||||
set c [gencode 500 $cmd]
|
||||
@@ -518,7 +518,7 @@ test compile-13.3 {TclCompileScript: testing check of max depth by nested script
|
||||
}}
|
||||
#puts $errors
|
||||
# all of nested calls exceed the limit, so must end with "too many nested compilations"
|
||||
# (or evaluations, depending on compile method/instruction and "mixed" compile within
|
||||
# (or evaluations, depending on compile method/instruction and "mixed" compile within
|
||||
# evaliation), so no one succeeds, the result must be empty:
|
||||
ti eval {set result}
|
||||
} -result {}
|
||||
@@ -539,7 +539,7 @@ test compile-14.1 {testing errors in element name; segfault?} {} {
|
||||
test compile-14.2 {testing element name "$"} -body {
|
||||
unset -nocomplain a
|
||||
set a() 1
|
||||
set a(1) 2
|
||||
set a(1) 2
|
||||
set a($) 3
|
||||
list [set a()] [set a(1)] [set a($)] [unset a() a(1); lindex [array names a] 0]
|
||||
} -cleanup {unset a} -result [list 1 2 3 {$}]
|
||||
@@ -564,7 +564,7 @@ test compile-15.5 {proper TCL_RETURN code from [return]} {
|
||||
|
||||
for {set noComp 0} {$noComp <= 1} {incr noComp} {
|
||||
|
||||
if $noComp {
|
||||
if {$noComp} {
|
||||
interp alias {} run {} testevalex
|
||||
set constraints testevalex
|
||||
} else {
|
||||
|
||||
+5
-5
@@ -24,7 +24,8 @@ package require tcltests
|
||||
# All tests require the "exec" command.
|
||||
# Skip them if exec is not defined.
|
||||
testConstraint exec [llength [info commands exec]]
|
||||
testConstraint noosx [expr {![info exists ::env(TRAVIS_OSX_IMAGE)] || ![string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]
|
||||
# Some skips when running in a macOS CI environment
|
||||
testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}]
|
||||
|
||||
unset -nocomplain path
|
||||
|
||||
@@ -671,7 +672,9 @@ test exec-18.2 {exec cat deals with weird file names} -body {
|
||||
# Note that this test cannot be adapted to work on Windows; that platform has
|
||||
# no kernel support for an analog of O_APPEND. OTOH, that means we can assume
|
||||
# that there is a POSIX shell...
|
||||
test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind noosx} -setup {
|
||||
#
|
||||
# This test also fails in some cases when building with macOS
|
||||
test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind noosxCI} -setup {
|
||||
set tmpfile [makeFile {0} tmpfile.exec-19.1]
|
||||
} -body {
|
||||
# Note that we have to allow for the current contents of the temporary
|
||||
@@ -707,9 +710,6 @@ test exec-20.1 {exec .CMD file} -constraints {win} -body {
|
||||
exec [makeFile "echo %1> $log" exec201.CMD] "Testing exec-20.1"
|
||||
viewFile $log
|
||||
} -result "\"Testing exec-20.1\""
|
||||
|
||||
|
||||
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
# cleanup
|
||||
|
||||
+15
-15
@@ -821,49 +821,49 @@ 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
|
||||
expr {wide(42) << 30}
|
||||
} 45097156608
|
||||
test execute-7.12 {Wide int handling in INST_LSHIFT} {
|
||||
expr 12345678901<<3
|
||||
expr {12345678901 << 3}
|
||||
} 98765431208
|
||||
test execute-7.13 {Wide int handling in INST_RSHIFT} {
|
||||
expr 0x543210febcda9876>>7
|
||||
expr {0x543210febcda9876 >> 7}
|
||||
} 47397893236700464
|
||||
test execute-7.14 {Wide int handling in INST_RSHIFT} {
|
||||
expr wide(0x9876543210febcda)>>7
|
||||
expr {wide(0x9876543210febcda) >> 7}
|
||||
} -58286587177206407
|
||||
test execute-7.15 {Wide int handling in INST_BITOR} {
|
||||
expr wide(0x9876543210febcda) | 0x543210febcda9876
|
||||
expr {wide(0x9876543210febcda) | 0x543210febcda9876}
|
||||
} -2560765885044310786
|
||||
test execute-7.16 {Wide int handling in INST_BITXOR} {
|
||||
expr wide(0x9876543210febcda) ^ 0x543210febcda9876
|
||||
expr {wide(0x9876543210febcda) ^ 0x543210febcda9876}
|
||||
} -3727778945703861076
|
||||
test execute-7.17 {Wide int handling in INST_BITAND} {
|
||||
expr wide(0x9876543210febcda) & 0x543210febcda9876
|
||||
expr {wide(0x9876543210febcda) & 0x543210febcda9876}
|
||||
} 1167013060659550290
|
||||
test execute-7.18 {Wide int handling in INST_ADD} {
|
||||
expr wide(0x7fffffff)+wide(0x7fffffff)
|
||||
expr {wide(0x7fffffff) + wide(0x7fffffff)}
|
||||
} 4294967294
|
||||
test execute-7.19 {Wide int handling in INST_ADD} {
|
||||
expr 0x7fffffff+wide(0x7fffffff)
|
||||
expr {0x7fffffff + wide(0x7fffffff)}
|
||||
} 4294967294
|
||||
test execute-7.20 {Wide int handling in INST_ADD} {
|
||||
expr wide(0x7fffffff)+0x7fffffff
|
||||
expr {wide(0x7fffffff) + 0x7fffffff}
|
||||
} 4294967294
|
||||
test execute-7.21 {Wide int handling in INST_ADD} {
|
||||
expr double(0x7fffffff)+wide(0x7fffffff)
|
||||
expr {double(0x7fffffff) + wide(0x7fffffff)}
|
||||
} 4294967294.0
|
||||
test execute-7.22 {Wide int handling in INST_ADD} {
|
||||
expr wide(0x7fffffff)+double(0x7fffffff)
|
||||
expr {wide(0x7fffffff) + double(0x7fffffff)}
|
||||
} 4294967294.0
|
||||
test execute-7.23 {Wide int handling in INST_SUB} {
|
||||
expr 0x123456789a-0x20406080a
|
||||
expr {0x123456789a - 0x20406080a}
|
||||
} 69530054800
|
||||
test execute-7.24 {Wide int handling in INST_MULT} {
|
||||
expr 0x123456789a*193
|
||||
expr {0x123456789a * 193}
|
||||
} 15090186251290
|
||||
test execute-7.25 {Wide int handling in INST_DIV} {
|
||||
expr 0x123456789a/193
|
||||
expr {0x123456789a / 193}
|
||||
} 405116546
|
||||
test execute-7.26 {Wide int handling in INST_UPLUS} {
|
||||
set x 0x123456871234568
|
||||
|
||||
+6
-1
@@ -80,6 +80,7 @@ testConstraint darwin9 [expr {
|
||||
&& [package vsatisfies 1.$::tcl_platform(osVersion) 1.9]
|
||||
}]
|
||||
testConstraint notDarwin9 [expr {![testConstraint darwin9]}]
|
||||
testConstraint notContinuousIntegration [expr {![info exists ::env(CI)]}]
|
||||
|
||||
testConstraint fileSharing 0
|
||||
testConstraint notFileSharing 1
|
||||
@@ -2582,7 +2583,11 @@ test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win} -body {
|
||||
&& [file exists $env(USERPROFILE)/NTUSER.DAT]
|
||||
&& [file readable $env(USERPROFILE)/NTUSER.DAT]}
|
||||
} -result {1}
|
||||
test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win} -body {
|
||||
# At least one CI environment (GitHub Actions) is set up with the page file in
|
||||
# an unusual location; skip the test if that is so.
|
||||
test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {
|
||||
win notContinuousIntegration
|
||||
} -body {
|
||||
set r {}
|
||||
if {[info exists env(SystemDrive)]} {
|
||||
set path $env(SystemDrive)/pagefile.sys
|
||||
|
||||
@@ -38,7 +38,9 @@ catch {
|
||||
testConstraint testfilesystem [llength [info commands ::testfilesystem]]
|
||||
testConstraint testsetplatform [llength [info commands ::testsetplatform]]
|
||||
testConstraint testsimplefilesystem [llength [info commands ::testsimplefilesystem]]
|
||||
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
|
||||
# Some things fail under all Continuous Integration systems for subtle reasons
|
||||
# such as CI often running with elevated privileges in a container.
|
||||
testConstraint notInCIenv [expr {![info exists ::env(CI)]}]
|
||||
|
||||
cd [tcltest::temporaryDirectory]
|
||||
makeFile "test file" gorp.file
|
||||
@@ -317,7 +319,7 @@ test filesystem-1.37 {file normalisation with '/./'} -body {
|
||||
} -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$}
|
||||
test filesystem-1.38 {file normalisation with volume relative} -setup {
|
||||
set dir [pwd]
|
||||
} -constraints {win moreThanOneDrive knownMsvcBug} -body {
|
||||
} -constraints {win moreThanOneDrive notInCIenv} -body {
|
||||
set path "[string range [lindex $drives 0] 0 1]foo"
|
||||
cd [lindex $drives 1]
|
||||
file norm $path
|
||||
|
||||
+7
-7
@@ -22,23 +22,23 @@ if {"::tcltest" ni [namespace children]} {
|
||||
catch {unset a i}
|
||||
test for-old-1.1 {for tests} {
|
||||
set a {}
|
||||
for {set i 1} {$i<6} {set i [expr $i+1]} {
|
||||
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} {set i [expr $i+1]} {
|
||||
if $i==4 continue
|
||||
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} {set i [expr $i+1]} {
|
||||
if $i==4 break
|
||||
for {set i 1} {$i<6} {incr i} {
|
||||
if {$i==4} break
|
||||
set a [concat $a $i]
|
||||
}
|
||||
set a
|
||||
@@ -55,12 +55,12 @@ test for-old-1.7 {for tests} {
|
||||
} {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]} {}
|
||||
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} {set i [expr $i+1]; if $i==4 break} {
|
||||
for {set i 1} {$i<6} {incr i; if {$i==4} break} {
|
||||
set a [concat $a $i]
|
||||
}
|
||||
set a
|
||||
|
||||
+70
-70
@@ -62,15 +62,15 @@ test for-1.8 {TclCompileForCmd: error compiling command body} -body {
|
||||
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
|
||||
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} {set i [expr $i+1]} "append a x"
|
||||
for {set i 1} {$i<6} {incr i} "append a x"
|
||||
set a
|
||||
} {xxxxx}
|
||||
test for-1.11 {TclCompileForCmd: computed command body} {
|
||||
@@ -81,7 +81,7 @@ test for-1.11 {TclCompileForCmd: computed command body} {
|
||||
set bb {break}
|
||||
set x2 {; append a x2}
|
||||
set a {}
|
||||
for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
|
||||
for {set i 1} {$i<6} {incr i} $x1$bb$x2
|
||||
set a
|
||||
} {x1}
|
||||
test for-1.12 {TclCompileForCmd: error in "next" command} -body {
|
||||
@@ -92,9 +92,9 @@ test for-1.12 {TclCompileForCmd: error in "next" command} -body {
|
||||
"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
|
||||
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
|
||||
@@ -129,7 +129,7 @@ test for-1.14 {TclCompileForCmd: for command result} {
|
||||
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 [for {set i 0} {$i < 5} {incr i} {if {$i==3} break}]
|
||||
set a
|
||||
} {}
|
||||
|
||||
@@ -144,7 +144,7 @@ test for-2.2 {TclCompileContinueCmd: continue result} {
|
||||
} 4
|
||||
test for-2.3 {continue tests} {
|
||||
set a {}
|
||||
for {set i 1} {$i <= 4} {set i [expr $i+1]} {
|
||||
for {set i 1} {$i <= 4} {incr i} {
|
||||
if {$i == 2} continue
|
||||
set a [concat $a $i]
|
||||
}
|
||||
@@ -152,7 +152,7 @@ test for-2.3 {continue tests} {
|
||||
} {1 3 4}
|
||||
test for-2.4 {continue tests} {
|
||||
set a {}
|
||||
for {set i 1} {$i <= 4} {set i [expr $i+1]} {
|
||||
for {set i 1} {$i <= 4} {incr i} {
|
||||
if {$i != 2} continue
|
||||
set a [concat $a $i]
|
||||
}
|
||||
@@ -170,10 +170,10 @@ test for-2.5 {continue tests, nested loops} {
|
||||
} {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
|
||||
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
|
||||
@@ -246,10 +246,10 @@ test for-3.4 {break tests, nested loops} {
|
||||
} {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
|
||||
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
|
||||
@@ -265,7 +265,7 @@ test for-3.5 {break tests, long command body} {
|
||||
catch {incr i 5} msg
|
||||
catch {incr i -5} msg
|
||||
}
|
||||
if $i==4 break
|
||||
if {$i==4} break
|
||||
if {$i>6 && $tcl_platform(machine)=="xxx"} {
|
||||
catch {set a $a} msg
|
||||
catch {incr i 5} msg
|
||||
@@ -303,35 +303,35 @@ proc formatMail {} {
|
||||
16 {This page contains information about Tcl 7.6 and Tk4.2, which are the most recent} \
|
||||
17 {releases of the Tcl scripting language and the Tk toolkit. The first beta versions of these} \
|
||||
18 {releases were released on August 30, 1996. These releases contain only minor changes,} \
|
||||
19 {so we hope to have only a single beta release and to go final in early October, 1996. } \
|
||||
19 {so we hope to have only a single beta release and to go final in early October, 1996.} \
|
||||
20 {} \
|
||||
21 {} \
|
||||
22 {What's new } \
|
||||
22 {What's new} \
|
||||
23 {} \
|
||||
24 {The most important changes in the releases are summarized below. See the README} \
|
||||
25 {and changes files in the distributions for more complete information on what has} \
|
||||
26 {changed, including both feature changes and bug fixes. } \
|
||||
26 {changed, including both feature changes and bug fixes.} \
|
||||
27 {} \
|
||||
28 { There are new options to the file command for copying files (file copy),} \
|
||||
29 { deleting files and directories (file delete), creating directories (file} \
|
||||
30 { mkdir), and renaming files (file rename). } \
|
||||
30 { mkdir), and renaming files (file rename).} \
|
||||
31 { The implementation of exec has been improved greatly for Windows 95 and} \
|
||||
32 { Windows NT. } \
|
||||
32 { Windows NT.} \
|
||||
33 { There is a new memory allocator for the Macintosh version, which should be} \
|
||||
34 { more efficient than the old one. } \
|
||||
34 { more efficient than the old one.} \
|
||||
35 { Tk's grid geometry manager has been completely rewritten. The layout} \
|
||||
36 { algorithm produces much better layouts than before, especially where rows or} \
|
||||
37 { columns were stretchable. } \
|
||||
37 { columns were stretchable.} \
|
||||
38 { There are new commands for creating common dialog boxes:} \
|
||||
39 { tk_chooseColor, tk_getOpenFile, tk_getSaveFile and} \
|
||||
40 { tk_messageBox. These use native dialog boxes if they are available. } \
|
||||
40 { tk_messageBox. These use native dialog boxes if they are available.} \
|
||||
41 { There is a new virtual event mechanism for handling events in a more portable} \
|
||||
42 { way. See the new command event. It also allows events (both physical and} \
|
||||
43 { virtual) to be generated dynamically. } \
|
||||
43 { virtual) to be generated dynamically.} \
|
||||
44 {} \
|
||||
45 {Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for} \
|
||||
46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \
|
||||
47 {should work on these new releases as well. } \
|
||||
47 {should work on these new releases as well.} \
|
||||
48 {} \
|
||||
49 {Obtaining The Releases} \
|
||||
50 {} \
|
||||
@@ -342,7 +342,7 @@ proc formatMail {} {
|
||||
55 { Windows 3.1, Windows 95, and Windows NT: Fetch} \
|
||||
56 { ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \
|
||||
57 { self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \
|
||||
58 { tclsh programs, and documentation. } \
|
||||
58 { tclsh programs, and documentation.} \
|
||||
59 { Macintosh (both 68K and PowerPC): Fetch} \
|
||||
60 { ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \
|
||||
61 { which is understood by Fetch, StuffIt, and many other Mac utilities. The} \
|
||||
@@ -386,7 +386,7 @@ proc formatMail {} {
|
||||
continue
|
||||
}
|
||||
}
|
||||
if $inheaders {
|
||||
if {$inheaders} {
|
||||
set limit 55
|
||||
} else {
|
||||
set limit 55
|
||||
@@ -430,12 +430,12 @@ proc formatMail {} {
|
||||
continue
|
||||
}
|
||||
}
|
||||
set climit [expr $limit-1]
|
||||
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} {
|
||||
for {set c [expr {$limit-1}]} {$c >= $cutoff} {incr c -1} {
|
||||
set char [string index $line $c]
|
||||
if {$char == " " || $char == "\t"} {
|
||||
break
|
||||
@@ -446,12 +446,12 @@ proc formatMail {} {
|
||||
}
|
||||
if {$c < $cutoff} {
|
||||
if {! $inheaders} {
|
||||
set c [expr $limit-1]
|
||||
set c [expr {$limit-1}]
|
||||
} else {
|
||||
set c [string length $line]
|
||||
}
|
||||
}
|
||||
set newline [string range $line 0 $c]
|
||||
set newline [string trimright [string range $line 0 $c]]
|
||||
if {! $continuation} {
|
||||
append result $newline $NL
|
||||
} else {
|
||||
@@ -507,76 +507,76 @@ releases of the Tcl scripting language and the Tk toolk
|
||||
it. The first beta versions of these
|
||||
releases were released on August 30, 1996. These releas
|
||||
es contain only minor changes,
|
||||
so we hope to have only a single beta release and to
|
||||
so we hope to have only a single beta release and to
|
||||
go final in early October, 1996.
|
||||
|
||||
|
||||
What's new
|
||||
What's new
|
||||
|
||||
The most important changes in the releases are summariz
|
||||
ed below. See the README
|
||||
and changes files in the distributions for more complet
|
||||
e information on what has
|
||||
changed, including both feature changes and bug fixes.
|
||||
changed, including both feature changes and bug fixes.
|
||||
|
||||
There are new options to the file command for
|
||||
There are new options to the file command for
|
||||
copying files (file copy),
|
||||
deleting files and directories (file delete),
|
||||
deleting files and directories (file delete),
|
||||
creating directories (file
|
||||
mkdir), and renaming files (file rename).
|
||||
mkdir), and renaming files (file rename).
|
||||
The implementation of exec has been improved great
|
||||
ly for Windows 95 and
|
||||
Windows NT.
|
||||
There is a new memory allocator for the Macintosh
|
||||
Windows NT.
|
||||
There is a new memory allocator for the Macintosh
|
||||
version, which should be
|
||||
more efficient than the old one.
|
||||
Tk's grid geometry manager has been completely
|
||||
more efficient than the old one.
|
||||
Tk's grid geometry manager has been completely
|
||||
rewritten. The layout
|
||||
algorithm produces much better layouts than before
|
||||
, especially where rows or
|
||||
columns were stretchable.
|
||||
There are new commands for creating common dialog
|
||||
columns were stretchable.
|
||||
There are new commands for creating common dialog
|
||||
boxes:
|
||||
tk_chooseColor, tk_getOpenFile, tk_getSaveFile and
|
||||
tk_messageBox. These use native dialog boxes if
|
||||
tk_messageBox. These use native dialog boxes if
|
||||
they are available.
|
||||
There is a new virtual event mechanism for handlin
|
||||
g events in a more portable
|
||||
way. See the new command event. It also allows
|
||||
way. See the new command event. It also allows
|
||||
events (both physical and
|
||||
virtual) to be generated dynamically.
|
||||
virtual) to be generated dynamically.
|
||||
|
||||
Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl
|
||||
Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl
|
||||
7.5 and Tk 4.1 except for
|
||||
changes in the C APIs for custom channel drivers. Scrip
|
||||
ts written for earlier releases
|
||||
should work on these new releases as well.
|
||||
should work on these new releases as well.
|
||||
|
||||
Obtaining The Releases
|
||||
|
||||
Binary Releases
|
||||
|
||||
Pre-compiled releases are available for the following
|
||||
Pre-compiled releases are available for the following
|
||||
platforms:
|
||||
|
||||
Windows 3.1, Windows 95, and Windows NT: Fetch
|
||||
ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
|
||||
ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
|
||||
execute it. The file is a
|
||||
self-extracting executable. It will install the
|
||||
self-extracting executable. It will install the
|
||||
Tcl and Tk libraries, the wish and
|
||||
tclsh programs, and documentation.
|
||||
tclsh programs, and documentation.
|
||||
Macintosh (both 68K and PowerPC): Fetch
|
||||
ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx.
|
||||
ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx.
|
||||
The file is in binhex format,
|
||||
which is understood by Fetch, StuffIt, and many
|
||||
which is understood by Fetch, StuffIt, and many
|
||||
other Mac utilities. The
|
||||
unpacked file is a self-installing executable:
|
||||
unpacked file is a self-installing executable:
|
||||
double-click on it and it will create a
|
||||
folder containing all that you need to run Tcl
|
||||
folder containing all that you need to run Tcl
|
||||
and Tk.
|
||||
UNIX (Solaris 2.* and SunOS, other systems
|
||||
UNIX (Solaris 2.* and SunOS, other systems
|
||||
soon to follow). Easy to install
|
||||
binary packages are now for sale at the Sun Labs
|
||||
binary packages are now for sale at the Sun Labs
|
||||
Tcl/Tk Shop. Check it out!
|
||||
}
|
||||
|
||||
@@ -585,7 +585,7 @@ Tcl/Tk Shop. Check it out!
|
||||
test for-4.1 {break must reset the interp result} {
|
||||
catch {
|
||||
set z GLOBTESTDIR/dir2/file2.c
|
||||
if [string match GLOBTESTDIR/dir2/* $z] {
|
||||
if {[string match GLOBTESTDIR/dir2/* $z]} {
|
||||
break
|
||||
}
|
||||
} j
|
||||
@@ -696,8 +696,8 @@ test for-6.9 {Tcl_ForObjCmd: error executing command body} -body {
|
||||
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
|
||||
$z {set i 1} {$i<6} {incr i} {
|
||||
if {$i==4} break
|
||||
set a [concat $a $i]
|
||||
}
|
||||
set a
|
||||
@@ -705,7 +705,7 @@ test for-6.10 {Tcl_ForObjCmd: simple command body} {
|
||||
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"
|
||||
$z {set i 1} {$i<6} {incr i} "append a x"
|
||||
set a
|
||||
} {xxxxx}
|
||||
test for-6.12 {Tcl_ForObjCmd: computed command body} {
|
||||
@@ -717,7 +717,7 @@ test for-6.12 {Tcl_ForObjCmd: computed command body} {
|
||||
set bb {break}
|
||||
set x2 {; append a x2}
|
||||
set a {}
|
||||
$z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
|
||||
$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 {
|
||||
@@ -733,9 +733,9 @@ test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body {
|
||||
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
|
||||
$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
|
||||
|
||||
+9
-5
@@ -18,10 +18,14 @@ if {"::tcltest" ni [namespace children]} {
|
||||
# %u output depends on word length, so this test is not portable.
|
||||
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
|
||||
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
|
||||
testConstraint wideIs64bit \
|
||||
[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
|
||||
testConstraint wideIs64bit [expr {
|
||||
(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
|
||||
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
|
||||
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
|
||||
# MSVC uses a broken libc that gets sprintf("%g") wrong. This is a pain
|
||||
# particularly in Continuous Integration, and there isn't anything much we can
|
||||
# do about it.
|
||||
testConstraint notWinCI [expr {
|
||||
($::tcl_platform(platform) ne "windows") || ![info exists ::env(CI)]}]
|
||||
|
||||
test format-1.1 {integer formatting} {
|
||||
format "%*d %d %d %d" 6 34 16923 -12 -1
|
||||
@@ -274,13 +278,13 @@ test format-6.1 {floating-point zeroes} {eformat} {
|
||||
test format-6.2 {floating-point zeroes} {eformat} {
|
||||
format "%.4e %.4f %.4g" 0.0 0.0 0.0 0.0
|
||||
} {0.0000e+00 0.0000 0}
|
||||
test format-6.3 {floating-point zeroes} {eformat knownMsvcBug} {
|
||||
test format-6.3 {floating-point zeroes} {eformat notWinCI} {
|
||||
format "%#.4e %#.4f %#.4g" 0.0 0.0 0.0 0.0
|
||||
} {0.0000e+00 0.0000 0.000}
|
||||
test format-6.4 {floating-point zeroes} {eformat} {
|
||||
format "%.0e %.0f %.0g" 0.0 0.0 0.0 0.0
|
||||
} {0e+00 0 0}
|
||||
test format-6.5 {floating-point zeroes} {eformat knownMsvcBug} {
|
||||
test format-6.5 {floating-point zeroes} {eformat notWinCI} {
|
||||
format "%#.0e %#.0f %#.0g" 0.0 0.0 0.0 0.0
|
||||
} {0.e+00 0. 0.}
|
||||
test format-6.6 {floating-point zeroes} {
|
||||
|
||||
+10
-8
@@ -40,7 +40,7 @@ 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]} \
|
||||
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]}
|
||||
@@ -149,11 +149,11 @@ test history-5.1 {info option} history {history info} [format {%6d set a {b
|
||||
%6d set b 1234
|
||||
%6d set c {a
|
||||
b
|
||||
c}} $num [expr $num+1] [expr $num+2]]
|
||||
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]]
|
||||
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
|
||||
@@ -164,7 +164,7 @@ test history-5.5 {info option} history {history} [format {%6d set a {b
|
||||
%6d set b 1234
|
||||
%6d set c {a
|
||||
b
|
||||
c}} $num [expr $num+1] [expr $num+2]]
|
||||
c}} $num [expr {$num+1}] [expr {$num+2}]]
|
||||
|
||||
# "history keep"
|
||||
|
||||
@@ -174,7 +174,9 @@ if {[testConstraint history]} {
|
||||
history add "foo3"
|
||||
history keep 2
|
||||
}
|
||||
test history-6.1 {keep option} history {history event [expr [history n]-1]} foo3
|
||||
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 {
|
||||
@@ -216,7 +218,7 @@ if {[testConstraint history]} {
|
||||
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.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
|
||||
@@ -262,7 +264,7 @@ test history-10.1 {references kept by history} -constraints history -setup {
|
||||
} -body {
|
||||
histtest eval {
|
||||
# A fresh object, refcount 1 from the variable we write it to
|
||||
set obj [expr rand()]
|
||||
set obj [expr {rand()}]
|
||||
set baseline [refcount $obj]
|
||||
lappend result [refcount $obj]
|
||||
history add [list list $obj]
|
||||
@@ -288,7 +290,7 @@ test history-10.2 {references kept by history} -constraints history -setup {
|
||||
} -body {
|
||||
histtest eval {
|
||||
# A fresh object, refcount 1 from the variable we write it to
|
||||
set obj [expr rand()]
|
||||
set obj [expr {rand()}]
|
||||
set baseline [refcount $obj]
|
||||
lappend result [refcount $obj]
|
||||
history add [list list $obj]
|
||||
|
||||
+1
-1
@@ -128,7 +128,7 @@ 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]
|
||||
set badurl //${::HOST}:[expr {$port+1}]
|
||||
test http-3.3 {http::geturl} -body {
|
||||
set token [http::geturl $url]
|
||||
http::data $token
|
||||
|
||||
+1
-1
@@ -49,7 +49,7 @@ catch {unset data}
|
||||
source [file join [file dirname [info script]] httpd]
|
||||
|
||||
set port 8010
|
||||
if [catch {httpd_init $port} listen] {
|
||||
if {[catch {httpd_init $port} listen]} {
|
||||
puts "Cannot start http server, http test skipped"
|
||||
unset port
|
||||
::tcltest::cleanupTests
|
||||
|
||||
+24
-24
@@ -142,7 +142,7 @@ test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 2
|
||||
@@ -165,7 +165,7 @@ test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 3
|
||||
@@ -239,7 +239,7 @@ test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 2
|
||||
@@ -262,7 +262,7 @@ test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 3
|
||||
@@ -287,7 +287,7 @@ test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 5
|
||||
@@ -310,7 +310,7 @@ test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 6
|
||||
@@ -389,7 +389,7 @@ test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 2
|
||||
@@ -412,7 +412,7 @@ test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 3
|
||||
@@ -437,7 +437,7 @@ test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 5
|
||||
@@ -460,7 +460,7 @@ test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 6
|
||||
@@ -485,7 +485,7 @@ test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 8
|
||||
@@ -508,7 +508,7 @@ test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 9
|
||||
@@ -713,7 +713,7 @@ test if-5.16 {if cmd with computed command names: test jumpFalse instruction rep
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 2
|
||||
@@ -736,7 +736,7 @@ test if-5.16 {if cmd with computed command names: test jumpFalse instruction rep
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 3
|
||||
@@ -816,7 +816,7 @@ test if-6.5 {if cmd with computed command names: test jumpFalse instruction repl
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 2
|
||||
@@ -839,7 +839,7 @@ test if-6.5 {if cmd with computed command names: test jumpFalse instruction repl
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 3
|
||||
@@ -864,7 +864,7 @@ test if-6.5 {if cmd with computed command names: test jumpFalse instruction repl
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 5
|
||||
@@ -887,7 +887,7 @@ test if-6.5 {if cmd with computed command names: test jumpFalse instruction repl
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 6
|
||||
@@ -975,7 +975,7 @@ test if-7.6 {if cmd with computed command names: test jumpFalse instruction repl
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 2
|
||||
@@ -998,7 +998,7 @@ test if-7.6 {if cmd with computed command names: test jumpFalse instruction repl
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 3
|
||||
@@ -1023,7 +1023,7 @@ test if-7.6 {if cmd with computed command names: test jumpFalse instruction repl
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 5
|
||||
@@ -1046,7 +1046,7 @@ test if-7.6 {if cmd with computed command names: test jumpFalse instruction repl
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 6
|
||||
@@ -1071,7 +1071,7 @@ test if-7.6 {if cmd with computed command names: test jumpFalse instruction repl
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 8
|
||||
@@ -1094,7 +1094,7 @@ test if-7.6 {if cmd with computed command names: test jumpFalse instruction repl
|
||||
set i $i
|
||||
set i [lindex $s $i]
|
||||
}
|
||||
set i [expr $i-1]
|
||||
incr i -1
|
||||
}
|
||||
}
|
||||
set a 9
|
||||
|
||||
+5
-5
@@ -325,7 +325,7 @@ test info-9.2 {info level option} {
|
||||
} {1 {t1 146 testString}}
|
||||
test info-9.3 {info level option} {
|
||||
proc t1 {a b} {
|
||||
t2 [expr $a*2] $b
|
||||
t2 [expr {$a*2}] $b
|
||||
}
|
||||
proc t2 {x y} {
|
||||
list [info level] [info level 1] [info level 2] [info level -1] \
|
||||
@@ -2099,7 +2099,7 @@ proc foo::bar {} {
|
||||
foreach {*}{
|
||||
x y
|
||||
{set res [info frame 0]}
|
||||
}
|
||||
}
|
||||
return $res
|
||||
}
|
||||
test info-33.13 {{*}, literal, simple, bytecompiled} -body {
|
||||
@@ -2114,7 +2114,7 @@ proc foo::bar {} {
|
||||
if {*}{
|
||||
{[return [info frame 0]]}
|
||||
{}
|
||||
}
|
||||
}
|
||||
}
|
||||
test info-33.14 {{*}, literal, simple, bytecompiled} -body {
|
||||
reduce [foo::bar]
|
||||
@@ -2128,7 +2128,7 @@ proc foo::bar {} {
|
||||
if 0 {*}{
|
||||
{} else
|
||||
{return [info frame 0]}
|
||||
}
|
||||
}
|
||||
}
|
||||
test info-33.15 {{*}, literal, simple, bytecompiled} -body {
|
||||
reduce [foo::bar]
|
||||
@@ -2229,7 +2229,7 @@ namespace eval foo {}
|
||||
proc foo::bar {} {
|
||||
try {*}{
|
||||
{set res [info frame 0]}
|
||||
}
|
||||
}
|
||||
return $res
|
||||
}
|
||||
test info-33.23 {{*}, literal, simple, bytecompiled} -body {
|
||||
|
||||
+22
-22
@@ -105,7 +105,7 @@ test interp-2.11 {anonymous interps vs existing procs} {
|
||||
proc interp$thenum {} {}
|
||||
set x [interp create]
|
||||
regexp "interp(\[0-9]+)" $x dummy anothernum
|
||||
expr $anothernum > $thenum
|
||||
expr {$anothernum > $thenum}
|
||||
} 1
|
||||
test interp-2.12 {anonymous interps vs existing procs} {
|
||||
set x [interp create -safe]
|
||||
@@ -114,7 +114,7 @@ test interp-2.12 {anonymous interps vs existing procs} {
|
||||
proc interp$thenum {} {}
|
||||
set x [interp create -safe]
|
||||
regexp "interp(\[0-9]+)" $x dummy anothernum
|
||||
expr $anothernum - $thenum
|
||||
expr {$anothernum - $thenum}
|
||||
} 1
|
||||
test interp-2.13 {correct default when no $path arg is given} -body {
|
||||
interp create --
|
||||
@@ -224,22 +224,22 @@ 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
|
||||
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 {proc foo {} {expr {3 + 5}}}
|
||||
a eval foo
|
||||
} 8
|
||||
catch {a eval {proc foo {} {expr 3 + 5}}}
|
||||
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} {proc frob {} {expr {4 * 9}}}
|
||||
interp eval {a x2} frob
|
||||
} 36
|
||||
catch {interp create {a x2}}
|
||||
@@ -746,7 +746,7 @@ test interp-16.5 {testing deletion order, bgerror} {
|
||||
xxx eval {proc bgerror {args} {exit}}
|
||||
xxx alias exit kill xxx
|
||||
proc kill {i} {interp delete $i}
|
||||
xxx eval after 100 expr a + b
|
||||
xxx eval after 100 expr {a + b}
|
||||
after 200
|
||||
update
|
||||
interp exists xxx
|
||||
@@ -966,7 +966,7 @@ test interp-19.9 {alias deletion, renaming} {
|
||||
interp create a
|
||||
interp alias a foo a bar
|
||||
interp eval a rename foo blotz
|
||||
interp eval a {proc foo {} {expr 34 * 34}}
|
||||
interp eval a {proc foo {} {expr {34 * 34}}}
|
||||
interp alias a foo {}
|
||||
set l [interp eval a foo]
|
||||
interp delete a
|
||||
@@ -3171,7 +3171,7 @@ test interp-34.3.1 {basic test of limits - pure inside-command loop} -body {
|
||||
}
|
||||
}
|
||||
# We use a time limit here; command limits don't trap this case
|
||||
$i limit time -seconds [expr {[clock seconds]+2}]
|
||||
$i limit time -seconds [expr {[clock seconds] + 2}]
|
||||
$i eval foobar
|
||||
} -returnCodes error -result {time limit exceeded} -cleanup {
|
||||
interp delete $i
|
||||
@@ -3193,8 +3193,8 @@ test interp-34.4 {limits with callbacks: extending limits} -setup {
|
||||
} -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 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 {
|
||||
@@ -3222,7 +3222,7 @@ test interp-34.5 {limits with callbacks: removing limits} -setup {
|
||||
} -body {
|
||||
interp alias $i foo {} cb1
|
||||
set curlim [$i eval info cmdcount]
|
||||
$i limit command -command "cb2 {}" -value [expr {$curlim+10}]
|
||||
$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 {
|
||||
@@ -3247,7 +3247,7 @@ test interp-34.6 {limits with callbacks: removing limits and handlers} -setup {
|
||||
} -body {
|
||||
interp alias $i foo {} cb1
|
||||
set curlim [$i eval info cmdcount]
|
||||
$i limit command -command cb2 -value [expr {$curlim+10}]
|
||||
$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 {
|
||||
@@ -3266,7 +3266,7 @@ test interp-34.7 {limits with callbacks: deleting the handler interp} -setup {
|
||||
proc cb2 {args} {
|
||||
global c i curlim
|
||||
set c b
|
||||
$i limit command -value [expr {$curlim+1000}]
|
||||
$i limit command -value [expr {$curlim + 1000}]
|
||||
trapToParent
|
||||
}
|
||||
}
|
||||
@@ -3289,7 +3289,7 @@ test interp-34.7 {limits with callbacks: deleting the handler interp} -setup {
|
||||
set c a
|
||||
interp alias $i foo {} cb1
|
||||
set curlim [$i eval info cmdcount]
|
||||
$i limit command -command cb2 -value [expr {$curlim+10}]
|
||||
$i limit command -command cb2 -value [expr {$curlim + 10}]
|
||||
}
|
||||
$i eval {
|
||||
$i eval {
|
||||
@@ -3304,7 +3304,7 @@ test interp-34.7 {limits with callbacks: deleting the handler interp} -setup {
|
||||
# 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
|
||||
interp limit $i time -seconds [expr {[clock seconds] + 1}] -granularity 1
|
||||
$i eval {
|
||||
set x {}
|
||||
vwait x
|
||||
@@ -3352,8 +3352,8 @@ test interp-34.11 {time limit extension in callbacks} -setup {
|
||||
} -body {
|
||||
set i [interp create]
|
||||
set t0 [clock seconds]
|
||||
$i limit time -seconds [expr {$t0+1}] -granularity 1 \
|
||||
-command "cb1 $i [expr {$t0+2}]"
|
||||
$i limit time -seconds [expr {$t0 + 1}] -granularity 1 \
|
||||
-command "cb1 $i [expr {$t0 + 2}]"
|
||||
set ::result {}
|
||||
lappend ::result [catch {
|
||||
$i eval {
|
||||
@@ -3380,8 +3380,8 @@ test interp-34.12 {time limit extension in callbacks} -setup {
|
||||
} -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 ::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 {
|
||||
@@ -3615,8 +3615,8 @@ test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup {
|
||||
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)}]
|
||||
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
|
||||
|
||||
+10
-7
@@ -43,7 +43,10 @@ testConstraint testchannelevent [llength [info commands testchannelevent]]
|
||||
testConstraint testmainthread [llength [info commands testmainthread]]
|
||||
testConstraint testobj [llength [info commands testobj]]
|
||||
testConstraint testservicemode [llength [info commands testservicemode]]
|
||||
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
|
||||
# Some things fail under Windows in Continuous Integration systems for subtle
|
||||
# reasons such as CI often running with elevated privileges in a container.
|
||||
testConstraint notWinCI [expr {
|
||||
$::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
|
||||
testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
|
||||
|
||||
# You need a *very* special environment to do some tests. In
|
||||
@@ -2230,7 +2233,7 @@ test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \
|
||||
set path(pipe) [makeFile {} pipe]
|
||||
set path(output) [makeFile {} output]
|
||||
test io-27.6 {FlushChannel, async flushing, async close} \
|
||||
{stdio asyncPipeClose knownMsvcBug} {
|
||||
{stdio asyncPipeClose notWinCI} {
|
||||
# This test may fail on old Unix systems (seen on IRIX64 6.5) with
|
||||
# obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
|
||||
file delete $path(pipe)
|
||||
@@ -2834,7 +2837,7 @@ test io-29.31 {Tcl_WriteChars, background flush} stdio {
|
||||
set result
|
||||
} ok
|
||||
test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
|
||||
{stdio asyncPipeClose knownMsvcBug} {
|
||||
{stdio asyncPipeClose notWinCI} {
|
||||
# This test may fail on old Unix systems (seen on IRIX64 6.5) with
|
||||
# obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
|
||||
file delete $path(pipe)
|
||||
@@ -7514,7 +7517,7 @@ test io-53.5 {CopyData: error during fcopy} {socket fcopy} {
|
||||
close $listen ;# This means the socket open never really succeeds
|
||||
fcopy $in $out -command [namespace code FcopyTestDone]
|
||||
variable fcopyTestDone
|
||||
if ![info exists fcopyTestDone] {
|
||||
if {![info exists fcopyTestDone]} {
|
||||
vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g.
|
||||
}
|
||||
close $in
|
||||
@@ -7533,7 +7536,7 @@ test io-53.6 {CopyData: error during fcopy} {stdio fcopy} {
|
||||
set out [open $path(test1) w]
|
||||
fcopy $in $out -command [namespace code FcopyTestDone]
|
||||
variable fcopyTestDone
|
||||
if ![info exists fcopyTestDone] {
|
||||
if {![info exists fcopyTestDone]} {
|
||||
vwait [namespace which -variable fcopyTestDone]
|
||||
}
|
||||
catch {close $in}
|
||||
@@ -7580,7 +7583,7 @@ test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio fcopy} {
|
||||
set out [open $path(test1) w]
|
||||
doFcopy $in $out
|
||||
variable fcopyTestDone
|
||||
if ![info exists fcopyTestDone] {
|
||||
if {![info exists fcopyTestDone]} {
|
||||
vwait [namespace which -variable fcopyTestDone]
|
||||
}
|
||||
catch {close $in}
|
||||
@@ -8068,7 +8071,7 @@ test io-53.17 {[7c187a3773] MBWrite: proper inQueueTail handling} -setup {
|
||||
removeFile out
|
||||
} -result {line 100 line}
|
||||
|
||||
test io-54.1 {Recursive channel events} {socket fileevent knownMsvcBug} {
|
||||
test io-54.1 {Recursive channel events} {socket fileevent notWinCI} {
|
||||
# This test checks to see if file events are delivered during recursive
|
||||
# event loops when there is buffered data on the channel.
|
||||
|
||||
|
||||
+7
-7
@@ -98,26 +98,26 @@ concat {}
|
||||
|
||||
proc slowsort list {
|
||||
set result {}
|
||||
set last [expr [llength $list] - 1]
|
||||
set last [expr {[llength $list] - 1}]
|
||||
while {$last > 0} {
|
||||
set minIndex [expr [llength $list] - 1]
|
||||
set minIndex [expr {[llength $list] - 1}]
|
||||
set min [lindex $list $last]
|
||||
set i [expr $minIndex-1]
|
||||
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]
|
||||
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 list [concat [lrange $list 0 [expr {$minIndex - 1}]] \
|
||||
[lrange $list [expr {$minIndex + 1}] end]]
|
||||
}
|
||||
set last [expr $last-1]
|
||||
set last [expr {$last - 1}]
|
||||
}
|
||||
return [concat $result $list]
|
||||
}
|
||||
|
||||
+60
-58
@@ -45,30 +45,30 @@ testConstraint teststaticpkg [llength [info commands teststaticpkg]]
|
||||
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-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] {
|
||||
@@ -130,16 +130,16 @@ test load-4.2 {reloading package into same interpreter} -setup {
|
||||
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] {
|
||||
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 {
|
||||
load -global [file join $testDir pkga$ext] pkga
|
||||
load {} pkga x
|
||||
set result [info loaded x]
|
||||
info loaded x
|
||||
} -cleanup {
|
||||
interp delete x
|
||||
set result
|
||||
} [list [list [file join $testDir pkga$ext] Pkga]]
|
||||
} -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.
|
||||
@@ -185,16 +185,16 @@ test load-7.4 {Tcl_StaticPackage procedure, redundant calls} -setup {
|
||||
info loaded
|
||||
} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]
|
||||
|
||||
testConstraint teststaticpkg_8.x \
|
||||
[if {[testConstraint teststaticpkg]} {
|
||||
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
|
||||
expr 1
|
||||
} else {
|
||||
expr 0
|
||||
}]
|
||||
testConstraint teststaticpkg_8.x 1
|
||||
}
|
||||
}
|
||||
|
||||
test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
|
||||
lsort -index 1 [info loaded]
|
||||
@@ -214,30 +214,32 @@ test load-8.4 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loa
|
||||
} [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-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} \
|
||||
-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-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] {
|
||||
|
||||
+1
-1
@@ -384,7 +384,7 @@ test lsearch-14.8 {combinations: -start, -inline and -not} {
|
||||
} {c4}
|
||||
|
||||
test lsearch-15.1 {make sure no shimmering occurs} {
|
||||
set x [expr int(sin(0))]
|
||||
set x [expr {int(sin(0))}]
|
||||
lsearch -start $x $x $x
|
||||
} 0
|
||||
|
||||
|
||||
+253
-253
@@ -22,7 +22,7 @@ if {"::tcltest" ni [namespace children]} {
|
||||
proc evalInProc { script } {
|
||||
proc testProc {} $script
|
||||
set status [catch {
|
||||
testProc
|
||||
testProc
|
||||
} result]
|
||||
rename testProc {}
|
||||
return [list $status $result]
|
||||
@@ -60,69 +60,69 @@ test lsetComp-2.3 {lset, compiled, list of args, scalar, one-byte offset} {
|
||||
|
||||
test lsetComp-2.4 {lset, compiled, list of args, scalar, four-byte offset} {
|
||||
evalInProc {
|
||||
set x0 0; set x1 0; set x2 0; set x3 0;
|
||||
set x4 0; set x5 0; set x6 0; set x7 0;
|
||||
set x8 0; set x9 0; set x10 0; set x11 0;
|
||||
set x12 0; set x13 0; set x14 0; set x15 0;
|
||||
set x16 0; set x17 0; set x18 0; set x19 0;
|
||||
set x20 0; set x21 0; set x22 0; set x23 0;
|
||||
set x24 0; set x25 0; set x26 0; set x27 0;
|
||||
set x28 0; set x29 0; set x30 0; set x31 0;
|
||||
set x32 0; set x33 0; set x34 0; set x35 0;
|
||||
set x36 0; set x37 0; set x38 0; set x39 0;
|
||||
set x40 0; set x41 0; set x42 0; set x43 0;
|
||||
set x44 0; set x45 0; set x46 0; set x47 0;
|
||||
set x48 0; set x49 0; set x50 0; set x51 0;
|
||||
set x52 0; set x53 0; set x54 0; set x55 0;
|
||||
set x56 0; set x57 0; set x58 0; set x59 0;
|
||||
set x60 0; set x61 0; set x62 0; set x63 0;
|
||||
set x64 0; set x65 0; set x66 0; set x67 0;
|
||||
set x68 0; set x69 0; set x70 0; set x71 0;
|
||||
set x72 0; set x73 0; set x74 0; set x75 0;
|
||||
set x76 0; set x77 0; set x78 0; set x79 0;
|
||||
set x80 0; set x81 0; set x82 0; set x83 0;
|
||||
set x84 0; set x85 0; set x86 0; set x87 0;
|
||||
set x88 0; set x89 0; set x90 0; set x91 0;
|
||||
set x92 0; set x93 0; set x94 0; set x95 0;
|
||||
set x96 0; set x97 0; set x98 0; set x99 0;
|
||||
set x100 0; set x101 0; set x102 0; set x103 0;
|
||||
set x104 0; set x105 0; set x106 0; set x107 0;
|
||||
set x108 0; set x109 0; set x110 0; set x111 0;
|
||||
set x112 0; set x113 0; set x114 0; set x115 0;
|
||||
set x116 0; set x117 0; set x118 0; set x119 0;
|
||||
set x120 0; set x121 0; set x122 0; set x123 0;
|
||||
set x124 0; set x125 0; set x126 0; set x127 0;
|
||||
set x128 0; set x129 0; set x130 0; set x131 0;
|
||||
set x132 0; set x133 0; set x134 0; set x135 0;
|
||||
set x136 0; set x137 0; set x138 0; set x139 0;
|
||||
set x140 0; set x141 0; set x142 0; set x143 0;
|
||||
set x144 0; set x145 0; set x146 0; set x147 0;
|
||||
set x148 0; set x149 0; set x150 0; set x151 0;
|
||||
set x152 0; set x153 0; set x154 0; set x155 0;
|
||||
set x156 0; set x157 0; set x158 0; set x159 0;
|
||||
set x160 0; set x161 0; set x162 0; set x163 0;
|
||||
set x164 0; set x165 0; set x166 0; set x167 0;
|
||||
set x168 0; set x169 0; set x170 0; set x171 0;
|
||||
set x172 0; set x173 0; set x174 0; set x175 0;
|
||||
set x176 0; set x177 0; set x178 0; set x179 0;
|
||||
set x180 0; set x181 0; set x182 0; set x183 0;
|
||||
set x184 0; set x185 0; set x186 0; set x187 0;
|
||||
set x188 0; set x189 0; set x190 0; set x191 0;
|
||||
set x192 0; set x193 0; set x194 0; set x195 0;
|
||||
set x196 0; set x197 0; set x198 0; set x199 0;
|
||||
set x200 0; set x201 0; set x202 0; set x203 0;
|
||||
set x204 0; set x205 0; set x206 0; set x207 0;
|
||||
set x208 0; set x209 0; set x210 0; set x211 0;
|
||||
set x212 0; set x213 0; set x214 0; set x215 0;
|
||||
set x216 0; set x217 0; set x218 0; set x219 0;
|
||||
set x220 0; set x221 0; set x222 0; set x223 0;
|
||||
set x224 0; set x225 0; set x226 0; set x227 0;
|
||||
set x228 0; set x229 0; set x230 0; set x231 0;
|
||||
set x232 0; set x233 0; set x234 0; set x235 0;
|
||||
set x236 0; set x237 0; set x238 0; set x239 0;
|
||||
set x240 0; set x241 0; set x242 0; set x243 0;
|
||||
set x244 0; set x245 0; set x246 0; set x247 0;
|
||||
set x248 0; set x249 0; set x250 0; set x251 0;
|
||||
set x0 0; set x1 0; set x2 0; set x3 0;
|
||||
set x4 0; set x5 0; set x6 0; set x7 0;
|
||||
set x8 0; set x9 0; set x10 0; set x11 0;
|
||||
set x12 0; set x13 0; set x14 0; set x15 0;
|
||||
set x16 0; set x17 0; set x18 0; set x19 0;
|
||||
set x20 0; set x21 0; set x22 0; set x23 0;
|
||||
set x24 0; set x25 0; set x26 0; set x27 0;
|
||||
set x28 0; set x29 0; set x30 0; set x31 0;
|
||||
set x32 0; set x33 0; set x34 0; set x35 0;
|
||||
set x36 0; set x37 0; set x38 0; set x39 0;
|
||||
set x40 0; set x41 0; set x42 0; set x43 0;
|
||||
set x44 0; set x45 0; set x46 0; set x47 0;
|
||||
set x48 0; set x49 0; set x50 0; set x51 0;
|
||||
set x52 0; set x53 0; set x54 0; set x55 0;
|
||||
set x56 0; set x57 0; set x58 0; set x59 0;
|
||||
set x60 0; set x61 0; set x62 0; set x63 0;
|
||||
set x64 0; set x65 0; set x66 0; set x67 0;
|
||||
set x68 0; set x69 0; set x70 0; set x71 0;
|
||||
set x72 0; set x73 0; set x74 0; set x75 0;
|
||||
set x76 0; set x77 0; set x78 0; set x79 0;
|
||||
set x80 0; set x81 0; set x82 0; set x83 0;
|
||||
set x84 0; set x85 0; set x86 0; set x87 0;
|
||||
set x88 0; set x89 0; set x90 0; set x91 0;
|
||||
set x92 0; set x93 0; set x94 0; set x95 0;
|
||||
set x96 0; set x97 0; set x98 0; set x99 0;
|
||||
set x100 0; set x101 0; set x102 0; set x103 0;
|
||||
set x104 0; set x105 0; set x106 0; set x107 0;
|
||||
set x108 0; set x109 0; set x110 0; set x111 0;
|
||||
set x112 0; set x113 0; set x114 0; set x115 0;
|
||||
set x116 0; set x117 0; set x118 0; set x119 0;
|
||||
set x120 0; set x121 0; set x122 0; set x123 0;
|
||||
set x124 0; set x125 0; set x126 0; set x127 0;
|
||||
set x128 0; set x129 0; set x130 0; set x131 0;
|
||||
set x132 0; set x133 0; set x134 0; set x135 0;
|
||||
set x136 0; set x137 0; set x138 0; set x139 0;
|
||||
set x140 0; set x141 0; set x142 0; set x143 0;
|
||||
set x144 0; set x145 0; set x146 0; set x147 0;
|
||||
set x148 0; set x149 0; set x150 0; set x151 0;
|
||||
set x152 0; set x153 0; set x154 0; set x155 0;
|
||||
set x156 0; set x157 0; set x158 0; set x159 0;
|
||||
set x160 0; set x161 0; set x162 0; set x163 0;
|
||||
set x164 0; set x165 0; set x166 0; set x167 0;
|
||||
set x168 0; set x169 0; set x170 0; set x171 0;
|
||||
set x172 0; set x173 0; set x174 0; set x175 0;
|
||||
set x176 0; set x177 0; set x178 0; set x179 0;
|
||||
set x180 0; set x181 0; set x182 0; set x183 0;
|
||||
set x184 0; set x185 0; set x186 0; set x187 0;
|
||||
set x188 0; set x189 0; set x190 0; set x191 0;
|
||||
set x192 0; set x193 0; set x194 0; set x195 0;
|
||||
set x196 0; set x197 0; set x198 0; set x199 0;
|
||||
set x200 0; set x201 0; set x202 0; set x203 0;
|
||||
set x204 0; set x205 0; set x206 0; set x207 0;
|
||||
set x208 0; set x209 0; set x210 0; set x211 0;
|
||||
set x212 0; set x213 0; set x214 0; set x215 0;
|
||||
set x216 0; set x217 0; set x218 0; set x219 0;
|
||||
set x220 0; set x221 0; set x222 0; set x223 0;
|
||||
set x224 0; set x225 0; set x226 0; set x227 0;
|
||||
set x228 0; set x229 0; set x230 0; set x231 0;
|
||||
set x232 0; set x233 0; set x234 0; set x235 0;
|
||||
set x236 0; set x237 0; set x238 0; set x239 0;
|
||||
set x240 0; set x241 0; set x242 0; set x243 0;
|
||||
set x244 0; set x245 0; set x246 0; set x247 0;
|
||||
set x248 0; set x249 0; set x250 0; set x251 0;
|
||||
set x252 0; set x253 0; set x254 0; set x255 0;
|
||||
set x {{1 2} {3 4}}
|
||||
lset x {1 1} 5
|
||||
@@ -145,69 +145,69 @@ test lsetComp-2.6 {lset, compiled, list of args, array, one-byte offset} {
|
||||
|
||||
test lsetComp-2.7 {lset, compiled, list of args, array, four-byte offset} {
|
||||
evalInProc {
|
||||
set x0 0; set x1 0; set x2 0; set x3 0;
|
||||
set x4 0; set x5 0; set x6 0; set x7 0;
|
||||
set x8 0; set x9 0; set x10 0; set x11 0;
|
||||
set x12 0; set x13 0; set x14 0; set x15 0;
|
||||
set x16 0; set x17 0; set x18 0; set x19 0;
|
||||
set x20 0; set x21 0; set x22 0; set x23 0;
|
||||
set x24 0; set x25 0; set x26 0; set x27 0;
|
||||
set x28 0; set x29 0; set x30 0; set x31 0;
|
||||
set x32 0; set x33 0; set x34 0; set x35 0;
|
||||
set x36 0; set x37 0; set x38 0; set x39 0;
|
||||
set x40 0; set x41 0; set x42 0; set x43 0;
|
||||
set x44 0; set x45 0; set x46 0; set x47 0;
|
||||
set x48 0; set x49 0; set x50 0; set x51 0;
|
||||
set x52 0; set x53 0; set x54 0; set x55 0;
|
||||
set x56 0; set x57 0; set x58 0; set x59 0;
|
||||
set x60 0; set x61 0; set x62 0; set x63 0;
|
||||
set x64 0; set x65 0; set x66 0; set x67 0;
|
||||
set x68 0; set x69 0; set x70 0; set x71 0;
|
||||
set x72 0; set x73 0; set x74 0; set x75 0;
|
||||
set x76 0; set x77 0; set x78 0; set x79 0;
|
||||
set x80 0; set x81 0; set x82 0; set x83 0;
|
||||
set x84 0; set x85 0; set x86 0; set x87 0;
|
||||
set x88 0; set x89 0; set x90 0; set x91 0;
|
||||
set x92 0; set x93 0; set x94 0; set x95 0;
|
||||
set x96 0; set x97 0; set x98 0; set x99 0;
|
||||
set x100 0; set x101 0; set x102 0; set x103 0;
|
||||
set x104 0; set x105 0; set x106 0; set x107 0;
|
||||
set x108 0; set x109 0; set x110 0; set x111 0;
|
||||
set x112 0; set x113 0; set x114 0; set x115 0;
|
||||
set x116 0; set x117 0; set x118 0; set x119 0;
|
||||
set x120 0; set x121 0; set x122 0; set x123 0;
|
||||
set x124 0; set x125 0; set x126 0; set x127 0;
|
||||
set x128 0; set x129 0; set x130 0; set x131 0;
|
||||
set x132 0; set x133 0; set x134 0; set x135 0;
|
||||
set x136 0; set x137 0; set x138 0; set x139 0;
|
||||
set x140 0; set x141 0; set x142 0; set x143 0;
|
||||
set x144 0; set x145 0; set x146 0; set x147 0;
|
||||
set x148 0; set x149 0; set x150 0; set x151 0;
|
||||
set x152 0; set x153 0; set x154 0; set x155 0;
|
||||
set x156 0; set x157 0; set x158 0; set x159 0;
|
||||
set x160 0; set x161 0; set x162 0; set x163 0;
|
||||
set x164 0; set x165 0; set x166 0; set x167 0;
|
||||
set x168 0; set x169 0; set x170 0; set x171 0;
|
||||
set x172 0; set x173 0; set x174 0; set x175 0;
|
||||
set x176 0; set x177 0; set x178 0; set x179 0;
|
||||
set x180 0; set x181 0; set x182 0; set x183 0;
|
||||
set x184 0; set x185 0; set x186 0; set x187 0;
|
||||
set x188 0; set x189 0; set x190 0; set x191 0;
|
||||
set x192 0; set x193 0; set x194 0; set x195 0;
|
||||
set x196 0; set x197 0; set x198 0; set x199 0;
|
||||
set x200 0; set x201 0; set x202 0; set x203 0;
|
||||
set x204 0; set x205 0; set x206 0; set x207 0;
|
||||
set x208 0; set x209 0; set x210 0; set x211 0;
|
||||
set x212 0; set x213 0; set x214 0; set x215 0;
|
||||
set x216 0; set x217 0; set x218 0; set x219 0;
|
||||
set x220 0; set x221 0; set x222 0; set x223 0;
|
||||
set x224 0; set x225 0; set x226 0; set x227 0;
|
||||
set x228 0; set x229 0; set x230 0; set x231 0;
|
||||
set x232 0; set x233 0; set x234 0; set x235 0;
|
||||
set x236 0; set x237 0; set x238 0; set x239 0;
|
||||
set x240 0; set x241 0; set x242 0; set x243 0;
|
||||
set x244 0; set x245 0; set x246 0; set x247 0;
|
||||
set x248 0; set x249 0; set x250 0; set x251 0;
|
||||
set x0 0; set x1 0; set x2 0; set x3 0;
|
||||
set x4 0; set x5 0; set x6 0; set x7 0;
|
||||
set x8 0; set x9 0; set x10 0; set x11 0;
|
||||
set x12 0; set x13 0; set x14 0; set x15 0;
|
||||
set x16 0; set x17 0; set x18 0; set x19 0;
|
||||
set x20 0; set x21 0; set x22 0; set x23 0;
|
||||
set x24 0; set x25 0; set x26 0; set x27 0;
|
||||
set x28 0; set x29 0; set x30 0; set x31 0;
|
||||
set x32 0; set x33 0; set x34 0; set x35 0;
|
||||
set x36 0; set x37 0; set x38 0; set x39 0;
|
||||
set x40 0; set x41 0; set x42 0; set x43 0;
|
||||
set x44 0; set x45 0; set x46 0; set x47 0;
|
||||
set x48 0; set x49 0; set x50 0; set x51 0;
|
||||
set x52 0; set x53 0; set x54 0; set x55 0;
|
||||
set x56 0; set x57 0; set x58 0; set x59 0;
|
||||
set x60 0; set x61 0; set x62 0; set x63 0;
|
||||
set x64 0; set x65 0; set x66 0; set x67 0;
|
||||
set x68 0; set x69 0; set x70 0; set x71 0;
|
||||
set x72 0; set x73 0; set x74 0; set x75 0;
|
||||
set x76 0; set x77 0; set x78 0; set x79 0;
|
||||
set x80 0; set x81 0; set x82 0; set x83 0;
|
||||
set x84 0; set x85 0; set x86 0; set x87 0;
|
||||
set x88 0; set x89 0; set x90 0; set x91 0;
|
||||
set x92 0; set x93 0; set x94 0; set x95 0;
|
||||
set x96 0; set x97 0; set x98 0; set x99 0;
|
||||
set x100 0; set x101 0; set x102 0; set x103 0;
|
||||
set x104 0; set x105 0; set x106 0; set x107 0;
|
||||
set x108 0; set x109 0; set x110 0; set x111 0;
|
||||
set x112 0; set x113 0; set x114 0; set x115 0;
|
||||
set x116 0; set x117 0; set x118 0; set x119 0;
|
||||
set x120 0; set x121 0; set x122 0; set x123 0;
|
||||
set x124 0; set x125 0; set x126 0; set x127 0;
|
||||
set x128 0; set x129 0; set x130 0; set x131 0;
|
||||
set x132 0; set x133 0; set x134 0; set x135 0;
|
||||
set x136 0; set x137 0; set x138 0; set x139 0;
|
||||
set x140 0; set x141 0; set x142 0; set x143 0;
|
||||
set x144 0; set x145 0; set x146 0; set x147 0;
|
||||
set x148 0; set x149 0; set x150 0; set x151 0;
|
||||
set x152 0; set x153 0; set x154 0; set x155 0;
|
||||
set x156 0; set x157 0; set x158 0; set x159 0;
|
||||
set x160 0; set x161 0; set x162 0; set x163 0;
|
||||
set x164 0; set x165 0; set x166 0; set x167 0;
|
||||
set x168 0; set x169 0; set x170 0; set x171 0;
|
||||
set x172 0; set x173 0; set x174 0; set x175 0;
|
||||
set x176 0; set x177 0; set x178 0; set x179 0;
|
||||
set x180 0; set x181 0; set x182 0; set x183 0;
|
||||
set x184 0; set x185 0; set x186 0; set x187 0;
|
||||
set x188 0; set x189 0; set x190 0; set x191 0;
|
||||
set x192 0; set x193 0; set x194 0; set x195 0;
|
||||
set x196 0; set x197 0; set x198 0; set x199 0;
|
||||
set x200 0; set x201 0; set x202 0; set x203 0;
|
||||
set x204 0; set x205 0; set x206 0; set x207 0;
|
||||
set x208 0; set x209 0; set x210 0; set x211 0;
|
||||
set x212 0; set x213 0; set x214 0; set x215 0;
|
||||
set x216 0; set x217 0; set x218 0; set x219 0;
|
||||
set x220 0; set x221 0; set x222 0; set x223 0;
|
||||
set x224 0; set x225 0; set x226 0; set x227 0;
|
||||
set x228 0; set x229 0; set x230 0; set x231 0;
|
||||
set x232 0; set x233 0; set x234 0; set x235 0;
|
||||
set x236 0; set x237 0; set x238 0; set x239 0;
|
||||
set x240 0; set x241 0; set x242 0; set x243 0;
|
||||
set x244 0; set x245 0; set x246 0; set x247 0;
|
||||
set x248 0; set x249 0; set x250 0; set x251 0;
|
||||
set x252 0; set x253 0; set x254 0; set x255 0;
|
||||
set y(0) {{1 2} {3 4}}
|
||||
lset y(0) {1 1} 5
|
||||
@@ -253,69 +253,69 @@ test lsetComp-3.3 {lset, compiled, flat args, scalar, one-byte offset} {
|
||||
|
||||
test lsetComp-3.4 {lset, compiled, scalar, four-byte offset} {
|
||||
evalInProc {
|
||||
set x0 0; set x1 0; set x2 0; set x3 0;
|
||||
set x4 0; set x5 0; set x6 0; set x7 0;
|
||||
set x8 0; set x9 0; set x10 0; set x11 0;
|
||||
set x12 0; set x13 0; set x14 0; set x15 0;
|
||||
set x16 0; set x17 0; set x18 0; set x19 0;
|
||||
set x20 0; set x21 0; set x22 0; set x23 0;
|
||||
set x24 0; set x25 0; set x26 0; set x27 0;
|
||||
set x28 0; set x29 0; set x30 0; set x31 0;
|
||||
set x32 0; set x33 0; set x34 0; set x35 0;
|
||||
set x36 0; set x37 0; set x38 0; set x39 0;
|
||||
set x40 0; set x41 0; set x42 0; set x43 0;
|
||||
set x44 0; set x45 0; set x46 0; set x47 0;
|
||||
set x48 0; set x49 0; set x50 0; set x51 0;
|
||||
set x52 0; set x53 0; set x54 0; set x55 0;
|
||||
set x56 0; set x57 0; set x58 0; set x59 0;
|
||||
set x60 0; set x61 0; set x62 0; set x63 0;
|
||||
set x64 0; set x65 0; set x66 0; set x67 0;
|
||||
set x68 0; set x69 0; set x70 0; set x71 0;
|
||||
set x72 0; set x73 0; set x74 0; set x75 0;
|
||||
set x76 0; set x77 0; set x78 0; set x79 0;
|
||||
set x80 0; set x81 0; set x82 0; set x83 0;
|
||||
set x84 0; set x85 0; set x86 0; set x87 0;
|
||||
set x88 0; set x89 0; set x90 0; set x91 0;
|
||||
set x92 0; set x93 0; set x94 0; set x95 0;
|
||||
set x96 0; set x97 0; set x98 0; set x99 0;
|
||||
set x100 0; set x101 0; set x102 0; set x103 0;
|
||||
set x104 0; set x105 0; set x106 0; set x107 0;
|
||||
set x108 0; set x109 0; set x110 0; set x111 0;
|
||||
set x112 0; set x113 0; set x114 0; set x115 0;
|
||||
set x116 0; set x117 0; set x118 0; set x119 0;
|
||||
set x120 0; set x121 0; set x122 0; set x123 0;
|
||||
set x124 0; set x125 0; set x126 0; set x127 0;
|
||||
set x128 0; set x129 0; set x130 0; set x131 0;
|
||||
set x132 0; set x133 0; set x134 0; set x135 0;
|
||||
set x136 0; set x137 0; set x138 0; set x139 0;
|
||||
set x140 0; set x141 0; set x142 0; set x143 0;
|
||||
set x144 0; set x145 0; set x146 0; set x147 0;
|
||||
set x148 0; set x149 0; set x150 0; set x151 0;
|
||||
set x152 0; set x153 0; set x154 0; set x155 0;
|
||||
set x156 0; set x157 0; set x158 0; set x159 0;
|
||||
set x160 0; set x161 0; set x162 0; set x163 0;
|
||||
set x164 0; set x165 0; set x166 0; set x167 0;
|
||||
set x168 0; set x169 0; set x170 0; set x171 0;
|
||||
set x172 0; set x173 0; set x174 0; set x175 0;
|
||||
set x176 0; set x177 0; set x178 0; set x179 0;
|
||||
set x180 0; set x181 0; set x182 0; set x183 0;
|
||||
set x184 0; set x185 0; set x186 0; set x187 0;
|
||||
set x188 0; set x189 0; set x190 0; set x191 0;
|
||||
set x192 0; set x193 0; set x194 0; set x195 0;
|
||||
set x196 0; set x197 0; set x198 0; set x199 0;
|
||||
set x200 0; set x201 0; set x202 0; set x203 0;
|
||||
set x204 0; set x205 0; set x206 0; set x207 0;
|
||||
set x208 0; set x209 0; set x210 0; set x211 0;
|
||||
set x212 0; set x213 0; set x214 0; set x215 0;
|
||||
set x216 0; set x217 0; set x218 0; set x219 0;
|
||||
set x220 0; set x221 0; set x222 0; set x223 0;
|
||||
set x224 0; set x225 0; set x226 0; set x227 0;
|
||||
set x228 0; set x229 0; set x230 0; set x231 0;
|
||||
set x232 0; set x233 0; set x234 0; set x235 0;
|
||||
set x236 0; set x237 0; set x238 0; set x239 0;
|
||||
set x240 0; set x241 0; set x242 0; set x243 0;
|
||||
set x244 0; set x245 0; set x246 0; set x247 0;
|
||||
set x248 0; set x249 0; set x250 0; set x251 0;
|
||||
set x0 0; set x1 0; set x2 0; set x3 0;
|
||||
set x4 0; set x5 0; set x6 0; set x7 0;
|
||||
set x8 0; set x9 0; set x10 0; set x11 0;
|
||||
set x12 0; set x13 0; set x14 0; set x15 0;
|
||||
set x16 0; set x17 0; set x18 0; set x19 0;
|
||||
set x20 0; set x21 0; set x22 0; set x23 0;
|
||||
set x24 0; set x25 0; set x26 0; set x27 0;
|
||||
set x28 0; set x29 0; set x30 0; set x31 0;
|
||||
set x32 0; set x33 0; set x34 0; set x35 0;
|
||||
set x36 0; set x37 0; set x38 0; set x39 0;
|
||||
set x40 0; set x41 0; set x42 0; set x43 0;
|
||||
set x44 0; set x45 0; set x46 0; set x47 0;
|
||||
set x48 0; set x49 0; set x50 0; set x51 0;
|
||||
set x52 0; set x53 0; set x54 0; set x55 0;
|
||||
set x56 0; set x57 0; set x58 0; set x59 0;
|
||||
set x60 0; set x61 0; set x62 0; set x63 0;
|
||||
set x64 0; set x65 0; set x66 0; set x67 0;
|
||||
set x68 0; set x69 0; set x70 0; set x71 0;
|
||||
set x72 0; set x73 0; set x74 0; set x75 0;
|
||||
set x76 0; set x77 0; set x78 0; set x79 0;
|
||||
set x80 0; set x81 0; set x82 0; set x83 0;
|
||||
set x84 0; set x85 0; set x86 0; set x87 0;
|
||||
set x88 0; set x89 0; set x90 0; set x91 0;
|
||||
set x92 0; set x93 0; set x94 0; set x95 0;
|
||||
set x96 0; set x97 0; set x98 0; set x99 0;
|
||||
set x100 0; set x101 0; set x102 0; set x103 0;
|
||||
set x104 0; set x105 0; set x106 0; set x107 0;
|
||||
set x108 0; set x109 0; set x110 0; set x111 0;
|
||||
set x112 0; set x113 0; set x114 0; set x115 0;
|
||||
set x116 0; set x117 0; set x118 0; set x119 0;
|
||||
set x120 0; set x121 0; set x122 0; set x123 0;
|
||||
set x124 0; set x125 0; set x126 0; set x127 0;
|
||||
set x128 0; set x129 0; set x130 0; set x131 0;
|
||||
set x132 0; set x133 0; set x134 0; set x135 0;
|
||||
set x136 0; set x137 0; set x138 0; set x139 0;
|
||||
set x140 0; set x141 0; set x142 0; set x143 0;
|
||||
set x144 0; set x145 0; set x146 0; set x147 0;
|
||||
set x148 0; set x149 0; set x150 0; set x151 0;
|
||||
set x152 0; set x153 0; set x154 0; set x155 0;
|
||||
set x156 0; set x157 0; set x158 0; set x159 0;
|
||||
set x160 0; set x161 0; set x162 0; set x163 0;
|
||||
set x164 0; set x165 0; set x166 0; set x167 0;
|
||||
set x168 0; set x169 0; set x170 0; set x171 0;
|
||||
set x172 0; set x173 0; set x174 0; set x175 0;
|
||||
set x176 0; set x177 0; set x178 0; set x179 0;
|
||||
set x180 0; set x181 0; set x182 0; set x183 0;
|
||||
set x184 0; set x185 0; set x186 0; set x187 0;
|
||||
set x188 0; set x189 0; set x190 0; set x191 0;
|
||||
set x192 0; set x193 0; set x194 0; set x195 0;
|
||||
set x196 0; set x197 0; set x198 0; set x199 0;
|
||||
set x200 0; set x201 0; set x202 0; set x203 0;
|
||||
set x204 0; set x205 0; set x206 0; set x207 0;
|
||||
set x208 0; set x209 0; set x210 0; set x211 0;
|
||||
set x212 0; set x213 0; set x214 0; set x215 0;
|
||||
set x216 0; set x217 0; set x218 0; set x219 0;
|
||||
set x220 0; set x221 0; set x222 0; set x223 0;
|
||||
set x224 0; set x225 0; set x226 0; set x227 0;
|
||||
set x228 0; set x229 0; set x230 0; set x231 0;
|
||||
set x232 0; set x233 0; set x234 0; set x235 0;
|
||||
set x236 0; set x237 0; set x238 0; set x239 0;
|
||||
set x240 0; set x241 0; set x242 0; set x243 0;
|
||||
set x244 0; set x245 0; set x246 0; set x247 0;
|
||||
set x248 0; set x249 0; set x250 0; set x251 0;
|
||||
set x252 0; set x253 0; set x254 0; set x255 0;
|
||||
set x {{1 2} {3 4}}
|
||||
lset x 1 1 5
|
||||
@@ -338,69 +338,69 @@ test lsetComp-3.6 {lset, compiled, flat args, array, one-byte offset} {
|
||||
|
||||
test lsetComp-3.7 {lset, compiled, flat args, array, four-byte offset} {
|
||||
evalInProc {
|
||||
set x0 0; set x1 0; set x2 0; set x3 0;
|
||||
set x4 0; set x5 0; set x6 0; set x7 0;
|
||||
set x8 0; set x9 0; set x10 0; set x11 0;
|
||||
set x12 0; set x13 0; set x14 0; set x15 0;
|
||||
set x16 0; set x17 0; set x18 0; set x19 0;
|
||||
set x20 0; set x21 0; set x22 0; set x23 0;
|
||||
set x24 0; set x25 0; set x26 0; set x27 0;
|
||||
set x28 0; set x29 0; set x30 0; set x31 0;
|
||||
set x32 0; set x33 0; set x34 0; set x35 0;
|
||||
set x36 0; set x37 0; set x38 0; set x39 0;
|
||||
set x40 0; set x41 0; set x42 0; set x43 0;
|
||||
set x44 0; set x45 0; set x46 0; set x47 0;
|
||||
set x48 0; set x49 0; set x50 0; set x51 0;
|
||||
set x52 0; set x53 0; set x54 0; set x55 0;
|
||||
set x56 0; set x57 0; set x58 0; set x59 0;
|
||||
set x60 0; set x61 0; set x62 0; set x63 0;
|
||||
set x64 0; set x65 0; set x66 0; set x67 0;
|
||||
set x68 0; set x69 0; set x70 0; set x71 0;
|
||||
set x72 0; set x73 0; set x74 0; set x75 0;
|
||||
set x76 0; set x77 0; set x78 0; set x79 0;
|
||||
set x80 0; set x81 0; set x82 0; set x83 0;
|
||||
set x84 0; set x85 0; set x86 0; set x87 0;
|
||||
set x88 0; set x89 0; set x90 0; set x91 0;
|
||||
set x92 0; set x93 0; set x94 0; set x95 0;
|
||||
set x96 0; set x97 0; set x98 0; set x99 0;
|
||||
set x100 0; set x101 0; set x102 0; set x103 0;
|
||||
set x104 0; set x105 0; set x106 0; set x107 0;
|
||||
set x108 0; set x109 0; set x110 0; set x111 0;
|
||||
set x112 0; set x113 0; set x114 0; set x115 0;
|
||||
set x116 0; set x117 0; set x118 0; set x119 0;
|
||||
set x120 0; set x121 0; set x122 0; set x123 0;
|
||||
set x124 0; set x125 0; set x126 0; set x127 0;
|
||||
set x128 0; set x129 0; set x130 0; set x131 0;
|
||||
set x132 0; set x133 0; set x134 0; set x135 0;
|
||||
set x136 0; set x137 0; set x138 0; set x139 0;
|
||||
set x140 0; set x141 0; set x142 0; set x143 0;
|
||||
set x144 0; set x145 0; set x146 0; set x147 0;
|
||||
set x148 0; set x149 0; set x150 0; set x151 0;
|
||||
set x152 0; set x153 0; set x154 0; set x155 0;
|
||||
set x156 0; set x157 0; set x158 0; set x159 0;
|
||||
set x160 0; set x161 0; set x162 0; set x163 0;
|
||||
set x164 0; set x165 0; set x166 0; set x167 0;
|
||||
set x168 0; set x169 0; set x170 0; set x171 0;
|
||||
set x172 0; set x173 0; set x174 0; set x175 0;
|
||||
set x176 0; set x177 0; set x178 0; set x179 0;
|
||||
set x180 0; set x181 0; set x182 0; set x183 0;
|
||||
set x184 0; set x185 0; set x186 0; set x187 0;
|
||||
set x188 0; set x189 0; set x190 0; set x191 0;
|
||||
set x192 0; set x193 0; set x194 0; set x195 0;
|
||||
set x196 0; set x197 0; set x198 0; set x199 0;
|
||||
set x200 0; set x201 0; set x202 0; set x203 0;
|
||||
set x204 0; set x205 0; set x206 0; set x207 0;
|
||||
set x208 0; set x209 0; set x210 0; set x211 0;
|
||||
set x212 0; set x213 0; set x214 0; set x215 0;
|
||||
set x216 0; set x217 0; set x218 0; set x219 0;
|
||||
set x220 0; set x221 0; set x222 0; set x223 0;
|
||||
set x224 0; set x225 0; set x226 0; set x227 0;
|
||||
set x228 0; set x229 0; set x230 0; set x231 0;
|
||||
set x232 0; set x233 0; set x234 0; set x235 0;
|
||||
set x236 0; set x237 0; set x238 0; set x239 0;
|
||||
set x240 0; set x241 0; set x242 0; set x243 0;
|
||||
set x244 0; set x245 0; set x246 0; set x247 0;
|
||||
set x248 0; set x249 0; set x250 0; set x251 0;
|
||||
set x0 0; set x1 0; set x2 0; set x3 0;
|
||||
set x4 0; set x5 0; set x6 0; set x7 0;
|
||||
set x8 0; set x9 0; set x10 0; set x11 0;
|
||||
set x12 0; set x13 0; set x14 0; set x15 0;
|
||||
set x16 0; set x17 0; set x18 0; set x19 0;
|
||||
set x20 0; set x21 0; set x22 0; set x23 0;
|
||||
set x24 0; set x25 0; set x26 0; set x27 0;
|
||||
set x28 0; set x29 0; set x30 0; set x31 0;
|
||||
set x32 0; set x33 0; set x34 0; set x35 0;
|
||||
set x36 0; set x37 0; set x38 0; set x39 0;
|
||||
set x40 0; set x41 0; set x42 0; set x43 0;
|
||||
set x44 0; set x45 0; set x46 0; set x47 0;
|
||||
set x48 0; set x49 0; set x50 0; set x51 0;
|
||||
set x52 0; set x53 0; set x54 0; set x55 0;
|
||||
set x56 0; set x57 0; set x58 0; set x59 0;
|
||||
set x60 0; set x61 0; set x62 0; set x63 0;
|
||||
set x64 0; set x65 0; set x66 0; set x67 0;
|
||||
set x68 0; set x69 0; set x70 0; set x71 0;
|
||||
set x72 0; set x73 0; set x74 0; set x75 0;
|
||||
set x76 0; set x77 0; set x78 0; set x79 0;
|
||||
set x80 0; set x81 0; set x82 0; set x83 0;
|
||||
set x84 0; set x85 0; set x86 0; set x87 0;
|
||||
set x88 0; set x89 0; set x90 0; set x91 0;
|
||||
set x92 0; set x93 0; set x94 0; set x95 0;
|
||||
set x96 0; set x97 0; set x98 0; set x99 0;
|
||||
set x100 0; set x101 0; set x102 0; set x103 0;
|
||||
set x104 0; set x105 0; set x106 0; set x107 0;
|
||||
set x108 0; set x109 0; set x110 0; set x111 0;
|
||||
set x112 0; set x113 0; set x114 0; set x115 0;
|
||||
set x116 0; set x117 0; set x118 0; set x119 0;
|
||||
set x120 0; set x121 0; set x122 0; set x123 0;
|
||||
set x124 0; set x125 0; set x126 0; set x127 0;
|
||||
set x128 0; set x129 0; set x130 0; set x131 0;
|
||||
set x132 0; set x133 0; set x134 0; set x135 0;
|
||||
set x136 0; set x137 0; set x138 0; set x139 0;
|
||||
set x140 0; set x141 0; set x142 0; set x143 0;
|
||||
set x144 0; set x145 0; set x146 0; set x147 0;
|
||||
set x148 0; set x149 0; set x150 0; set x151 0;
|
||||
set x152 0; set x153 0; set x154 0; set x155 0;
|
||||
set x156 0; set x157 0; set x158 0; set x159 0;
|
||||
set x160 0; set x161 0; set x162 0; set x163 0;
|
||||
set x164 0; set x165 0; set x166 0; set x167 0;
|
||||
set x168 0; set x169 0; set x170 0; set x171 0;
|
||||
set x172 0; set x173 0; set x174 0; set x175 0;
|
||||
set x176 0; set x177 0; set x178 0; set x179 0;
|
||||
set x180 0; set x181 0; set x182 0; set x183 0;
|
||||
set x184 0; set x185 0; set x186 0; set x187 0;
|
||||
set x188 0; set x189 0; set x190 0; set x191 0;
|
||||
set x192 0; set x193 0; set x194 0; set x195 0;
|
||||
set x196 0; set x197 0; set x198 0; set x199 0;
|
||||
set x200 0; set x201 0; set x202 0; set x203 0;
|
||||
set x204 0; set x205 0; set x206 0; set x207 0;
|
||||
set x208 0; set x209 0; set x210 0; set x211 0;
|
||||
set x212 0; set x213 0; set x214 0; set x215 0;
|
||||
set x216 0; set x217 0; set x218 0; set x219 0;
|
||||
set x220 0; set x221 0; set x222 0; set x223 0;
|
||||
set x224 0; set x225 0; set x226 0; set x227 0;
|
||||
set x228 0; set x229 0; set x230 0; set x231 0;
|
||||
set x232 0; set x233 0; set x234 0; set x235 0;
|
||||
set x236 0; set x237 0; set x238 0; set x239 0;
|
||||
set x240 0; set x241 0; set x242 0; set x243 0;
|
||||
set x244 0; set x245 0; set x246 0; set x247 0;
|
||||
set x248 0; set x249 0; set x250 0; set x251 0;
|
||||
set x252 0; set x253 0; set x254 0; set x255 0;
|
||||
set y(0) {{1 2} {3 4}}
|
||||
lset y(0) 1 1 5
|
||||
|
||||
+3
-3
@@ -901,10 +901,10 @@ test mathop-22.2 { bitwise ops on bignums } {
|
||||
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]
|
||||
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]]
|
||||
set val [expr {"0x[string repeat $d $dig]"}]
|
||||
}
|
||||
lappend exp $val
|
||||
}
|
||||
|
||||
@@ -749,13 +749,13 @@ test namespace-old-9.14 {imported commands can be removed} {
|
||||
} {{} 1 {invalid command name "cmd1"}}
|
||||
test namespace-old-9.15 {existing commands can't be overwritten} {
|
||||
proc cmd1 {x y} {
|
||||
return [expr $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] }
|
||||
proc cmd1 {x y} { return [expr {$x+$y}] }
|
||||
list [cmd1 3 5] \
|
||||
[namespace import -force test_ns_import::cmd?] \
|
||||
[cmd1 3 5]
|
||||
|
||||
+4
-4
@@ -1898,7 +1898,7 @@ test oo-13.5 {OO: changing an object's class: non-class to class} -setup {
|
||||
class oo::class
|
||||
}
|
||||
oo::define fooObj {
|
||||
method x {} {expr 1+2+3}
|
||||
method x {} {expr {1+2+3}}
|
||||
}
|
||||
[fooObj new] x
|
||||
} -cleanup {
|
||||
@@ -1910,7 +1910,7 @@ test oo-13.6 {OO: changing an object's class: class to non-class} -setup {
|
||||
} -body {
|
||||
set result dangling
|
||||
oo::define foo {
|
||||
method x {} {expr 1+2+3}
|
||||
method x {} {expr {1+2+3}}
|
||||
}
|
||||
oo::class create boo {
|
||||
superclass foo
|
||||
@@ -1933,7 +1933,7 @@ test oo-13.7 {OO: changing an object's class} -setup {
|
||||
} -body {
|
||||
oo::define bar method x {} {return ok}
|
||||
oo::define foo {
|
||||
method x {} {expr 1+2+3}
|
||||
method x {} {expr {1+2+3}}
|
||||
self mixin foo
|
||||
}
|
||||
lappend result [foo x]
|
||||
@@ -1947,7 +1947,7 @@ 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}
|
||||
method x {} {expr {1+2+3}}
|
||||
}
|
||||
oo::objdefine foo class foo
|
||||
} -cleanup {
|
||||
|
||||
+2
-2
@@ -27,8 +27,8 @@ package require opt 0.4.8
|
||||
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]"
|
||||
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] \
|
||||
|
||||
+2
-2
@@ -481,7 +481,7 @@ 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]}
|
||||
testevalex {concat [expr {2 + 6}]}
|
||||
} {8}
|
||||
test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex {
|
||||
unset -nocomplain a
|
||||
@@ -499,7 +499,7 @@ test parse-10.6 {Tcl_EvalTokens, array variables} testevalex {
|
||||
test parse-10.7 {Tcl_EvalTokens, array variables} testevalex {
|
||||
unset -nocomplain a
|
||||
set a(12) 46
|
||||
testevalex {concat $a(1[expr 3 - 1])}
|
||||
testevalex {concat $a(1[expr {3 - 1}])}
|
||||
} {46}
|
||||
test parse-10.8 {Tcl_EvalTokens, array variables} testevalex {
|
||||
unset -nocomplain a
|
||||
|
||||
+1
-1
@@ -135,7 +135,7 @@ format %s $b
|
||||
} a22b
|
||||
test parseOld-4.4 {command substitution} {
|
||||
set a 7.7
|
||||
if [catch {expr int($a)}] {set a foo}
|
||||
if {[catch {expr {int($a)}}]} {set a foo}
|
||||
set a
|
||||
} 7.7
|
||||
|
||||
|
||||
@@ -315,7 +315,7 @@ namespace eval pkg2 {
|
||||
namespace export p2-1
|
||||
}
|
||||
proc pkg2::p2-1 { num } {
|
||||
return [expr $num * 2]
|
||||
return [expr {$num * 2}]
|
||||
}
|
||||
} [file join pkg pkg2_a.tcl]
|
||||
|
||||
@@ -328,7 +328,7 @@ namespace eval pkg2 {
|
||||
namespace export p2-2
|
||||
}
|
||||
proc pkg2::p2-2 { num } {
|
||||
return [expr $num * 3]
|
||||
return [expr {$num * 3}]
|
||||
}
|
||||
} [file join pkg pkg2_b.tcl]
|
||||
|
||||
@@ -409,10 +409,10 @@ namespace eval pkg3 {
|
||||
namespace export p3-1 p3-2
|
||||
}
|
||||
proc pkg3::p3-1 { num } {
|
||||
return {[expr $num * 2]}
|
||||
return {[expr {$num * 2}]}
|
||||
}
|
||||
proc pkg3::p3-2 { num } {
|
||||
return {[expr $num * 3]}
|
||||
return {[expr {$num * 3}]}
|
||||
}
|
||||
} [file join pkg pkg3.tcl]
|
||||
|
||||
@@ -520,10 +520,10 @@ namespace eval circ2 {
|
||||
namespace export c2-1 c2-2
|
||||
}
|
||||
proc circ2::c2-1 { num } {
|
||||
return [expr $num * [circ3::c3-1]]
|
||||
return [expr {$num * [circ3::c3-1]}]
|
||||
}
|
||||
proc circ2::c2-2 { num } {
|
||||
return [expr $num * [circ3::c3-2]]
|
||||
return [expr {$num * [circ3::c3-2]}]
|
||||
}
|
||||
} [file join pkg circ2.tcl]
|
||||
|
||||
|
||||
+6
-6
@@ -25,7 +25,7 @@ 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]
|
||||
set x [expr {$x + 1}]
|
||||
return $x
|
||||
}
|
||||
test proc-old-1.2 {simple procedure call and return} {tproc 2} 3
|
||||
@@ -49,7 +49,7 @@ test proc-old-1.6 {simple procedure call and return (shared proc body string)} {
|
||||
|
||||
test proc-old-2.1 {local and global variables} {
|
||||
proc tproc x {
|
||||
set x [expr $x+1]
|
||||
set x [expr {$x + 1}]
|
||||
return $x
|
||||
}
|
||||
set x 42
|
||||
@@ -57,7 +57,7 @@ test proc-old-2.1 {local and global variables} {
|
||||
} {7 42}
|
||||
test proc-old-2.2 {local and global variables} {
|
||||
proc tproc x {
|
||||
set y [expr $x+1]
|
||||
set y [expr {$x + 1}]
|
||||
return $y
|
||||
}
|
||||
set y 18
|
||||
@@ -66,7 +66,7 @@ test proc-old-2.2 {local and global variables} {
|
||||
test proc-old-2.3 {local and global variables} {
|
||||
proc tproc x {
|
||||
global y
|
||||
set y [expr $x+1]
|
||||
set y [expr {$x + 1}]
|
||||
return $y
|
||||
}
|
||||
set y 189
|
||||
@@ -75,7 +75,7 @@ test proc-old-2.3 {local and global variables} {
|
||||
test proc-old-2.4 {local and global variables} {
|
||||
proc tproc x {
|
||||
global y
|
||||
return [expr $x+$y]
|
||||
return [expr {$x + $y}]
|
||||
}
|
||||
set y 189
|
||||
list [tproc 6] $y
|
||||
@@ -504,7 +504,7 @@ test proc-old-10.1 {ByteCode epoch change during recursive proc execution} {
|
||||
set y 20
|
||||
rename expr expr.old
|
||||
rename expr.old expr
|
||||
if $x then {t1 0} ;# recursive call after foo's code is invalidated
|
||||
if {$x} then {t1 0} ;# recursive call after foo's code is invalidated
|
||||
return 20
|
||||
}
|
||||
t1 1
|
||||
|
||||
+1
-1
@@ -100,7 +100,7 @@ test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array e
|
||||
catch {rename p ""}
|
||||
} -returnCodes error -body {
|
||||
proc p {a(1) a(2)} {
|
||||
set z [expr $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}
|
||||
|
||||
+3
-2
@@ -20,9 +20,10 @@ test pwd-1.1 {simple pwd} {
|
||||
catch pwd
|
||||
} 0
|
||||
test pwd-1.2 {simple pwd} {
|
||||
expr [string length pwd]>0
|
||||
expr {[string length [pwd]]>0}
|
||||
} 1
|
||||
test pwd-1.3 {pwd takes no args} -body {
|
||||
|
||||
test pwd-2.1 {pwd takes no args} -body {
|
||||
pwd foobar
|
||||
} -returnCodes error -result "wrong \# args: should be \"pwd\""
|
||||
|
||||
|
||||
+4
-4
@@ -91,8 +91,8 @@ if {![info exists 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]]
|
||||
if {$i < $argc - 1} {
|
||||
set serverPort [lindex $argv [expr {$i + 1}]]
|
||||
}
|
||||
break
|
||||
}
|
||||
@@ -110,8 +110,8 @@ if {![info exists 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]]
|
||||
if {$i < $argc - 1} {
|
||||
set serverAddress [lindex $argv [expr {$i + 1}]]
|
||||
}
|
||||
break
|
||||
}
|
||||
|
||||
+4
-2
@@ -67,7 +67,9 @@ if {"::tcltest" ni [namespace children]} {
|
||||
|
||||
::tcltest::loadTestedCommands
|
||||
|
||||
if {[expr {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]} {
|
||||
# A bad interaction between socket creation, macOS, and unattended CI
|
||||
# environments make this whole file impractical to run; too many weird hangs.
|
||||
if {[info exists ::env(MAC_CI)]} {
|
||||
return
|
||||
}
|
||||
|
||||
@@ -939,7 +941,7 @@ test socket_$af-6.1 {accept callback error} -constraints [list socket supported_
|
||||
}
|
||||
close $f
|
||||
set f [open "|[list [interpreter] $path(script)]" r+]
|
||||
proc accept {s a p} {expr 10 / 0}
|
||||
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
|
||||
|
||||
+6
-6
@@ -132,20 +132,20 @@ test subst-7.3 {switches} -returnCodes error -body {
|
||||
} -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}
|
||||
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}
|
||||
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}
|
||||
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}
|
||||
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}
|
||||
|
||||
+1
-1
@@ -1444,7 +1444,7 @@ test tcltest-23.2 {removeFile} {
|
||||
file mkdir $mfdir
|
||||
makeFile {} t1.tmp
|
||||
makeFile {} et1.tmp $mfdir
|
||||
if {![file exists [file join [temporaryDirectory] t1.tmp]] || \
|
||||
if {![file exists [file join [temporaryDirectory] t1.tmp]] || \
|
||||
![file exists [file join $mfdir et1.tmp]]} {
|
||||
error "file creation didn't work"
|
||||
}
|
||||
|
||||
+32
-32
@@ -166,30 +166,30 @@ test trace-1.10 {trace variable reads} {
|
||||
} {}
|
||||
test trace-1.11 {read traces that modify the array structure} {
|
||||
unset -nocomplain x
|
||||
set x(bar) 0
|
||||
trace variable x r {set x(foo) 1 ;#}
|
||||
trace variable x r {unset -nocomplain x(bar) ;#}
|
||||
set x(bar) 0
|
||||
trace variable x r {set x(foo) 1 ;#}
|
||||
trace variable x r {unset -nocomplain x(bar) ;#}
|
||||
array get x
|
||||
} {}
|
||||
test trace-1.12 {read traces that modify the array structure} {
|
||||
unset -nocomplain x
|
||||
set x(bar) 0
|
||||
trace variable x r {unset -nocomplain x(bar) ;#}
|
||||
trace variable x r {set x(foo) 1 ;#}
|
||||
set x(bar) 0
|
||||
trace variable x r {unset -nocomplain x(bar) ;#}
|
||||
trace variable x r {set x(foo) 1 ;#}
|
||||
array get x
|
||||
} {}
|
||||
test trace-1.13 {read traces that modify the array structure} {
|
||||
unset -nocomplain x
|
||||
set x(bar) 0
|
||||
trace variable x r {set x(foo) 1 ;#}
|
||||
trace variable x r {unset -nocomplain x;#}
|
||||
set x(bar) 0
|
||||
trace variable x r {set x(foo) 1 ;#}
|
||||
trace variable x r {unset -nocomplain x;#}
|
||||
list [catch {array get x} res] $res
|
||||
} {1 {can't read "x(bar)": no such variable}}
|
||||
test trace-1.14 {read traces that modify the array structure} {
|
||||
unset -nocomplain x
|
||||
set x(bar) 0
|
||||
trace variable x r {unset -nocomplain x;#}
|
||||
trace variable x r {set x(foo) 1 ;#}
|
||||
set x(bar) 0
|
||||
trace variable x r {unset -nocomplain x;#}
|
||||
trace variable x r {set x(foo) 1 ;#}
|
||||
list [catch {array get x} res] $res
|
||||
} {1 {can't read "x(bar)": no such variable}}
|
||||
|
||||
@@ -421,7 +421,7 @@ test trace-5.8 {array traces fire for undefined variables} {
|
||||
trace add variable x array {set x(foo) 1 ;#}
|
||||
set res "names: [array names x]"
|
||||
} {names: foo}
|
||||
|
||||
|
||||
# Trace multiple trace types at once.
|
||||
|
||||
test trace-6.1 {multiple ops traced at once} {
|
||||
@@ -769,7 +769,7 @@ test trace-13.1 {delete one trace from another} {
|
||||
trace add variable x read {traceTag 2}
|
||||
trace add variable x read {traceTag 3}
|
||||
trace add variable x read {traceTag 4}
|
||||
trace add variable x read delTraces
|
||||
trace add variable x read delTraces
|
||||
trace add variable x read {traceTag 5}
|
||||
set x
|
||||
set info
|
||||
@@ -874,7 +874,7 @@ test trace-14.5 {trace command, invalid option} {
|
||||
} [list 1 "bad option \"gorp\": must be add, info, remove, variable, vdelete, or vinfo"]
|
||||
|
||||
# Again, [trace ... command] and [trace ... variable] share syntax and
|
||||
# error message styles for their opList options; these loops test those
|
||||
# error message styles for their opList options; these loops test those
|
||||
# error messages.
|
||||
|
||||
set i 0
|
||||
@@ -2106,7 +2106,7 @@ foo foo 0 1 leave}
|
||||
test trace-28.2 {exec traces with 'error'} {
|
||||
set info {}
|
||||
set res {}
|
||||
|
||||
|
||||
proc foo {} {
|
||||
if {[catch {bar}]} {
|
||||
return "error"
|
||||
@@ -2128,7 +2128,7 @@ test trace-28.2 {exec traces with 'error'} {
|
||||
|
||||
trace remove execution foo {enter enterstep leave leavestep} \
|
||||
[list traceExecute foo]
|
||||
|
||||
|
||||
list $res [join $info \n]
|
||||
} {{error error} {foo foo enter
|
||||
foo {if {[catch {bar}]} {
|
||||
@@ -2154,7 +2154,7 @@ foo foo 0 error leave}}
|
||||
test trace-28.3 {exec traces with 'return -code error'} {
|
||||
set info {}
|
||||
set res {}
|
||||
|
||||
|
||||
proc foo {} {
|
||||
if {[catch {bar}]} {
|
||||
return "error"
|
||||
@@ -2176,7 +2176,7 @@ test trace-28.3 {exec traces with 'return -code error'} {
|
||||
|
||||
trace remove execution foo {enter enterstep leave leavestep} \
|
||||
[list traceExecute foo]
|
||||
|
||||
|
||||
list $res [join $info \n]
|
||||
} {{error error} {foo foo enter
|
||||
foo {if {[catch {bar}]} {
|
||||
@@ -2206,7 +2206,7 @@ test trace-28.4 {exec traces in child with 'return -code error'} {
|
||||
set res [interp eval child {
|
||||
set info {}
|
||||
set res {}
|
||||
|
||||
|
||||
proc foo {} {
|
||||
if {[catch {bar}]} {
|
||||
return "error"
|
||||
@@ -2214,21 +2214,21 @@ test trace-28.4 {exec traces in child with 'return -code error'} {
|
||||
return "ok"
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
proc bar {} { return -code error "msg" }
|
||||
|
||||
|
||||
lappend res [foo]
|
||||
|
||||
|
||||
trace add execution foo {enter enterstep leave leavestep} \
|
||||
[list traceExecute foo]
|
||||
|
||||
|
||||
# With the trace active
|
||||
|
||||
|
||||
lappend res [foo]
|
||||
|
||||
|
||||
trace remove execution foo {enter enterstep leave leavestep} \
|
||||
[list traceExecute foo]
|
||||
|
||||
|
||||
list $res
|
||||
}]
|
||||
interp delete child
|
||||
@@ -2314,8 +2314,8 @@ test trace-28.10 {exec trace info nonsense} {
|
||||
} {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}}
|
||||
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]"]]
|
||||
@@ -2612,7 +2612,7 @@ test trace-39 {bug #3484621: tracing Bc'ed commands} -setup {
|
||||
proc foo {} {
|
||||
incr ::traceCalls
|
||||
# choose a BC'ed command that is 'unlikely' to interfere with tcltest's
|
||||
# internals
|
||||
# internals
|
||||
lset ::bar 1 2
|
||||
}
|
||||
} -body {
|
||||
@@ -2633,7 +2633,7 @@ test trace-39 {bug #3484621: tracing Bc'ed commands} -setup {
|
||||
rename dotrace {}
|
||||
rename foo {}
|
||||
} -result {3 | 0 1 1}
|
||||
|
||||
|
||||
test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup {
|
||||
set ::traceLog 0
|
||||
set ::traceCalls 0
|
||||
@@ -2670,7 +2670,7 @@ test trace-40.1 {execution trace errors become command errors} {
|
||||
catch foo m
|
||||
return -level 0 $m[unset m]
|
||||
} bar
|
||||
|
||||
|
||||
# Delete procedures when done, so we don't clash with other tests
|
||||
# (e.g. foobar will clash with 'unknown' tests).
|
||||
catch {rename foobar {}}
|
||||
|
||||
@@ -38,9 +38,6 @@ testConstraint $loaded [expr {![string match *pkgua* $alreadyLoaded]}]
|
||||
|
||||
set alreadyTotalLoaded [info loaded]
|
||||
|
||||
# Certain tests require the 'teststaticpkg' command from tcltest
|
||||
testConstraint teststaticpkg [llength [info commands teststaticpkg]]
|
||||
|
||||
# Certain tests need the 'testsimplefilsystem' in tcltest
|
||||
testConstraint testsimplefilesystem \
|
||||
[llength [info commands testsimplefilesystem]]
|
||||
|
||||
+5
-5
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
|
||||
}
|
||||
|
||||
proc a {x y} {
|
||||
newset z [expr $x+$y]
|
||||
newset z [expr {$x + $y}]
|
||||
return $z
|
||||
}
|
||||
proc newset {name value} {
|
||||
@@ -247,7 +247,7 @@ test uplevel-7.1 {var access, no LVT in either level} -setup {
|
||||
unset -nocomplain y z
|
||||
} -body {
|
||||
namespace eval foo {
|
||||
set x 2
|
||||
set x 2
|
||||
set y 2
|
||||
uplevel 1 {
|
||||
set x 3
|
||||
@@ -266,7 +266,7 @@ test uplevel-7.2 {var access, no LVT in upper level} -setup {
|
||||
unset -nocomplain y z
|
||||
} -body {
|
||||
proc foo {} {
|
||||
set x 2
|
||||
set x 2
|
||||
set y 2
|
||||
uplevel 1 {
|
||||
set x 3
|
||||
@@ -290,7 +290,7 @@ test uplevel-7.3 {var access, LVT in upper level} -setup {
|
||||
}
|
||||
} -body {
|
||||
proc foo {} {
|
||||
set x 2
|
||||
set x 2
|
||||
set y 2
|
||||
uplevel 1 {
|
||||
set x 3
|
||||
@@ -309,7 +309,7 @@ test uplevel-7.3 {var access, LVT in upper level} -setup {
|
||||
test uplevel-8.0 {
|
||||
string representation isn't generated when there is only one argument
|
||||
} -body {
|
||||
set res {}
|
||||
set res {}
|
||||
set script [list lindex 5]
|
||||
lappend res [apply {script {
|
||||
uplevel $script
|
||||
|
||||
+1
-1
@@ -451,7 +451,7 @@ test var-7.4 {Tcl_VariableObjCmd, list of vars} -setup {
|
||||
variable three 3 four 4
|
||||
}
|
||||
list [lsort [info vars test_ns_var::*]] \
|
||||
[namespace eval test_ns_var {expr $three+$four}]
|
||||
[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}
|
||||
|
||||
@@ -20,7 +20,7 @@ if {"::tcltest" ni [namespace children]} {
|
||||
|
||||
test while-old-1.1 {basic while loops} {
|
||||
set count 0
|
||||
while {$count < 10} {set count [expr $count+1]}
|
||||
while {$count < 10} {set count [expr {$count + 1}]}
|
||||
set count
|
||||
} 10
|
||||
test while-old-1.2 {basic while loops} {
|
||||
@@ -58,9 +58,9 @@ test while-old-2.1 {continue in while loop} {
|
||||
set index 0
|
||||
set result {}
|
||||
while {$index < 5} {
|
||||
if {$index == 2} {set index [expr $index+1]; continue}
|
||||
if {$index == 2} {set index [expr {$index + 1}]; continue}
|
||||
set result [concat $result [lindex $list $index]]
|
||||
set index [expr $index+1]
|
||||
set index [expr {$index + 1}]
|
||||
}
|
||||
set result
|
||||
} {1 2 4 5}
|
||||
@@ -72,7 +72,7 @@ test while-old-3.1 {break in while loop} {
|
||||
while {$index < 5} {
|
||||
if {$index == 3} break
|
||||
set result [concat $result [lindex $list $index]]
|
||||
set index [expr $index+1]
|
||||
set index [expr {$index + 1}]
|
||||
}
|
||||
set result
|
||||
} {1 2 3}
|
||||
|
||||
+22
-22
@@ -77,7 +77,7 @@ test while-1.9 {TclCompileWhileCmd: simple command body} -body {
|
||||
set a {}
|
||||
set i 1
|
||||
while {$i<6} {
|
||||
if $i==4 break
|
||||
if {$i==4} break
|
||||
set a [concat $a $i]
|
||||
incr i
|
||||
}
|
||||
@@ -112,8 +112,8 @@ 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==4} break
|
||||
if {$i>5} continue
|
||||
if {$i>6 && $tcl_platform(machine)=="xxx"} {
|
||||
catch {set a $a} msg
|
||||
catch {incr i 5} msg
|
||||
@@ -155,7 +155,7 @@ test while-1.13 {TclCompileWhileCmd: while command result} -body {
|
||||
} -result {}
|
||||
test while-1.14 {TclCompileWhileCmd: while command result} -body {
|
||||
set i 0
|
||||
set a [while {$i < 5} {if $i==3 break; incr i}]
|
||||
set a [while {$i < 5} {if {$i==3} break; incr i}]
|
||||
return $a
|
||||
} -cleanup {
|
||||
unset a i
|
||||
@@ -207,9 +207,9 @@ 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==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
|
||||
@@ -277,9 +277,9 @@ 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==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
|
||||
@@ -295,7 +295,7 @@ test while-3.3 {break tests, long command body} -body {
|
||||
catch {incr i 5} msg
|
||||
catch {incr i -5} msg
|
||||
}
|
||||
if $i==4 break
|
||||
if {$i==4} break
|
||||
if {$i>6 && $tcl_platform(machine)=="xxx"} {
|
||||
catch {set a $a} msg
|
||||
catch {incr i 5} msg
|
||||
@@ -401,7 +401,7 @@ test while-4.10 {while (not compiled): simple command body} -body {
|
||||
set i 1
|
||||
set z while
|
||||
$z {$i<6} {
|
||||
if $i==4 break
|
||||
if {$i==4} break
|
||||
set a [concat $a $i]
|
||||
incr i
|
||||
}
|
||||
@@ -439,8 +439,8 @@ test while-4.13 {while (not compiled): long command body} -body {
|
||||
set z while
|
||||
set i 1
|
||||
$z {$i<6} {
|
||||
if $i==4 break
|
||||
if $i>5 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
|
||||
@@ -484,7 +484,7 @@ test while-4.14 {while (not compiled): while command result} -body {
|
||||
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}]
|
||||
set a [$z {$i < 5} {if {$i==3} break; incr i}]
|
||||
return $a
|
||||
} -cleanup {
|
||||
unset a i z
|
||||
@@ -538,9 +538,9 @@ test while-5.4 {break tests, long command body with computed command names} -bod
|
||||
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==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
|
||||
@@ -556,7 +556,7 @@ test while-5.4 {break tests, long command body with computed command names} -bod
|
||||
catch {incr i 5} msg
|
||||
catch {incr i -5} msg
|
||||
}
|
||||
if $i==4 $z
|
||||
if {$i==4} $z
|
||||
if {$i>6 && $tcl_platform(machine)=="xxx"} {
|
||||
catch {set a $a} msg
|
||||
catch {incr i 5} msg
|
||||
@@ -637,9 +637,9 @@ test while-6.5 {continue tests, long command body with computed command names} -
|
||||
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==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
|
||||
|
||||
+5
-5
@@ -21,7 +21,7 @@ if {[testConstraint win]} {
|
||||
if {![catch {
|
||||
::tcltest::loadTestedCommands
|
||||
set ::ddever [package require dde 1.4.3]
|
||||
set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
|
||||
set ::ddelib [info loaded "" Dde]}]} {
|
||||
testConstraint dde 1
|
||||
}
|
||||
}
|
||||
@@ -38,7 +38,7 @@ proc createChildProcess {ddeServerName args} {
|
||||
|
||||
set f [open $::scriptName w+]
|
||||
puts $f [list set ddeServerName $ddeServerName]
|
||||
puts $f [list load $::ddelib dde]
|
||||
puts $f [list load $::ddelib Dde]
|
||||
puts $f {
|
||||
# DDE child server -
|
||||
#
|
||||
@@ -111,7 +111,7 @@ test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
|
||||
} -result {foobar foobar self}
|
||||
|
||||
test winDde-2.1 {Checking for other services} -constraints dde -body {
|
||||
expr [llength [dde services {} {}]] >= 0
|
||||
expr {[llength [dde services {} {}]] >= 0}
|
||||
} -result 1
|
||||
test winDde-2.2 {Checking for existence, with service and topic specified} \
|
||||
-constraints dde -body {
|
||||
@@ -119,11 +119,11 @@ test winDde-2.2 {Checking for existence, with service and topic specified} \
|
||||
} -result 1
|
||||
test winDde-2.3 {Checking for existence, with only the service specified} \
|
||||
-constraints dde -body {
|
||||
expr [llength [dde services TclEval {}]] >= 1
|
||||
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
|
||||
expr {[llength [dde services {} self]] >= 1}
|
||||
} -result 1
|
||||
|
||||
# -------------------------------------------------------------------------
|
||||
|
||||
+8
-6
@@ -29,7 +29,9 @@ testConstraint testchmod [llength [info commands testchmod]]
|
||||
testConstraint cdrom 0
|
||||
testConstraint exdev 0
|
||||
testConstraint longFileNames 0
|
||||
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
|
||||
# Some things fail under all Continuous Integration systems for subtle reasons
|
||||
# such as CI often running with elevated privileges in a container.
|
||||
testConstraint notInCIenv [expr {![info exists ::env(CI)]}]
|
||||
|
||||
proc createfile {file {string a}} {
|
||||
set f [open $file w]
|
||||
@@ -411,7 +413,7 @@ proc MakeFiles {dirname} {
|
||||
|
||||
test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup {
|
||||
cleanup
|
||||
} -constraints {win winNonZeroInodes knownMsvcBug} -body {
|
||||
} -constraints {win winNonZeroInodes notInCIenv} -body {
|
||||
file mkdir td1
|
||||
foreach {a b} [MakeFiles td1] break
|
||||
file rename -force $a $b
|
||||
@@ -661,7 +663,7 @@ test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} -setup {
|
||||
|
||||
test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup {
|
||||
cleanup
|
||||
} -constraints {winVista testfile testchmod knownMsvcBug} -body {
|
||||
} -constraints {winVista testfile testchmod notInCIenv} -body {
|
||||
file mkdir td1
|
||||
testchmod 0 td1
|
||||
testfile rmdir td1
|
||||
@@ -715,7 +717,7 @@ test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} -setup {
|
||||
} -result {1 {tf1 ENOTDIR}}
|
||||
test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup {
|
||||
cleanup
|
||||
} -constraints {winVista testfile testchmod knownMsvcBug} -body {
|
||||
} -constraints {winVista testfile testchmod notInCIenv} -body {
|
||||
file mkdir td1
|
||||
testchmod 0 td1
|
||||
testfile rmdir td1
|
||||
@@ -733,7 +735,7 @@ test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
|
||||
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
|
||||
test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
|
||||
cleanup
|
||||
} -constraints {winVista testfile testchmod knownMsvcBug} -body {
|
||||
} -constraints {winVista testfile testchmod notInCIenv} -body {
|
||||
file mkdir td1
|
||||
testchmod 0 td1
|
||||
testfile rmdir td1
|
||||
@@ -962,7 +964,7 @@ test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup {
|
||||
} -result {}
|
||||
test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
|
||||
cleanup
|
||||
} -constraints {winVista testfile testchmod knownMsvcBug} -body {
|
||||
} -constraints {winVista testfile testchmod notInCIenv} -body {
|
||||
file mkdir td1/td2
|
||||
testchmod 0 td1
|
||||
testfile rmdir -force td1
|
||||
|
||||
+4
-2
@@ -19,7 +19,9 @@ if {"::tcltest" ni [namespace children]} {
|
||||
catch [list package require -exact Tcltest [info patchlevel]]
|
||||
|
||||
testConstraint testwinclock [llength [info commands testwinclock]]
|
||||
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
|
||||
# Some things fail under all Continuous Integration systems for subtle reasons
|
||||
# such as CI often running with elevated privileges in a container.
|
||||
testConstraint notInCIenv [expr {![info exists ::env(CI)]}]
|
||||
|
||||
# The next two tests will crash on Windows if the check for negative
|
||||
# clock values is not done properly.
|
||||
@@ -41,7 +43,7 @@ test winTime-1.2 {TclpGetDate} {win} {
|
||||
# with the Windows clock. 30 sec really isn't enough,
|
||||
# but how much time does a tester have patience for?
|
||||
|
||||
test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock knownMsvcBug} {
|
||||
test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock notInCIenv} {
|
||||
# May fail due to OS/hardware discrepancies. See:
|
||||
# http://support.microsoft.com/default.aspx?scid=kb;en-us;274323
|
||||
set failed {}
|
||||
|
||||
+4
-4
@@ -140,7 +140,7 @@ test zlib-7.7 {zlib stream: Bug 25842c161} -constraints zlib -body {
|
||||
} -result ""
|
||||
# Also causes Tk Bug 10f2e7872b
|
||||
test zlib-7.8 {zlib stream: Bug b26e38a3e4} -constraints zlib -setup {
|
||||
expr srand(12345)
|
||||
expr {srand(12345)}
|
||||
set randdata {}
|
||||
for {set i 0} {$i<6001} {incr i} {
|
||||
append randdata [binary format c [expr {int(256*rand())}]]
|
||||
@@ -451,7 +451,7 @@ 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} {
|
||||
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())}]]
|
||||
}
|
||||
@@ -1032,7 +1032,7 @@ test zlib-13.1 {Ticket [8af92dfb66] - zlib stream mis-expansion} -constraints zl
|
||||
close $chanin
|
||||
close $chanout
|
||||
} -body {
|
||||
file size $pathout
|
||||
file size $pathout
|
||||
} -cleanup {
|
||||
removeFile $pathout
|
||||
unset chanin pathin chanout pathout
|
||||
@@ -1069,7 +1069,7 @@ test zlib-13.2 {Ticket [f70ce1fead] - zlib multi-stream expansion} -constraints
|
||||
fcopy $chanin $chanout
|
||||
chan pop $chanin
|
||||
close $chanout
|
||||
#
|
||||
#
|
||||
list [file size $pathout1] [file size $pathout2]
|
||||
} -cleanup {
|
||||
close $chanin
|
||||
|
||||
+3
-3
@@ -155,9 +155,9 @@ REG_LIB_FILE = @LIBPREFIX@tclreg$(REGVER)${DLLSUFFIX}${LIBSUFFIX}
|
||||
TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX}
|
||||
TEST_EXE_FILE = tcltest${EXESUFFIX}
|
||||
TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX}
|
||||
TEST_LOAD_PRMS = package ifneeded dde 1.4.3 [list load [file normalize ${DDE_DLL_FILE}] dde];\
|
||||
package ifneeded registry 1.3.5 [list load [file normalize ${REG_DLL_FILE}] registry]
|
||||
TEST_LOAD_FACILITIES = package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest];\
|
||||
TEST_LOAD_PRMS = package ifneeded dde 1.4.3 [list load [file normalize ${DDE_DLL_FILE}] Dde];\
|
||||
package ifneeded registry 1.3.5 [list load [file normalize ${REG_DLL_FILE}] Registry]
|
||||
TEST_LOAD_FACILITIES = package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}]];\
|
||||
$(TEST_LOAD_PRMS)
|
||||
ZLIB_DLL_FILE = zlib1.dll
|
||||
|
||||
|
||||
+2
-2
@@ -163,12 +163,12 @@ Tcl_AppInit(
|
||||
if (Registry_Init(interp) == TCL_ERROR) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
|
||||
Tcl_StaticPackage(interp, "Registry", Registry_Init, NULL);
|
||||
|
||||
if (Dde_Init(interp) == TCL_ERROR) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
|
||||
Tcl_StaticPackage(interp, "Dde", Dde_Init, Dde_SafeInit);
|
||||
#endif
|
||||
|
||||
#ifdef TCL_TEST
|
||||
|
||||
Reference in New Issue
Block a user