Check-in [600368ed3f]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Merge 8.7
Timelines: family | ancestors | descendants | both | build-info
Files: files | file ages | folders
SHA3-256: 600368ed3f2a24e5e147372b7c87e1de627b77331e1b2cfafcc282f64ad9d331
User & Date: jan.nijtmans 2020-10-16 16:34:29.537
Context
2020-10-18
20:27
Merge 8.7 check-in: 3079f8774c user: jan.nijtmans tags: build-info
2020-10-16
16:34
Merge 8.7 check-in: 600368ed3f user: jan.nijtmans tags: build-info
16:24
Merge 8.6 check-in: 3e4e2312bc user: jan.nijtmans tags: core-8-branch
2020-10-14
09:41
Merge 8.7 check-in: 57d6405a93 user: jan.nijtmans tags: build-info
Changes
Unified Diff Ignore Whitespace Patch
Changes to .travis.yml.
220
221
222
223
224
225
226


227
228
229
230
231
232
233
    - name: "Windows/MSVC/Shared"
      os: windows
      compiler: cl
      env: &vcenv
        - BUILD_DIR=win
        - VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build"
      before_install: &vcpreinst


        - PATH="$PATH:$VCDIR"
        - cd ${BUILD_DIR}
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc test
    - name: "Windows/MSVC/Shared: UTF_MAX=4"







>
>







220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
    - name: "Windows/MSVC/Shared"
      os: windows
      compiler: cl
      env: &vcenv
        - BUILD_DIR=win
        - VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build"
      before_install: &vcpreinst
        - rm -rf tests/safe-stock8*.test
        - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
        - PATH="$PATH:$VCDIR"
        - cd ${BUILD_DIR}
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc test
    - name: "Windows/MSVC/Shared: UTF_MAX=4"
334
335
336
337
338
339
340


341
342
343
344
345
346
347
    - name: "Windows/GCC/Shared"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit"
      before_install: &makepreinst


        - choco install -y make zip
        - cd ${BUILD_DIR}
    - name: "Windows/GCC/Shared: UTF_MAX=4"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win







>
>







336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
    - name: "Windows/GCC/Shared"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit"
      before_install: &makepreinst
        - rm -rf tests/safe-stock8*.test
        - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
        - choco install -y make zip
        - cd ${BUILD_DIR}
    - name: "Windows/GCC/Shared: UTF_MAX=4"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
441
442
443
444
445
446
447

448
449
450
451
452
453
454
455
456
457
458
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
      script:
        - make dist
before_install:

  - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
  - cd ${BUILD_DIR}
install:
  - mkdir "$HOME/install dir"
  - ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
before_script:
  - export ERROR_ON_FAILURES=1
script:
  - make all tcltest || echo "Something wrong, maybe a hickup, let's try again"
  - make test
  - make install







>











445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
      script:
        - make dist
before_install:
  - rm -rf tests/safe-stock8*.test
  - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
  - cd ${BUILD_DIR}
install:
  - mkdir "$HOME/install dir"
  - ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
before_script:
  - export ERROR_ON_FAILURES=1
script:
  - make all tcltest || echo "Something wrong, maybe a hickup, let's try again"
  - make test
  - make install
Changes to doc/interp.n.
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
access to it. For a detailed explanation of hidden commands, see
\fBHIDDEN COMMANDS\fR, below.
The alias mechanism can be used for protected communication (analogous to a
kernel call) between a child interpreter and its parent.
See \fBALIAS INVOCATION\fR, below, for more details
on how the alias mechanism works.
.PP
A qualified interpreter name is a proper Tcl lists containing a subset of its
ancestors in the interpreter hierarchy, terminated by the string naming the
interpreter in its immediate parent. Interpreter names are relative to the
interpreter in which they are used. For example, if
.QW \fBa\fR
is a child of the current interpreter and it has a child
.QW \fBa1\fR ,
which in turn has a child







|







54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
access to it. For a detailed explanation of hidden commands, see
\fBHIDDEN COMMANDS\fR, below.
The alias mechanism can be used for protected communication (analogous to a
kernel call) between a child interpreter and its parent.
See \fBALIAS INVOCATION\fR, below, for more details
on how the alias mechanism works.
.PP
A qualified interpreter name is a proper Tcl list containing a subset of its
ancestors in the interpreter hierarchy, terminated by the string naming the
interpreter in its immediate parent. Interpreter names are relative to the
interpreter in which they are used. For example, if
.QW \fBa\fR
is a child of the current interpreter and it has a child
.QW \fBa1\fR ,
which in turn has a child
Changes to generic/tclPkgConfig.c.
31
32
33
34
35
36
37








38
39
40
41
42
43
44
 *
 * - TCL_CFGVAL_ENCODING	string containing the encoding used for the
 *				configuration values.
 */

#include "tclInt.h"









/*
 * Use C preprocessor statements to define the various values for the embedded
 * configuration information.
 */

#if TCL_THREADS
#  define  CFG_THREADED		"1"







>
>
>
>
>
>
>
>







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
 *
 * - TCL_CFGVAL_ENCODING	string containing the encoding used for the
 *				configuration values.
 */

#include "tclInt.h"

#ifndef TCL_CFGVAL_ENCODING
#   ifdef _WIN32
#	define TCL_CFGVAL_ENCODING "cp1252"
#   else
#	define TCL_CFGVAL_ENCODING "iso8859-1"
#   endif
#endif

/*
 * Use C preprocessor statements to define the various values for the embedded
 * configuration information.
 */

#if TCL_THREADS
#  define  CFG_THREADED		"1"
Changes to tests/cmdAH.test.
26
27
28
29
30
31
32

33
34
35
36
37
38
39
    [llength [info command testsize]] && [testsize st_mtime] >= 8
}]
testConstraint linkDirectory [expr {
    ![testConstraint win] ||
    ($::tcl_platform(osVersion) >= 5.0
     && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
}]


global env
set cmdAHwd [pwd]
catch {set platform [testgetplatform]}

proc waitForEvenSecondForFAT {} {
    # Windows 9x uses filesystems (the FAT* family of FSes) without enough







>







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
    [llength [info command testsize]] && [testsize st_mtime] >= 8
}]
testConstraint linkDirectory [expr {
    ![testConstraint win] ||
    ($::tcl_platform(osVersion) >= 5.0
     && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
}]
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

global env
set cmdAHwd [pwd]
catch {set platform [testgetplatform]}

proc waitForEvenSecondForFAT {} {
    # Windows 9x uses filesystems (the FAT* family of FSes) without enough
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
    file owned $tmpfile
} -cleanup {
    removeFile touch.me /tmp
} -result 1
test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} {
    file owned /
} 0
test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints win -body {
    if {[info exists env(SystemRoot)]} {
	file owned $env(SystemRoot)
    } else {
	file owned $env(windir)
    }
} -result 0
test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body {







|







1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
    file owned $tmpfile
} -cleanup {
    removeFile touch.me /tmp
} -result 1
test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} {
    file owned /
} 0
test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints {win notWine} -body {
    if {[info exists env(SystemRoot)]} {
	file owned $env(SystemRoot)
    } else {
	file owned $env(windir)
    }
} -result 0
test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body {
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
} -body {
    # Unlike [exec ln -s], [file link] requires an existing target
    file link -symbolic $linkfile $gorpfile
    file type $linkfile
} -cleanup {
    file delete $linkfile
} -result link
test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory} -setup {
    set tempdir [makeDirectory temp]
} -body {
    set linkdir [file join [temporaryDirectory] link.dir]
    file link -symbolic $linkdir $tempdir
    file type $linkdir
} -cleanup {
    file delete $linkdir







|







1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
} -body {
    # Unlike [exec ln -s], [file link] requires an existing target
    file link -symbolic $linkfile $gorpfile
    file type $linkfile
} -cleanup {
    file delete $linkfile
} -result link
test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory notWine} -setup {
    set tempdir [makeDirectory temp]
} -body {
    set linkdir [file join [temporaryDirectory] link.dir]
    file link -symbolic $linkdir $tempdir
    file type $linkdir
} -cleanup {
    file delete $linkdir
Changes to tests/env.test.
100
101
102
103
104
105
106

107

108
109
110
111
112
113
114
}

variable keep {
    TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
    SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
    DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
    __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM

    CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432

}

variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
    encoding system iso8859-1
    proc lrem {listname name} {
	upvar $listname list
	set i [lsearch -nocase $list $name]







>
|
>







100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
}

variable keep {
    TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
    SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
    DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
    __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
    CommonProgramFiles CommonProgramFiles(x86) ProgramFiles
    ProgramFiles(x86) CommonProgramW6432 ProgramW6432
    WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR
}

variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
    encoding system iso8859-1
    proc lrem {listname name} {
	upvar $listname list
	set i [lsearch -nocase $list $name]
Changes to tests/fCmd.test.
37
38
39
40
41
42
43

44
45
46
47
48
49
50
	    # try the location given to use on the commandline to tcltest
	    ::tcltest::loadTestedCommands
	    load $::reglib Registry
	}
	testConstraint reg 1
    }
}


set tmpspace /tmp;# default value
# Find a group that exists on this Unix system, or else skip tests that
# require Unix groups.
testConstraint foundGroup [expr {![testConstraint unix]}]
if {[testConstraint unix]} {
    catch {







>







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
	    # try the location given to use on the commandline to tcltest
	    ::tcltest::loadTestedCommands
	    load $::reglib Registry
	}
	testConstraint reg 1
    }
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

set tmpspace /tmp;# default value
# Find a group that exists on this Unix system, or else skip tests that
# require Unix groups.
testConstraint foundGroup [expr {![testConstraint unix]}]
if {[testConstraint unix]} {
    catch {
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
    file mkdir td1
    set x [list [file exists tf1] [file exists tf2] [file exists td1]]
    file delete tf1 td1 tf2
    lappend x [file exists tf1] [file exists tf2] [file exists tf3]
} -cleanup {cleanup} -result {1 1 1 0 0 0}
test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup {
    cleanup
} -constraints {notRoot unixOrWin} -body {
    createfile tf1
    createfile tf2
    file mkdir td1
    catch {file delete tf1 td1 $root tf2}
    list [file exists tf1] [file exists tf2] [file exists td1]
} -cleanup {cleanup} -result {0 1 0}
test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body {







|







413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
    file mkdir td1
    set x [list [file exists tf1] [file exists tf2] [file exists td1]]
    file delete tf1 td1 tf2
    lappend x [file exists tf1] [file exists tf2] [file exists tf3]
} -cleanup {cleanup} -result {1 1 1 0 0 0}
test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup {
    cleanup
} -constraints {notRoot unixOrWin notWine} -body {
    createfile tf1
    createfile tf2
    file mkdir td1
    catch {file delete tf1 td1 $root tf2}
    list [file exists tf1] [file exists tf2] [file exists td1]
} -cleanup {cleanup} -result {0 1 0}
test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body {
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
    file mkdir td2
    createfile [file join td2 tf1]
    file rename -force td2 td1
    file exists [file join td1 td2 tf1]
} -result 1
test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir [file join td1 td2]
    createfile [file join td1 td2 tf1]
    file mkdir td2
    file rename -force td2 td1
} -returnCodes error -match glob -result \
    [subst {error renaming "td2" to "[file join td1 td2]": file *}]
test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    file rename -force $root tf1
} -result [subst {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}]
test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir [file join td1 td2]
    createfile [file join td1 td2 tf1]
    file mkdir td2
    file rename -force td2 td1
} -returnCodes error -match glob -result \
    [subst {error renaming "td2" to "[file join td1 td2]": file *}]
test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup {







|








|




|







560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
    file mkdir td2
    createfile [file join td2 tf1]
    file rename -force td2 td1
    file exists [file join td1 td2 tf1]
} -result 1
test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} -setup {
    cleanup
} -constraints {notRoot notWine} -body {
    file mkdir [file join td1 td2]
    createfile [file join td1 td2 tf1]
    file mkdir td2
    file rename -force td2 td1
} -returnCodes error -match glob -result \
    [subst {error renaming "td2" to "[file join td1 td2]": file *}]
test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} -setup {
    cleanup
} -constraints {notRoot notWine} -returnCodes error -body {
    file rename -force $root tf1
} -result [subst {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}]
test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
    cleanup
} -constraints {notRoot notWine} -body {
    file mkdir [file join td1 td2]
    createfile [file join td1 td2 tf1]
    file mkdir td2
    file rename -force td2 td1
} -returnCodes error -match glob -result \
    [subst {error renaming "td2" to "[file join td1 td2]": file *}]
test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup {
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
    file rename td2 td4
    list [lsort [glob td*]] [file writable td3] [file writable td4]
} -cleanup {
    cleanup
} -result {{td3 td4} 1 0}
test fCmd-9.5 {file rename: comprehensive: file to self} -setup {
    cleanup
} -constraints {notRoot testchmod} -body {
    createfile tf1 tf1
    createfile tf2 tf2
    testchmod 0o444 tf2
    file rename -force tf1 tf1
    file rename -force tf2 tf2
    list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
} -result {tf1 tf2 1 0}







|







808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
    file rename td2 td4
    list [lsort [glob td*]] [file writable td3] [file writable td4]
} -cleanup {
    cleanup
} -result {{td3 td4} 1 0}
test fCmd-9.5 {file rename: comprehensive: file to self} -setup {
    cleanup
} -constraints {notRoot testchmod notWine} -body {
    createfile tf1 tf1
    createfile tf2 tf2
    testchmod 0o444 tf2
    file rename -force tf1 tf1
    file rename -force tf2 tf2
    list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
} -result {tf1 tf2 1 0}
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
    testchmod 0o555 td2
    file rename -force td1 .
    file rename -force td2 .
    list [lsort [glob td*]] [file writable td1] [file writable td2]
} -result {{td1 td2} 1 0}
test fCmd-9.7 {file rename: comprehensive: file to existing file} -setup {
    cleanup
} -constraints {notRoot testchmod} -body {
    createfile tf1
    createfile tf2
    createfile tfs1
    createfile tfs2
    createfile tfs3
    createfile tfs4
    createfile tfd1







|







838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
    testchmod 0o555 td2
    file rename -force td1 .
    file rename -force td2 .
    list [lsort [glob td*]] [file writable td1] [file writable td2]
} -result {{td1 td2} 1 0}
test fCmd-9.7 {file rename: comprehensive: file to existing file} -setup {
    cleanup
} -constraints {notRoot testchmod notWine} -body {
    createfile tf1
    createfile tf2
    createfile tfs1
    createfile tfs2
    createfile tfs3
    createfile tfs4
    createfile tfd1
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
    }
    list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
    [file writable [file join tdd2 tds2]] $w3 $w4
} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]
# Test can hit EEXIST or EBUSY, depending on underlying filesystem
test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup {
    cleanup
} -constraints {notRoot testchmod} -body {
    file mkdir tds1
    file mkdir tds2
    file mkdir [file join tdd1 tds1 xxx]
    file mkdir [file join tdd2 tds2 xxx]
    if {!([testConstraint unix] || [testConstraint winVista])} {
	testchmod 0o555 tds2
    }







|







899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
    }
    list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
    [file writable [file join tdd2 tds2]] $w3 $w4
} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]
# Test can hit EEXIST or EBUSY, depending on underlying filesystem
test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup {
    cleanup
} -constraints {notRoot testchmod notWine} -body {
    file mkdir tds1
    file mkdir tds2
    file mkdir [file join tdd1 tds1 xxx]
    file mkdir [file join tdd2 tds2 xxx]
    if {!([testConstraint unix] || [testConstraint winVista])} {
	testchmod 0o555 tds2
    }
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
	[catch {file rename td1 td2} msg] $msg
} -cleanup {
    testchmod 0o755 [file join td2 td1]
} -result [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
# Test can hit EEXIST or EBUSY, depending on underlying filesystem
test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir [file join td1 td2] [file join td2 td1 td4]
    file rename -force td1 td2
} -returnCodes error -match glob -result \
    [subst {error renaming "td1" to "[file join td2 td1]": file *}]
test fCmd-9.14 {file rename: comprehensive: dir into self} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir td1
    list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
} -result [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
test fCmd-9.14.1 {file rename: comprehensive: dir into self} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir td1







|






|







963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
	[catch {file rename td1 td2} msg] $msg
} -cleanup {
    testchmod 0o755 [file join td2 td1]
} -result [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
# Test can hit EEXIST or EBUSY, depending on underlying filesystem
test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup {
    cleanup
} -constraints {notRoot notWine} -body {
    file mkdir [file join td1 td2] [file join td2 td1 td4]
    file rename -force td1 td2
} -returnCodes error -match glob -result \
    [subst {error renaming "td1" to "[file join td2 td1]": file *}]
test fCmd-9.14 {file rename: comprehensive: dir into self} -setup {
    cleanup
} -constraints {notRoot notWine} -body {
    file mkdir td1
    list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
} -result [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
test fCmd-9.14.1 {file rename: comprehensive: dir into self} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir td1
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
	    [glob -directory td4 t*] [file writable td3] [file writable td4]
} -cleanup {
    testchmod 0o755 td2
    testchmod 0o755 td4
} -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1]
test fCmd-10.4 {file copy: comprehensive: file to existing file} -setup {
    cleanup
} -constraints {notRoot testchmod} -body {
    createfile tf1
    createfile tf2
    createfile tfs1
    createfile tfs2
    createfile tfs3
    createfile tfs4
    createfile tfd1







|







1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
	    [glob -directory td4 t*] [file writable td3] [file writable td4]
} -cleanup {
    testchmod 0o755 td2
    testchmod 0o755 td4
} -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1]
test fCmd-10.4 {file copy: comprehensive: file to existing file} -setup {
    cleanup
} -constraints {notRoot testchmod notWine} -body {
    createfile tf1
    createfile tf2
    createfile tfs1
    createfile tfs2
    createfile tfs3
    createfile tfs4
    createfile tfd1
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
    file link doesnt/abc.link abc.dir
} -returnCodes error -cleanup {
    cd [workingDirectory]
} -result {could not create new link "doesnt/abc.link": no such file or directory}
test fCmd-28.11 {file link: success with directory} -setup {
    cd [temporaryDirectory]
    file delete -force abc.link
} -constraints {linkDirectory} -body {
    file link abc.link abc.dir
} -cleanup {
    cd [workingDirectory]
} -result abc.dir
test fCmd-28.12 {file link: cd into a link} -setup {
    cd [temporaryDirectory]
    file delete -force abc.link
} -constraints {linkDirectory} -body {
    file link abc.link abc.dir
    set orig [pwd]
    cd abc.link
    set dir [pwd]
    cd ..
    set up [pwd]
    cd $orig







|







|







2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
    file link doesnt/abc.link abc.dir
} -returnCodes error -cleanup {
    cd [workingDirectory]
} -result {could not create new link "doesnt/abc.link": no such file or directory}
test fCmd-28.11 {file link: success with directory} -setup {
    cd [temporaryDirectory]
    file delete -force abc.link
} -constraints {linkDirectory notWine} -body {
    file link abc.link abc.dir
} -cleanup {
    cd [workingDirectory]
} -result abc.dir
test fCmd-28.12 {file link: cd into a link} -setup {
    cd [temporaryDirectory]
    file delete -force abc.link
} -constraints {linkDirectory notWine} -body {
    file link abc.link abc.dir
    set orig [pwd]
    cd abc.link
    set dir [pwd]
    cd ..
    set up [pwd]
    cd $orig
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
    } else {
	return "ok"
    }
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result ok
test fCmd-28.13 {file link} -constraints {linkDirectory} -setup {
    cd [temporaryDirectory]
    file link abc.link abc.dir
} -body {
    # duplicate link throws error
    file link abc.link abc.dir
} -returnCodes error -cleanup {
    file delete -force abc.link







|







2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
    } else {
	return "ok"
    }
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result ok
test fCmd-28.13 {file link} -constraints {linkDirectory notWine} -setup {
    cd [temporaryDirectory]
    file link abc.link abc.dir
} -body {
    # duplicate link throws error
    file link abc.link abc.dir
} -returnCodes error -cleanup {
    file delete -force abc.link
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result {directory abc.dir}
test fCmd-28.15.2 {file link: copies link not dir} -setup {
    cd [temporaryDirectory]
    file delete -force abc.link
} -constraints {linkDirectory} -body {
    file link abc.link abc.dir
    file copy abc.link abc2.link
    list [file type abc2.link] [file tail [file link abc2.link]]
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result {link abc.dir}
cd [temporaryDirectory]
file delete -force abc.link
file delete -force abc2.link
cd abc.dir
file delete -force abc.file
file delete -force abc2.file
cd ..
file copy abc.file abc.dir
file copy abc2.file abc.dir
cd [workingDirectory]
test fCmd-28.16 {file link: glob inside link} -setup {
    cd [temporaryDirectory]
    file delete -force abc.link
} -constraints {linkDirectory} -body {
    file link abc.link abc.dir
    lsort [glob -dir abc.link -tails *]
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result {abc.file abc2.file}
test fCmd-28.17 {file link: glob -type l} -setup {
    cd [temporaryDirectory]
    file link abc.link abc.dir
} -constraints {linkDirectory} -body {
    glob -dir [pwd] -type l -tails abc*
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result {abc.link}
test fCmd-28.18 {file link: glob -type d} -constraints linkDirectory -setup {
    cd [temporaryDirectory]
    file link abc.link abc.dir
} -body {
    lsort [glob -dir [pwd] -type d -tails abc*]
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result [lsort [list abc.link abc.dir abc2.dir]]
test fCmd-28.19 {file link: relative paths} -setup {
    cd [temporaryDirectory]
} -constraints {win linkDirectory} -body {
    file mkdir d1/d2/d3
    file link d1/l2 d1/d2
} -cleanup {
    catch {file delete -force d1}
    cd [workingDirectory]
} -result d1/d2
test fCmd-28.20 {file link: relative paths} -setup {







|




















|









|





|










|







2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result {directory abc.dir}
test fCmd-28.15.2 {file link: copies link not dir} -setup {
    cd [temporaryDirectory]
    file delete -force abc.link
} -constraints {linkDirectory notWine} -body {
    file link abc.link abc.dir
    file copy abc.link abc2.link
    list [file type abc2.link] [file tail [file link abc2.link]]
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result {link abc.dir}
cd [temporaryDirectory]
file delete -force abc.link
file delete -force abc2.link
cd abc.dir
file delete -force abc.file
file delete -force abc2.file
cd ..
file copy abc.file abc.dir
file copy abc2.file abc.dir
cd [workingDirectory]
test fCmd-28.16 {file link: glob inside link} -setup {
    cd [temporaryDirectory]
    file delete -force abc.link
} -constraints {linkDirectory notWine} -body {
    file link abc.link abc.dir
    lsort [glob -dir abc.link -tails *]
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result {abc.file abc2.file}
test fCmd-28.17 {file link: glob -type l} -setup {
    cd [temporaryDirectory]
    file link abc.link abc.dir
} -constraints {linkDirectory notWine} -body {
    glob -dir [pwd] -type l -tails abc*
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result {abc.link}
test fCmd-28.18 {file link: glob -type d} -constraints {linkDirectory notWine} -setup {
    cd [temporaryDirectory]
    file link abc.link abc.dir
} -body {
    lsort [glob -dir [pwd] -type d -tails abc*]
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result [lsort [list abc.link abc.dir abc2.dir]]
test fCmd-28.19 {file link: relative paths} -setup {
    cd [temporaryDirectory]
} -constraints {win linkDirectory notWine} -body {
    file mkdir d1/d2/d3
    file link d1/l2 d1/d2
} -cleanup {
    catch {file delete -force d1}
    cd [workingDirectory]
} -result d1/d2
test fCmd-28.20 {file link: relative paths} -setup {
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590

test fCmd-30.1 {file writable on 'My Documents'} -setup {
    # Get the localized version of the folder name by looking in the registry.
    set mydocsname [registry get {HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} Personal]
} -constraints {win reg} -body {
    file writable $mydocsname
} -result 1
test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win} -body {
    expr {[info exists env(USERPROFILE)]
          && [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 {
    set r {}
    if {[info exists env(SystemDrive)]} {
        set path $env(SystemDrive)/pagefile.sys
        lappend r exists [file exists $path]
        lappend r readable [file readable $path]
        lappend r stat [catch {file stat $path a} e] $e
    }







|




|







2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591

test fCmd-30.1 {file writable on 'My Documents'} -setup {
    # Get the localized version of the folder name by looking in the registry.
    set mydocsname [registry get {HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} Personal]
} -constraints {win reg} -body {
    file writable $mydocsname
} -result 1
test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win notWine} -body {
    expr {[info exists env(USERPROFILE)]
          && [file exists $env(USERPROFILE)/NTUSER.DAT]
          && [file readable $env(USERPROFILE)/NTUSER.DAT]}
} -result {1}
test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win notWine} -body {
    set r {}
    if {[info exists env(SystemDrive)]} {
        set path $env(SystemDrive)/pagefile.sys
        lappend r exists [file exists $path]
        lappend r readable [file readable $path]
        lappend r stat [catch {file stat $path a} e] $e
    }
Changes to tests/fileName.test.
27
28
29
30
31
32
33

34
35
36
37
38
39
40
    if {$::tcl_platform(osVersion) < 5.0 \
	    || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
	testConstraint linkDirectory 0
    }
    testConstraint symbolicLinkFile 0
    testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
}

# This match compares the first two words of the result. If the wanted result
# is "equal", then this is successful if the words are equal. If the wanted
# result is "not equal", then this is successful if the words are different.
customMatch compareWords {apply {{a b} {
    lassign $b w1 w2
    expr {$a eq "equal" ? $w1 eq $w2 : $w1 ne $w2}
}}}







>







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
    if {$::tcl_platform(osVersion) < 5.0 \
	    || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
	testConstraint linkDirectory 0
    }
    testConstraint symbolicLinkFile 0
    testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
# This match compares the first two words of the result. If the wanted result
# is "equal", then this is successful if the words are equal. If the wanted
# result is "not equal", then this is successful if the words are different.
customMatch compareWords {apply {{a b} {
    lassign $b w1 w2
    expr {$a eq "equal" ? $w1 eq $w2 : $w1 ne $w2}
}}}
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
    lsort [glob -directory $globname *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.17.1 {Tcl_GlobCmd} {win} {
    lsort [glob -directory $globname *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.17.2 {Tcl_GlobCmd} -setup {
    set dir [pwd]
} -constraints {notRoot linkDirectory} -body {
    cd $globname
    file link -symbolic link a1
    cd $dir
    lsort [glob -directory $globname -join * b1]
} -cleanup {
    cd $dir
    file delete [file join $globname link]
} -result [list [file join $globname a1 b1] \
	[file join $globname link b1]]
# Simpler version of the above test to illustrate a given bug.
test filename-11.17.3 {Tcl_GlobCmd} -setup {
    set dir [pwd]
} -constraints {notRoot linkDirectory} -body {
    cd $globname
    file link -symbolic link a1
    cd $dir
    lsort [glob -directory $globname -type d *]
} -cleanup {
    cd $dir
    file delete [file join $globname link]
} -result [list [file join $globname a1] \
	[file join $globname a2] \
	[file join $globname a3] \
	[file join $globname link]]
# Make sure the bugfix isn't too simple. We don't want to break 'glob -type l'
test filename-11.17.4 {Tcl_GlobCmd} -setup {
    set dir [pwd]
} -constraints {notRoot linkDirectory} -body {
    cd $globname
    file link -symbolic link a1
    cd $dir
    lsort [glob -directory $globname -type l *]
} -cleanup {
    cd $dir
    file delete [file join $globname link]
} -result [list [file join $globname link]]
test filename-11.17.5 {Tcl_GlobCmd} {
    lsort [glob -directory $globname -tails *.c]
} [lsort [list "weird name.c" x,z1.c x1.c y1.c z1.c]]
test filename-11.17.6 {Tcl_GlobCmd} {
    lsort [glob -directory $globname -tails *.c *.c]
} [lsort [concat [list "weird name.c" x,z1.c x1.c y1.c z1.c] \
	[list "weird name.c" x,z1.c x1.c y1.c z1.c]]]
test filename-11.17.7 {Tcl_GlobCmd: broken link and glob -l} -setup {
    set dir [pwd]
} -constraints {linkDirectory} -body {
    cd $globname
    file mkdir nonexistent
    file link -symbolic link nonexistent
    file delete nonexistent
    cd $dir
    lsort [glob -nocomplain -directory $globname -type l *]
} -cleanup {







|










|












|














|

















|







786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
    lsort [glob -directory $globname *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.17.1 {Tcl_GlobCmd} {win notWine} {
    lsort [glob -directory $globname *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.17.2 {Tcl_GlobCmd} -setup {
    set dir [pwd]
} -constraints {notRoot linkDirectory notWine} -body {
    cd $globname
    file link -symbolic link a1
    cd $dir
    lsort [glob -directory $globname -join * b1]
} -cleanup {
    cd $dir
    file delete [file join $globname link]
} -result [list [file join $globname a1 b1] \
	[file join $globname link b1]]
# Simpler version of the above test to illustrate a given bug.
test filename-11.17.3 {Tcl_GlobCmd} -setup {
    set dir [pwd]
} -constraints {notRoot linkDirectory notWine} -body {
    cd $globname
    file link -symbolic link a1
    cd $dir
    lsort [glob -directory $globname -type d *]
} -cleanup {
    cd $dir
    file delete [file join $globname link]
} -result [list [file join $globname a1] \
	[file join $globname a2] \
	[file join $globname a3] \
	[file join $globname link]]
# Make sure the bugfix isn't too simple. We don't want to break 'glob -type l'
test filename-11.17.4 {Tcl_GlobCmd} -setup {
    set dir [pwd]
} -constraints {notRoot linkDirectory notWine} -body {
    cd $globname
    file link -symbolic link a1
    cd $dir
    lsort [glob -directory $globname -type l *]
} -cleanup {
    cd $dir
    file delete [file join $globname link]
} -result [list [file join $globname link]]
test filename-11.17.5 {Tcl_GlobCmd} {
    lsort [glob -directory $globname -tails *.c]
} [lsort [list "weird name.c" x,z1.c x1.c y1.c z1.c]]
test filename-11.17.6 {Tcl_GlobCmd} {
    lsort [glob -directory $globname -tails *.c *.c]
} [lsort [concat [list "weird name.c" x,z1.c x1.c y1.c z1.c] \
	[list "weird name.c" x,z1.c x1.c y1.c z1.c]]]
test filename-11.17.7 {Tcl_GlobCmd: broken link and glob -l} -setup {
    set dir [pwd]
} -constraints {linkDirectory notWine} -body {
    cd $globname
    file mkdir nonexistent
    file link -symbolic link nonexistent
    file delete nonexistent
    cd $dir
    lsort [glob -nocomplain -directory $globname -type l *]
} -cleanup {
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
    lsort [glob -path $globname/ *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.18.1 {Tcl_GlobCmd} {win} {
    lsort [glob -path $globname/ *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.19 {Tcl_GlobCmd} {unix} {
    lsort [glob -join -path [string range $globname 0 5] * *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.19.1 {Tcl_GlobCmd} {win} {
    lsort [glob -join -path [string range $globname 0 5] * *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.20 {Tcl_GlobCmd} {
    lsort [glob -type d -dir $globname *]
} [lsort [list [file join $globname a1]\
	[file join $globname a2]\
	[file join $globname a3]]]
test filename-11.21 {Tcl_GlobCmd} {
    lsort [glob -type d -path $globname *]
} [list $globname]







|
















|








|







875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
    lsort [glob -path $globname/ *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.18.1 {Tcl_GlobCmd} {win notWine} {
    lsort [glob -path $globname/ *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.19 {Tcl_GlobCmd} {unix} {
    lsort [glob -join -path [string range $globname 0 5] * *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.19.1 {Tcl_GlobCmd} {win notWine} {
    lsort [glob -join -path [string range $globname 0 5] * *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.20 {Tcl_GlobCmd} notWine {
    lsort [glob -type d -dir $globname *]
} [lsort [list [file join $globname a1]\
	[file join $globname a2]\
	[file join $globname a3]]]
test filename-11.21 {Tcl_GlobCmd} {
    lsort [glob -type d -path $globname *]
} [list $globname]
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
    lsort [glob -dir $globname *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.22.1 {Tcl_GlobCmd} {win} {
    lsort [glob -dir $globname *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.23 {Tcl_GlobCmd} {unix} {
    lsort [glob -path $globname/ *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.23.1 {Tcl_GlobCmd} {win} {
    lsort [glob -path $globname/ *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.24 {Tcl_GlobCmd} {unix} {
    lsort [glob -join -path [string range $globname 0 5] * *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.24.1 {Tcl_GlobCmd} {win} {
    lsort [glob -join -path [string range $globname 0 5] * *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.25 {Tcl_GlobCmd} {
    lsort [glob -type d -dir $globname *]
} [lsort [list [file join $globname a1]\
	[file join $globname a2]\
	[file join $globname a3]]]
test filename-11.25.1 {Tcl_GlobCmd} {
    lsort [glob -type {d r} -dir $globname *]
} [lsort [list [file join $globname a1]\
	[file join $globname a2]\
	[file join $globname a3]]]
test filename-11.25.2 {Tcl_GlobCmd} {
    lsort [glob -type {d r w} -dir $globname *]
} [lsort [list [file join $globname a1]\
	[file join $globname a2]\
	[file join $globname a3]]]
test filename-11.26 {Tcl_GlobCmd} {
    glob -type d -path $globname *
} [list $globname]







|
















|
















|








|




|




|







931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
    lsort [glob -dir $globname *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.22.1 {Tcl_GlobCmd} {win notWine} {
    lsort [glob -dir $globname *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.23 {Tcl_GlobCmd} {unix} {
    lsort [glob -path $globname/ *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.23.1 {Tcl_GlobCmd} {win notWine} {
    lsort [glob -path $globname/ *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.24 {Tcl_GlobCmd} {unix} {
    lsort [glob -join -path [string range $globname 0 5] * *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.24.1 {Tcl_GlobCmd} {win notWine} {
    lsort [glob -join -path [string range $globname 0 5] * *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.25 {Tcl_GlobCmd} notWine {
    lsort [glob -type d -dir $globname *]
} [lsort [list [file join $globname a1]\
	[file join $globname a2]\
	[file join $globname a3]]]
test filename-11.25.1 {Tcl_GlobCmd} notWine {
    lsort [glob -type {d r} -dir $globname *]
} [lsort [list [file join $globname a1]\
	[file join $globname a2]\
	[file join $globname a3]]]
test filename-11.25.2 {Tcl_GlobCmd} notWine {
    lsort [glob -type {d r w} -dir $globname *]
} [lsort [list [file join $globname a1]\
	[file join $globname a2]\
	[file join $globname a3]]]
test filename-11.26 {Tcl_GlobCmd} {
    glob -type d -path $globname *
} [list $globname]
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
    cd $savepwd
    file rename [file join globTestContext globTest] globTest
    file delete globTestContext
} -result {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
test filename-14.7 {asterisks, question marks, and brackets} {unix} {
    lsort [glob globTest/*]
} {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.7.1 {asterisks, question marks, and brackets} {win} {
    lsort [glob globTest/*]
} {globTest/.1 globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.9 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob globTest/.*]
} {globTest/. globTest/.. globTest/.1}
test filename-14.11 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob globTest/*/*]
} {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3}
test filename-14.13 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob {globTest/[xyab]1.*}]
} {globTest/x1.c globTest/y1.c}
test filename-14.15 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob globTest/*/]
} {globTest/a1/ globTest/a2/ globTest/a3/}
test filename-14.17 {asterisks, question marks, and brackets} -setup {
    global env
    set temp $env(HOME)
} -body {
    set env(HOME) [file join $env(HOME) globTest]







|


|








|







1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
    cd $savepwd
    file rename [file join globTestContext globTest] globTest
    file delete globTestContext
} -result {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
test filename-14.7 {asterisks, question marks, and brackets} {unix} {
    lsort [glob globTest/*]
} {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.7.1 {asterisks, question marks, and brackets} {win notWine} {
    lsort [glob globTest/*]
} {globTest/.1 globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.9 {asterisks, question marks, and brackets} {unixOrWin notWine} {
    lsort [glob globTest/.*]
} {globTest/. globTest/.. globTest/.1}
test filename-14.11 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob globTest/*/*]
} {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3}
test filename-14.13 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob {globTest/[xyab]1.*}]
} {globTest/x1.c globTest/y1.c}
test filename-14.15 {asterisks, question marks, and brackets} {unixOrWin notWine} {
    lsort [glob globTest/*/]
} {globTest/a1/ globTest/a2/ globTest/a3/}
test filename-14.17 {asterisks, question marks, and brackets} -setup {
    global env
    set temp $env(HOME)
} -body {
    set env(HOME) [file join $env(HOME) globTest]
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
test filename-14.25 {type specific globbing} {unix} {
    lsort [glob -dir globTest -types f *]
} [lsort [list \
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-14.25.1 {type specific globbing} {win} {
    lsort [glob -dir globTest -types f *]
} [lsort [list \
	[file join $globname .1]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]







|







1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
test filename-14.25 {type specific globbing} {unix} {
    lsort [glob -dir globTest -types f *]
} [lsort [list \
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-14.25.1 {type specific globbing} {win notWine} {
    lsort [glob -dir globTest -types f *]
} [lsort [list \
	[file join $globname .1]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
Changes to tests/registry.test.
20
21
22
23
24
25
26

27
28
29
30
31
32
33
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::regver [package require registry 1.3.5]
	}]} {
	testConstraint reg 1
    }
}


# determine the current locale
testConstraint english [expr {
    [llength [info commands testlocale]]
    && [string match "English*" [testlocale all ""]]
}]








>







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::regver [package require registry 1.3.5]
	}]} {
	testConstraint reg 1
    }
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

# determine the current locale
testConstraint english [expr {
    [llength [info commands testlocale]]
    && [string match "English*" [testlocale all ""]]
}]

669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
test registry-12.2 {BroadcastValue} -constraints {win reg} -body {
    registry broadcast "" -time
} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
test registry-12.3 {BroadcastValue} -constraints {win reg} -body {
    registry broadcast "" - 500
} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
test registry-12.4 {BroadcastValue} -constraints {win reg} -body {
    registry broadcast {Environment}
} -result {1 0}
test registry-12.5 {BroadcastValue} -constraints {win reg} -body {
    registry b {}
} -result {1 0}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# tcl-indent-level: 4
# fill-column: 78
# End:







|


|












670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
test registry-12.2 {BroadcastValue} -constraints {win reg} -body {
    registry broadcast "" -time
} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
test registry-12.3 {BroadcastValue} -constraints {win reg} -body {
    registry broadcast "" - 500
} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
test registry-12.4 {BroadcastValue} -constraints {win reg notWine} -body {
    registry broadcast {Environment}
} -result {1 0}
test registry-12.5 {BroadcastValue} -constraints {win reg notWine} -body {
    registry b {}
} -result {1 0}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# tcl-indent-level: 4
# fill-column: 78
# End:
Changes to tests/safe.test.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
# - Tests that used http are replaced here with tests that use example packages
#   provided in subdirectory auto0 of the tests directory, which are independent
#   of any changes made to the packages provided with Tcl itself.
#   - These are tests 7.1 7.2 7.4 9.11 9.13
#   - Tests 5.* test the example packages themselves before they
#     are used to test Safe Base interpreters.
# - Alternative tests using stock packages of Tcl 8.7 are in file
#   safe-stock87.test.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.








|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
# - Tests that used http are replaced here with tests that use example packages
#   provided in subdirectory auto0 of the tests directory, which are independent
#   of any changes made to the packages provided with Tcl itself.
#   - These are tests 7.1 7.2 7.4 9.11 9.13
#   - Tests 5.* test the example packages themselves before they
#     are used to test Safe Base interpreters.
# - Alternative tests using stock packages of Tcl 8.7 are in file
#   safe-stock.test.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
test safe-4.6 {safe::interpDelete, indirectly} -setup {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    a eval exit
} -result ""

# The old test "safe-5.1" has been moved to "safe-stock87-9.8".
# A replacement test using example files is "safe-9.8".
# Tests 5.* test the example files before using them to test safe interpreters.

test safe-5.1 {example tclIndex commands, test in parent interpreter} -setup {
    set tmpAutoPath $::auto_path
    lappend ::auto_path [file join $TestsDir auto0 auto1] [file join $TestsDir auto0 auto2]
} -body {







|







165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
test safe-4.6 {safe::interpDelete, indirectly} -setup {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    a eval exit
} -result ""

# The old test "safe-5.1" has been moved to "safe-stock-9.8".
# A replacement test using example files is "safe-9.8".
# Tests 5.* test the example files before using them to test safe interpreters.

test safe-5.1 {example tclIndex commands, test in parent interpreter} -setup {
    set tmpAutoPath $::auto_path
    lappend ::auto_path [file join $TestsDir auto0 auto1] [file join $TestsDir auto0 auto2]
} -body {
Changes to tests/socket.test.
68
69
70
71
72
73
74

75
76
77
78
79
80
81
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
::tcltest::loadTestedCommands

if {[expr {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]} {
    return
}


# Some tests require the Thread package or exec command
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint exec [llength [info commands exec]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]

# Produce a random port number in the Dynamic/Private range







>







68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
::tcltest::loadTestedCommands

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

# Some tests require the Thread package or exec command
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint exec [llength [info commands exec]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]

# Produce a random port number in the Dynamic/Private range
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
    proc readpipe {pipe} {
	while {![string is integer [set ::done [gets $pipe]]]} {}
    }
    vwait ::done
    close $f
    set ::done
} 0
test socket_$af-2.13 {Bug 1758a0b603} {socket stdio} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f {
	set server [socket -server accept 0]
	puts [lindex [chan configure $server -sockname] 2]
	proc accept { client host port } {
	    chan configure $client -blocking  0 -buffering line -buffersize 1







|







731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
    proc readpipe {pipe} {
	while {![string is integer [set ::done [gets $pipe]]]} {}
    }
    vwait ::done
    close $f
    set ::done
} 0
test socket_$af-2.13 {Bug 1758a0b603} {socket stdio notWine} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f {
	set server [socket -server accept 0]
	puts [lindex [chan configure $server -sockname] 2]
	proc accept { client host port } {
	    chan configure $client -blocking  0 -buffering line -buffersize 1
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
    fileevent $c readable "readlittle $c"
    vwait done
    list $spurious $len $done
} -cleanup {
    after cancel $timer
    sendCommand {close $server}
} -result {0 2690 1}
test socket_$af-11.12 {testing EOF stickyness} -constraints [list socket supported_$af doTestsWithRemoteServer] -setup {
    set counter 0
    set done 0
    set port [sendCommand {
	set server [socket -server accept 0]
	proc accept {s a p} {
	    after idle close $s
	}







|







1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
    fileevent $c readable "readlittle $c"
    vwait done
    list $spurious $len $done
} -cleanup {
    after cancel $timer
    sendCommand {close $server}
} -result {0 2690 1}
test socket_$af-11.12 {testing EOF stickyness} -constraints [list socket supported_$af doTestsWithRemoteServer notWine] -setup {
    set counter 0
    set done 0
    set port [sendCommand {
	set server [socket -server accept 0]
	proc accept {s a p} {
	    after idle close $s
	}
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
        after cancel $after
        close $client
        close $server
        unset x
    } -result {{} bye}
# FIXME: we should also have an IPv6 counterpart of this
test socket-14.5 {[socket -async] which fails before any connect() can be made} \
    -constraints {socket supported_inet} \
    -body {
        # address from rfc5737
        socket -async -myaddr 192.0.2.42 127.0.0.1 [randport]
    } \
    -returnCodes 1 \
    -result {couldn't open socket: cannot assign requested address}
test socket-14.6.0 {[socket -async] with no event loop and server listening on IPv4} \







|







2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
        after cancel $after
        close $client
        close $server
        unset x
    } -result {{} bye}
# FIXME: we should also have an IPv6 counterpart of this
test socket-14.5 {[socket -async] which fails before any connect() can be made} \
    -constraints {socket supported_inet notWine} \
    -body {
        # address from rfc5737
        socket -async -myaddr 192.0.2.42 127.0.0.1 [randport]
    } \
    -returnCodes 1 \
    -result {couldn't open socket: cannot assign requested address}
test socket-14.6.0 {[socket -async] with no event loop and server listening on IPv4} \
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
        set x
    } -cleanup {
        close $s
        unset x s
    } -result {connection refused}

test socket-14.13 {testing writable event when quick failure} \
    -constraints {socket win supported_inet} \
    -body {
    # Test for bug 336441ed59 where a quick background fail was ignored

    # Test only for windows as socket -async 255.255.255.255 fails
    # directly on unix

    # The following connect should fail very quickly







|







2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
        set x
    } -cleanup {
        close $s
        unset x s
    } -result {connection refused}

test socket-14.13 {testing writable event when quick failure} \
    -constraints {socket win supported_inet notWine} \
    -body {
    # Test for bug 336441ed59 where a quick background fail was ignored

    # Test only for windows as socket -async 255.255.255.255 fails
    # directly on unix

    # The following connect should fail very quickly
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
} -cleanup {
        catch {close $ssock}
        catch {close $csock1}
        catch {close $csock2}
    } -result {}

test socket-14.19 {tip 456 -- introduce the -reuseport option} \
    -constraints {socket} \
    -body {
        proc accept {channel address port} {}
        set port [randport]
        set ssock1 [socket -server accept -reuseport yes $port]
        set ssock2 [socket -server accept -reuseport yes $port]
        return ok
} -cleanup {







|







2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
} -cleanup {
        catch {close $ssock}
        catch {close $csock1}
        catch {close $csock2}
    } -result {}

test socket-14.19 {tip 456 -- introduce the -reuseport option} \
    -constraints {socket notWine} \
    -body {
        proc accept {channel address port} {}
        set port [randport]
        set ssock1 [socket -server accept -reuseport yes $port]
        set ssock2 [socket -server accept -reuseport yes $port]
        return ok
} -cleanup {
Changes to tests/winDde.test.
20
21
22
23
24
25
26

27
28
29
30
31
32
33
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::ddever [package require dde 1.4.3]
	    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
	testConstraint dde 1
    }
}



# -------------------------------------------------------------------------
# Setup a script for a test server
#

set scriptName [makeFile {} script1.tcl]







>







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::ddever [package require dde 1.4.3]
	    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
	testConstraint dde 1
    }
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]


# -------------------------------------------------------------------------
# Setup a script for a test server
#

set scriptName [makeFile {} script1.tcl]
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
test winDde-3.6 {DDE request utf-8} -constraints dde -body {
    set \xe1 "not set"
    dde execute TclEval self "set \xe1 \xc4"
    scan [set \xe1] %c
} -result 196
# Set variable a to A with diaeresis (unicode C4) using binary execute
# and compose utf-8 (e.g. "c3 84" ) manualy
test winDde-3.7 {DDE request binary} -constraints dde -body {
    set \xe1 "not set"
    dde execute -binary TclEval self [list set \xc3\xa1 \xc3\x84\x00]
    scan [set \xe1] %c
} -result 196
test winDde-3.8 {DDE poke locally} -constraints {dde debug} -body {
    set \xe1 ""
    dde poke TclEval self \xe1 \xc4







|







158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
test winDde-3.6 {DDE request utf-8} -constraints dde -body {
    set \xe1 "not set"
    dde execute TclEval self "set \xe1 \xc4"
    scan [set \xe1] %c
} -result 196
# Set variable a to A with diaeresis (unicode C4) using binary execute
# and compose utf-8 (e.g. "c3 84" ) manualy
test winDde-3.7 {DDE request binary} -constraints {dde notWine} -body {
    set \xe1 "not set"
    dde execute -binary TclEval self [list set \xc3\xa1 \xc3\x84\x00]
    scan [set \xe1] %c
} -result 196
test winDde-3.8 {DDE poke locally} -constraints {dde debug} -body {
    set \xe1 ""
    dde poke TclEval self \xe1 \xc4
Changes to tests/winFCmd.test.
25
26
27
28
29
30
31

32
33
34
35
36
37
38
testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint testfile       [llength [info commands testfile]]
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)]}]


proc createfile {file {string a}} {
    set f [open $file w]
    puts -nonewline $f $string
    close $f
    return $string
}







>







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint testfile       [llength [info commands testfile]]
testConstraint testchmod      [llength [info commands testchmod]]
testConstraint cdrom 0
testConstraint exdev 0
testConstraint longFileNames 0
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

proc createfile {file {string a}} {
    set f [open $file w]
    puts -nonewline $f $string
    close $f
    return $string
}
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
# low-level posix emulation layer.

test winFCmd-1.1 {TclpRenameFile: errno: EACCES} -body {
    testfile mv $cdfile $cdrom/dummy~~.fil
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td2/td3
    file mkdir td2
    testfile mv td2 td1/td2
} -returnCodes error -result EEXIST
test winFCmd-1.3 {TclpRenameFile: errno: EINVAL} -setup {
    cleanup
} -constraints {win testfile} -body {
    testfile mv / td1
} -returnCodes error -result EINVAL
test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile mv td1 td1/td2
} -returnCodes error -result EINVAL
test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile tf1
    testfile mv tf1 td1
} -returnCodes error -result EISDIR
test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} -setup {
    cleanup
} -constraints {win testfile} -body {







|






|




|





|







129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
# low-level posix emulation layer.

test winFCmd-1.1 {TclpRenameFile: errno: EACCES} -body {
    testfile mv $cdfile $cdrom/dummy~~.fil
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} -setup {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1/td2/td3
    file mkdir td2
    testfile mv td2 td1/td2
} -returnCodes error -result EEXIST
test winFCmd-1.3 {TclpRenameFile: errno: EINVAL} -setup {
    cleanup
} -constraints {win testfile notWine} -body {
    testfile mv / td1
} -returnCodes error -result EINVAL
test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} -setup {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1
    testfile mv td1 td1/td2
} -returnCodes error -result EINVAL
test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} -setup {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1
    createfile tf1
    testfile mv tf1 td1
} -returnCodes error -result EISDIR
test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} -setup {
    cleanup
} -constraints {win testfile} -body {
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    testfile mv tf1 $longname
} -returnCodes error -result ENAMETOOLONG
test winFCmd-1.23 {TclpRenameFile: move dir into self} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile mv [pwd]/td1 td1/td2
} -returnCodes error -result EINVAL
test winFCmd-1.24 {TclpRenameFile: move a root dir} -setup {
    cleanup
} -constraints {win testfile} -body {
    testfile mv / c:/







|







252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    testfile mv tf1 $longname
} -returnCodes error -result ENAMETOOLONG
test winFCmd-1.23 {TclpRenameFile: move dir into self} -setup {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1
    testfile mv [pwd]/td1 td1/td2
} -returnCodes error -result EINVAL
test winFCmd-1.24 {TclpRenameFile: move a root dir} -setup {
    cleanup
} -constraints {win testfile} -body {
    testfile mv / c:/
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
} -constraints {win testfile} -body {
    file mkdir td1
    createfile tf1
    testfile mv td1 tf1
} -returnCodes error -result ENOTDIR
test winFCmd-1.30 {TclpRenameFile: dst is dir} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    file mkdir td2/td2
    testfile mv td1 td2
} -returnCodes error -result EEXIST
test winFCmd-1.31 {TclpRenameFile: TclpRemoveDirectory fails} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    file mkdir td2/td2
    testfile mv td1 td2
} -returnCodes error -result EEXIST
test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td2
    file mkdir td2
    testfile mv td1 td2
    list [file exists td1] [file exists td2] [file exists td2/td2]
} -result {0 1 1}
test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \
	-constraints {win exdev testfile testchmod} -body {







|






|






|







297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
} -constraints {win testfile} -body {
    file mkdir td1
    createfile tf1
    testfile mv td1 tf1
} -returnCodes error -result ENOTDIR
test winFCmd-1.30 {TclpRenameFile: dst is dir} -setup {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1
    file mkdir td2/td2
    testfile mv td1 td2
} -returnCodes error -result EEXIST
test winFCmd-1.31 {TclpRenameFile: TclpRemoveDirectory fails} -setup {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1
    file mkdir td2/td2
    testfile mv td1 td2
} -returnCodes error -result EEXIST
test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} -setup {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1/td2
    file mkdir td2
    testfile mv td1 td2
    list [file exists td1] [file exists td2] [file exists td2/td2]
} -result {0 1 1}
test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \
	-constraints {win exdev testfile testchmod} -body {
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
    createfile tf1
    testfile mv td1 tf1
} -cleanup {
    cleanup
} -returnCodes error -result ENOTDIR
test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile tf1
    testfile mv tf1 td1
} -cleanup {
    cleanup
} -returnCodes error -result EISDIR
test winFCmd-1.36 {TclpRenameFile: src and dst not dir} -setup {







|







340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
    createfile tf1
    testfile mv td1 tf1
} -cleanup {
    cleanup
} -returnCodes error -result ENOTDIR
test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} -setup {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1
    createfile tf1
    testfile mv tf1 td1
} -cleanup {
    cleanup
} -returnCodes error -result EISDIR
test winFCmd-1.36 {TclpRenameFile: src and dst not dir} -setup {
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
        lappend inodes $stat(ino)
        unset stat
    }
}

test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup {
    cleanup
} -constraints {win winNonZeroInodes knownMsvcBug} -body {
    file mkdir td1
    foreach {a b} [MakeFiles td1] break
    file rename -force $a $b
    file exists $a
} -cleanup {
    cleanup
} -result {0}







|







391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
        lappend inodes $stat(ino)
        unset stat
    }
}

test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup {
    cleanup
} -constraints {win winNonZeroInodes knownMsvcBug notWine} -body {
    file mkdir td1
    foreach {a b} [MakeFiles td1] break
    file rename -force $a $b
    file exists $a
} -cleanup {
    cleanup
} -result {0}
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
    list [file type td1] [file type td2]
} -cleanup {
    cleanup
} -result {directory directory}

test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
    cleanup







|







636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
    list [file type td1] [file type td2]
} -cleanup {
    cleanup
} -result {directory directory}

test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug notWine} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    list [catch {testfile rmdir tf1} msg] [file tail $msg]
} -result {1 {tf1 ENOTDIR}}
test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -result {td1 EACCES}
test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
    cleanup
} -constraints {win testfile} -body {
    testfile rmdir /
    # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
    # decision has been made as to which is correct.
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup







|










|






|







690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    list [catch {testfile rmdir tf1} msg] [file tail $msg]
} -result {1 {tf1 ENOTDIR}}
test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug notWine} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -result {td1 EACCES}
test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
    cleanup
} -constraints {win testfile notWine} -body {
    testfile rmdir /
    # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
    # decision has been made as to which is correct.
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug notWine} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1
    testfile rmdir -force td1
} -result {}
test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug} -body {
    file mkdir td1/td2
    testchmod 0 td1
    testfile rmdir -force td1
    file exists td1
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup







|







937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1
    testfile rmdir -force td1
} -result {}
test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug notWine} -body {
    file mkdir td1/td2
    testchmod 0 td1
    testfile rmdir -force td1
    file exists td1
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -archive 1] [file attributes td1 -archive]
} -cleanup {
    cleanup
} -result {{} 1}
test winFCmd-15.3 {SetWinFileAttributes - archive} -constraints {win} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -archive 0] [file attributes td1 -archive]
} -cleanup {
    cleanup
} -result {{} 0}
test winFCmd-15.4 {SetWinFileAttributes - hidden} -constraints {win} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -hidden 1] [file attributes td1 -hidden] \
	[file attributes td1 -hidden 0]
} -cleanup {
    cleanup







|







|







1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -archive 1] [file attributes td1 -archive]
} -cleanup {
    cleanup
} -result {{} 1}
test winFCmd-15.3 {SetWinFileAttributes - archive} -constraints {win notWine} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -archive 0] [file attributes td1 -archive]
} -cleanup {
    cleanup
} -result {{} 0}
test winFCmd-15.4 {SetWinFileAttributes - hidden} -constraints {win notWine} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -hidden 1] [file attributes td1 -hidden] \
	[file attributes td1 -hidden 0]
} -cleanup {
    cleanup
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
    cleanup
} -constraints {win} -body {
    createfile td1 {}
    list [file attributes td1 -readonly 0] [file attributes td1 -readonly]
} -cleanup {
    cleanup
} -result {{} 0}
test winFCmd-15.8 {SetWinFileAttributes - system} -constraints {win} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -system 1] [file attributes td1 -system]
} -cleanup {
    cleanup
} -result {{} 1}







|







1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
    cleanup
} -constraints {win} -body {
    createfile td1 {}
    list [file attributes td1 -readonly 0] [file attributes td1 -readonly]
} -cleanup {
    cleanup
} -result {{} 0}
test winFCmd-15.8 {SetWinFileAttributes - system} -constraints {win notWine} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -system 1] [file attributes td1 -system]
} -cleanup {
    cleanup
} -result {{} 1}
Changes to tests/winFile.test.
20
21
22
23
24
25
26

27
28
29
30
31
32
33

testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint notNTFS 0

if {[testConstraint testvolumetype]} {
    testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}]
}


test winFile-1.1 {TclpGetUserHome} -constraints {win} -body {
    glob ~nosuchuser
} -returnCodes error -result {user "nosuchuser" doesn't exist}
test winFile-1.2 {TclpGetUserHome} -constraints {win nonPortable} -body {
    # The administrator account should always exist.
    glob ~administrator







>







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint notNTFS 0

if {[testConstraint testvolumetype]} {
    testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}]
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

test winFile-1.1 {TclpGetUserHome} -constraints {win} -body {
    glob ~nosuchuser
} -returnCodes error -result {user "nosuchuser" doesn't exist}
test winFile-1.2 {TclpGetUserHome} -constraints {win nonPortable} -body {
    # The administrator account should always exist.
    glob ~administrator
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
    file delete $fname
    close [open $fname w]
}

test winFile-4.0 {
    Enhanced NTFS user/group permissions: test no acccess
} -constraints {
    win notNTFS
} -setup {
    set owner [getuser $fname]
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    # Clean out all well-known ACLs
    catch {cacls $fname /E /R "Everyone"} result
    catch {cacls $fname /E /R $user} result
    catch {cacls $fname /E /R $owner} result
    cacls $fname /E /P $user:N
    test_access $fname 0 0
} -result {}
test winFile-4.1 {
    Enhanced NTFS user/group permissions: test readable only
} -constraints {
    win notNTFS
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:R
    test_access $fname 1 0
} -result {}
test winFile-4.2 {
    Enhanced NTFS user/group permissions: test writable only
} -constraints {
    win notNTFS
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    catch {cacls $fname /E /R $user} result
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:W
    test_access $fname 0 1







|














|










|







147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
    file delete $fname
    close [open $fname w]
}

test winFile-4.0 {
    Enhanced NTFS user/group permissions: test no acccess
} -constraints {
    win notNTFS notWine
} -setup {
    set owner [getuser $fname]
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    # Clean out all well-known ACLs
    catch {cacls $fname /E /R "Everyone"} result
    catch {cacls $fname /E /R $user} result
    catch {cacls $fname /E /R $owner} result
    cacls $fname /E /P $user:N
    test_access $fname 0 0
} -result {}
test winFile-4.1 {
    Enhanced NTFS user/group permissions: test readable only
} -constraints {
    win notNTFS notWine
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:R
    test_access $fname 1 0
} -result {}
test winFile-4.2 {
    Enhanced NTFS user/group permissions: test writable only
} -constraints {
    win notNTFS notWine
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    catch {cacls $fname /E /R $user} result
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:W
    test_access $fname 0 1
Changes to tests/winPipe.test.
23
24
25
26
27
28
29



30
31
32
33
34
35
36
    package require -exact tcl::test [info patchlevel]
    set ::tcltestlib [lindex [package ifneeded tcl::test [info patchlevel]] 1]
}

set org_pwd [pwd]
set bindir [file join $org_pwd [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]




# several test-cases here expect current directory == [temporaryDirectory]:
cd [temporaryDirectory]

testConstraint exec         [llength [info commands exec]]
testConstraint cat32        [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]







>
>
>







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    package require -exact tcl::test [info patchlevel]
    set ::tcltestlib [lindex [package ifneeded tcl::test [info patchlevel]] 1]
}

set org_pwd [pwd]
set bindir [file join $org_pwd [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]

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


# several test-cases here expect current directory == [temporaryDirectory]:
cd [temporaryDirectory]

testConstraint exec         [llength [info commands exec]]
testConstraint cat32        [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
    fconfigure $f  -buffering none -blocking 0
    fileevent $f readable "readResults $f"
    set x 0
    set result ""
    vwait x
    list $result $x [contents $path(stderr)]
} "{$big} 1 stderr32"
test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec testexcept} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "testexcept float_underflow"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGFPE}
test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec testexcept} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "testexcept access_violation"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGSEGV}
test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec testexcept} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "testexcept illegal_instruction"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGILL}
test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec testexcept} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "testexcept ctrl+c"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGINT}







|







|







|







|







196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
    fconfigure $f  -buffering none -blocking 0
    fileevent $f readable "readResults $f"
    set x 0
    set result ""
    vwait x
    list $result $x [contents $path(stderr)]
} "{$big} 1 stderr32"
test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec testexcept notWine} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "testexcept float_underflow"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGFPE}
test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec testexcept notWine} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "testexcept access_violation"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGSEGV}
test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec testexcept notWine} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "testexcept illegal_instruction"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGILL}
test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec testexcept notWine} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "testexcept ctrl+c"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGINT}
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547

test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (particular)} \
-constraints {win exec slowTest} -body {
    _testExecArgs 1 {*}$injectList
} -result {}

test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (jointly)} \
-constraints {win exec} -body {
    _testExecArgs 0 \
	[list START     {*}$injectList END] \
	[list "START\"" {*}$injectList END] \
	[list START     {*}$injectList "\"END"] \
	[list "START\"" {*}$injectList "\"END"]
} -result {}

test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (command/jointly args)} \
-constraints {win exec} -body {
    _testExecArgs 2 \
	[list START     {*}$injectList END] \
	[list "START\"" {*}$injectList END] \
	[list START     {*}$injectList "\"END"] \
	[list "START\"" {*}$injectList "\"END"]
} -result {}

test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (random mix)} \
-constraints {win exec} -body {
    set lst {}
    set maps {
	{\&|^<>!()%}
	{\&|^<>!()% }
	{"\&|^<>!()%}
	{"\&|^<>!()% }
	{"""""\\\\\&|^<>!()%}







|








|








|







518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550

test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (particular)} \
-constraints {win exec slowTest} -body {
    _testExecArgs 1 {*}$injectList
} -result {}

test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (jointly)} \
-constraints {win exec notWine} -body {
    _testExecArgs 0 \
	[list START     {*}$injectList END] \
	[list "START\"" {*}$injectList END] \
	[list START     {*}$injectList "\"END"] \
	[list "START\"" {*}$injectList "\"END"]
} -result {}

test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (command/jointly args)} \
-constraints {win exec notWine} -body {
    _testExecArgs 2 \
	[list START     {*}$injectList END] \
	[list "START\"" {*}$injectList END] \
	[list START     {*}$injectList "\"END"] \
	[list "START\"" {*}$injectList "\"END"]
} -result {}

test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (random mix)} \
-constraints {win exec notWine} -body {
    set lst {}
    set maps {
	{\&|^<>!()%}
	{\&|^<>!()% }
	{"\&|^<>!()%}
	{"\&|^<>!()% }
	{"""""\\\\\&|^<>!()%}
Changes to unix/Makefile.in.
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
# This keeps tcltest from picking up an already installed version of the Tcl
# library.
SHELL_ENV =	@LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@} \
		TCLLIBPATH="@abs_builddir@/pkgs" \
		TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"

${TCLTEST_EXE}: ${TCLTEST_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${BUILD_DLTEST}
	rm -rf $(TOP_DIR)/tests/safe-stock86.test
	$(MAKE) tcltest-real LIB_RUNTIME_DIR="`pwd`"

tcltest-real:
	${CC} ${CFLAGS} ${LDFLAGS} ${TCLTEST_OBJS} \
		@TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \
		${CC_SEARCH_FLAGS} -o ${TCLTEST_EXE}








<







862
863
864
865
866
867
868

869
870
871
872
873
874
875
# This keeps tcltest from picking up an already installed version of the Tcl
# library.
SHELL_ENV =	@LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@} \
		TCLLIBPATH="@abs_builddir@/pkgs" \
		TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"

${TCLTEST_EXE}: ${TCLTEST_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${BUILD_DLTEST}

	$(MAKE) tcltest-real LIB_RUNTIME_DIR="`pwd`"

tcltest-real:
	${CC} ${CFLAGS} ${LDFLAGS} ${TCLTEST_OBJS} \
		@TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \
		${CC_SEARCH_FLAGS} -o ${TCLTEST_EXE}

Changes to win/Makefile.in.
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
	@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
	@MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${TEST_DLL_FILE}.manifest

${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT}
	@$(RM) ${TEST_EXE_FILE}
	@$(RM) $(ROOT_DIR_NATIVE)/tests/safe-stock86.test
	$(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
        tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
	$(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest

# use pre-built zlib1.dll
${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE}
	@if test "@ZLIB_LIBS@set" != "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \







<







592
593
594
595
596
597
598

599
600
601
602
603
604
605
${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
	@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
	@MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${TEST_DLL_FILE}.manifest

${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT}
	@$(RM) ${TEST_EXE_FILE}

	$(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
        tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
	$(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest

# use pre-built zlib1.dll
${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE}
	@if test "@ZLIB_LIBS@set" != "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \
Changes to win/makefile.vc.
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
#		changed.  $(OUT_DIR) is assumed to be
#		$(BINROOT)\(Release|Debug) based on if symbols are requested.
#		$(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default.
#
#	TESTPAT=<file>
#		Reads the tests requested to be run from this file.
#
#	CFG_ENCODING=encoding
#		name of encoding for configuration information. Defaults
#		to cp1252
#
# Examples:
#       c:\tcl_src\win\>nmake -f makefile.vc release
#       c:\tcl_src\win\>nmake -f makefile.vc test
#       c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
#       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=pdbs
#       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=symbols
#







<
<
<
<







110
111
112
113
114
115
116




117
118
119
120
121
122
123
#		changed.  $(OUT_DIR) is assumed to be
#		$(BINROOT)\(Release|Debug) based on if symbols are requested.
#		$(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default.
#
#	TESTPAT=<file>
#		Reads the tests requested to be run from this file.
#




# Examples:
#       c:\tcl_src\win\>nmake -f makefile.vc release
#       c:\tcl_src\win\>nmake -f makefile.vc test
#       c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
#       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=pdbs
#       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=symbols
#
Changes to win/rules.vc.
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
#     compiler version 1200. This is kept only for legacy reasons as it
#     does not make sense for recent Microsoft compilers. Only used for
#     output directory names.
# ARCH - set to IX86 or AMD64 depending on 32- or 64-bit target
# NATIVE_ARCH - set to IX86 or AMD64 for the host machine
# MACHINE - same as $(ARCH) - legacy
# _VC_MANIFEST_EMBED_{DLL,EXE} - commands for embedding a manifest if needed
# CFG_ENCODING - set to an character encoding.
#   TBD - this is passed to compiler as TCL_CFGVAL_ENCODING but can't
#   see where it is used

cc32		= $(CC)   # built-in default.
link32		= link
lib32		= lib
rc32		= $(RC)   # built-in default.

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







<
<
<







411
412
413
414
415
416
417



418
419
420
421
422
423
424
#     compiler version 1200. This is kept only for legacy reasons as it
#     does not make sense for recent Microsoft compilers. Only used for
#     output directory names.
# ARCH - set to IX86 or AMD64 depending on 32- or 64-bit target
# NATIVE_ARCH - set to IX86 or AMD64 for the host machine
# MACHINE - same as $(ARCH) - legacy
# _VC_MANIFEST_EMBED_{DLL,EXE} - commands for embedding a manifest if needed




cc32		= $(CC)   # built-in default.
link32		= link
lib32		= lib
rc32		= $(RC)   # built-in default.

#----------------------------------------------------------------
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516

# Since MSVC8 we must deal with manifest resources.
!if $(VCVERSION) >= 1400
_VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1
_VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
!endif

!ifndef CFG_ENCODING
CFG_ENCODING	= \"cp1252\"
!endif

################################################################
# 4. Build the nmakehlp program
# This is a helper app we need to overcome nmake's limiting
# environment. We will call out to it to get various bits of
# information about supported compiler options etc.
#
# Tcl itself will always use the nmakehlp.c program which is







<
<
<
<







496
497
498
499
500
501
502




503
504
505
506
507
508
509

# Since MSVC8 we must deal with manifest resources.
!if $(VCVERSION) >= 1400
_VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1
_VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
!endif





################################################################
# 4. Build the nmakehlp program
# This is a helper app we need to overcome nmake's limiting
# environment. We will call out to it to get various bits of
# information about supported compiler options etc.
#
# Tcl itself will always use the nmakehlp.c program which is
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
# lflags - complete linker switches (subsumes ldebug) except subsystem type
# dlllflags - complete linker switches to build DLLs (subsumes lflags)
# conlflags - complete linker switches for console program (subsumes lflags)
# guilflags - complete linker switches for GUI program (subsumes lflags)
# baselibs - minimum Windows libraries required. Parent makefile can
#    define PRJ_LIBS before including rules.rc if additional libs are needed

OPTDEFINES	= /DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) /DSTDC_HEADERS /DUSE_NMAKE=1
!if $(VCVERSION) >= 1600
OPTDEFINES	= $(OPTDEFINES) /DHAVE_STDINT_H=1
!else
OPTDEFINES	= $(OPTDEFINES) /DMP_NO_STDINT=1
!endif
!if $(VCVERSION) >= 1800
OPTDEFINES	= $(OPTDEFINES) /DHAVE_INTTYPES_H=1 /DHAVE_STDBOOL_H=1







|







1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
# lflags - complete linker switches (subsumes ldebug) except subsystem type
# dlllflags - complete linker switches to build DLLs (subsumes lflags)
# conlflags - complete linker switches for console program (subsumes lflags)
# guilflags - complete linker switches for GUI program (subsumes lflags)
# baselibs - minimum Windows libraries required. Parent makefile can
#    define PRJ_LIBS before including rules.rc if additional libs are needed

OPTDEFINES	= /DSTDC_HEADERS /DUSE_NMAKE=1
!if $(VCVERSION) >= 1600
OPTDEFINES	= $(OPTDEFINES) /DHAVE_STDINT_H=1
!else
OPTDEFINES	= $(OPTDEFINES) /DMP_NO_STDINT=1
!endif
!if $(VCVERSION) >= 1800
OPTDEFINES	= $(OPTDEFINES) /DHAVE_INTTYPES_H=1 /DHAVE_STDBOOL_H=1