1 | # The file tests the tcl_platform variable |
---|
2 | # |
---|
3 | # This file contains a collection of tests for one or more of the Tcl |
---|
4 | # built-in commands. Sourcing this file into Tcl runs the tests and |
---|
5 | # generates output for errors. No output means no errors were found. |
---|
6 | # |
---|
7 | # Copyright (c) 1999 by Scriptics Corporation |
---|
8 | # |
---|
9 | # See the file "license.terms" for information on usage and redistribution |
---|
10 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
11 | # |
---|
12 | # RCS: @(#) |
---|
13 | |
---|
14 | if {[lsearch [namespace children] ::tcltest] == -1} { |
---|
15 | package require tcltest |
---|
16 | namespace import -force ::tcltest::* |
---|
17 | } |
---|
18 | |
---|
19 | testConstraint testWinCPUID [llength [info commands testwincpuid]] |
---|
20 | |
---|
21 | test platform-1.1 {TclpSetVariables: tcl_platform} { |
---|
22 | interp create i |
---|
23 | i eval {catch {unset tcl_platform(debug)}} |
---|
24 | i eval {catch {unset tcl_platform(threaded)}} |
---|
25 | set result [i eval {lsort [array names tcl_platform]}] |
---|
26 | interp delete i |
---|
27 | set result |
---|
28 | } {byteOrder machine os osVersion platform pointerSize user wordSize} |
---|
29 | |
---|
30 | # Test assumes twos-complement arithmetic, which is true of virtually |
---|
31 | # everything these days. Note that this does *not* use wide(), and |
---|
32 | # this is intentional since that could make Tcl's numbers wider than |
---|
33 | # the machine-integer on some platforms... |
---|
34 | test platform-2.1 {tcl_platform(wordSize) indicates size of native word} { |
---|
35 | set result [expr {int(1 << (8 * $tcl_platform(wordSize) - 1))}] |
---|
36 | # Result must be the largest bit in a machine word, which this checks |
---|
37 | # without assuming how wide the word really is |
---|
38 | list [expr {$result < 0}] [expr {$result ^ int($result - 1)}] |
---|
39 | } {1 -1} |
---|
40 | |
---|
41 | # On Windows, test that the CPU ID works |
---|
42 | |
---|
43 | test platform-3.1 {CPU ID on Windows } \ |
---|
44 | -constraints testWinCPUID \ |
---|
45 | -body { |
---|
46 | set cpudata [testwincpuid 0] |
---|
47 | binary format iii \ |
---|
48 | [lindex $cpudata 1] \ |
---|
49 | [lindex $cpudata 3] \ |
---|
50 | [lindex $cpudata 2] |
---|
51 | } \ |
---|
52 | -match regexp \ |
---|
53 | -result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$} |
---|
54 | |
---|
55 | # cleanup |
---|
56 | ::tcltest::cleanupTests |
---|
57 | return |
---|
58 | |
---|
59 | # Local Variables: |
---|
60 | # mode: tcl |
---|
61 | # End: |
---|