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