12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
# RCS: @(#)
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
test platform-1.1 {TclpSetVariables: tcl_platform} {
interp create i
i eval {catch {unset tcl_platform(debug)}}
i eval {catch {unset tcl_platform(threaded)}}
set result [i eval {lsort [array names tcl_platform]}]
interp delete i
set result
} {byteOrder machine os osVersion platform user wordSize}
# Test assumes twos-complement arithmetic, which is true of virtually
# everything these days. Note that this does *not* use wide(), and
# this is intentional since that could make Tcl's numbers wider than
# the machine-integer on some platforms...
test platform-2.1 {tcl_platform(wordSize) indicates size of native word} {
set result [expr {1 << (8 * $tcl_platform(wordSize) - 1)}]
# Result must be the largest bit in a machine word, which this checks
# without assuming how wide the word really is
list [expr {$result < 0}] [expr {$result ^ ($result - 1)}]
} {1 -1}
# cleanup
::tcltest::cleanupTests
return
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
# RCS: @(#)
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
testConstraint testWinCPUID [llength [info commands testwincpuid]]
test platform-1.1 {TclpSetVariables: tcl_platform} {
interp create i
i eval {catch {unset tcl_platform(debug)}}
i eval {catch {unset tcl_platform(threaded)}}
set result [i eval {lsort [array names tcl_platform]}]
interp delete i
set result
} {byteOrder machine os osVersion platform user wordSize}
# Test assumes twos-complement arithmetic, which is true of virtually
# everything these days. Note that this does *not* use wide(), and
# this is intentional since that could make Tcl's numbers wider than
# the machine-integer on some platforms...
test platform-2.1 {tcl_platform(wordSize) indicates size of native word} {
set result [expr {1 << (8 * $tcl_platform(wordSize) - 1)}]
# Result must be the largest bit in a machine word, which this checks
# without assuming how wide the word really is
list [expr {$result < 0}] [expr {$result ^ ($result - 1)}]
} {1 -1}
# On Windows, test that the CPU ID works
test platform-3.1 {CPU ID on Windows } \
-constraints testWinCPUID \
-body {
set cpudata [testwincpuid 0]
binary format iii \
[lindex $cpudata 1] \
[lindex $cpudata 3] \
[lindex $cpudata 2]
} \
-match regexp \
-result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$}
# cleanup
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
|