summaryrefslogtreecommitdiffstats
path: root/tests/platform.test
blob: ce72211f075585e07f0b5d5d0025ea149a2d8996 (plain)
1
2
3
4
5
6
7
8
9
10
11
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
62
63
# The file tests the tcl_platform variable
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 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.
#
# 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)}}
    i eval {catch {unset tcl_platform(tip,268)}}
    i eval {catch {unset tcl_platform(tip,280)}}
    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: