Tcl Source Code

Check-in [a8a42c2118]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Fix test-cases running on Windows 10: [string index $tcl_platform(osVersion) 0] doesn't give the correct answer then (it gives "1", but "10" was expected)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA3-256: a8a42c211816cb0ca813d6deec91135ac98595f9b72413cb37e71072884833ef
User & Date: jan.nijtmans 2018-10-17 19:51:47
Context
2018-10-23
11:14
Enable CI builds with Travis. check-in: 0386db909a user: dkf tags: core-8-5-branch
2018-10-17
19:55
Fix test-cases running on Windows 10: [string index $tcl_platform(osVersion) 0] doesn't give the co... check-in: 5fbb107638 user: jan.nijtmans tags: core-8-6-branch
19:51
Fix test-cases running on Windows 10: [string index $tcl_platform(osVersion) 0] doesn't give the c... check-in: a8a42c2118 user: jan.nijtmans tags: core-8-5-branch
2018-08-30
11:08
test-cases to cover quoting of the newline character, and the documentation extended. check-in: 707127bd2d user: sebres tags: core-8-5-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/cmdAH.test.

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
}

testConstraint testchmod       [llength [info commands testchmod]]
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testvolumetype  [llength [info commands testvolumetype]]
testConstraint linkDirectory [expr {
    ![testConstraint win] ||
    ([string index $tcl_platform(osVersion) 0] >= 5
     && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
}]

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







|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
}

testConstraint testchmod       [llength [info commands testchmod]]
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testvolumetype  [llength [info commands testvolumetype]]
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]}

Changes to tests/fCmd.test.

46
47
48
49
50
51
52
53
54
55

56
57
58
59
60
61
62
63
64
65

66
67
68

69
70
71
72
73
74
75
....
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
    if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} {
	testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]
    }
}

# Also used in winFCmd...
if {[testConstraint winOnly]} {
    set major [string index $tcl_platform(osVersion) 0]
    if {[testConstraint nt] && $major > 4} {
        if {$major > 5} {

            testConstraint winVista 1
        } elseif {$major == 5} {
            testConstraint win2000orXP 1
        }
    } else {
        testConstraint winOlderThan2000 1
    }
}

testConstraint darwin9 [expr {[testConstraint unix] &&

	$tcl_platform(os) eq "Darwin" &&
	int([string range $tcl_platform(osVersion) 0 \
	[string first . $tcl_platform(osVersion)]]) >= 9}]

testConstraint notDarwin9 [expr {![testConstraint darwin9]}]

testConstraint fileSharing 0
testConstraint notFileSharing 1
testConstraint linkFile 1
testConstraint linkDirectory 1

................................................................................
    file attributes foo.tmp {*}[lrange $attrs 0 3]
} -cleanup {
    file delete -force -- foo.tmp
} -result {}

if {
    [testConstraint win] &&
    ([string index $tcl_platform(osVersion) 0] < 5
     || [lindex [file system [temporaryDirectory]] 1] ne "NTFS")
} then {
    testConstraint linkDirectory 0
    testConstraint linkFile 0
}

test fCmd-28.1 {file link} -returnCodes error -body {






<
|
<
>

|







|
>
|
|
<
>







 







|







46
47
48
49
50
51
52

53

54
55
56
57
58
59
60
61
62
63
64
65
66
67

68
69
70
71
72
73
74
75
....
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
    if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} {
	testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]
    }
}

# Also used in winFCmd...
if {[testConstraint winOnly]} {

    if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {

        if {$::tcl_platform(osVersion) >= 6.0} {
            testConstraint winVista 1
        } else {
            testConstraint win2000orXP 1
        }
    } else {
        testConstraint winOlderThan2000 1
    }
}

testConstraint darwin9 [expr {
    [testConstraint unix]
    && $tcl_platform(os) eq "Darwin"
    && [package vsatisfies 1.$::tcl_platform(osVersion) 1.9]

}]
testConstraint notDarwin9 [expr {![testConstraint darwin9]}]

testConstraint fileSharing 0
testConstraint notFileSharing 1
testConstraint linkFile 1
testConstraint linkDirectory 1

................................................................................
    file attributes foo.tmp {*}[lrange $attrs 0 3]
} -cleanup {
    file delete -force -- foo.tmp
} -result {}

if {
    [testConstraint win] &&
    ($::tcl_platform(osVersion) < 5.0
     || [lindex [file system [temporaryDirectory]] 1] ne "NTFS")
} then {
    testConstraint linkDirectory 0
    testConstraint linkFile 0
}

test fCmd-28.1 {file link} -returnCodes error -body {

Changes to tests/fileName.test.

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
}

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testtranslatefilename [llength [info commands testtranslatefilename]]
testConstraint linkDirectory 1
testConstraint symbolicLinkFile 1
if {[testConstraint win]} {
    if {[string index $tcl_platform(osVersion) 0] < 5 \
	    || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
	testConstraint linkDirectory 0
    }
    testConstraint symbolicLinkFile 0
}

global env






|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
}

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testtranslatefilename [llength [info commands testtranslatefilename]]
testConstraint linkDirectory 1
testConstraint symbolicLinkFile 1
if {[testConstraint win]} {
    if {$::tcl_platform(osVersion) < 5.0 \
	    || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
	testConstraint linkDirectory 0
    }
    testConstraint symbolicLinkFile 0
}

global env

Changes to tests/winFCmd.test.

49
50
51
52
53
54
55
56
57
58
59

60
61
62
63
64
65
66
	if {$x != ""} {
	    catch {file delete -force -- {*}$x}
	}
    }
}

if {[testConstraint win]} {
    set major [string index $tcl_platform(osVersion) 0]
    if {$major > 5} {
	testConstraint winVista 1
    } elseif {$major == 5} {

	testConstraint winXP 1
    }
}

# find a CD-ROM so we can test read-only filesystems.

proc findfile {dir} {






|
<

<
>







49
50
51
52
53
54
55
56

57

58
59
60
61
62
63
64
65
	if {$x != ""} {
	    catch {file delete -force -- {*}$x}
	}
    }
}

if {[testConstraint win]} {
    if {$::tcl_platform(osVersion) >= 5.0} {

	testConstraint winVista 1

    } elseif {$::tcl_platform(osVersion) >= 4.0} {
	testConstraint winXP 1
    }
}

# find a CD-ROM so we can test read-only filesystems.

proc findfile {dir} {