1# The file tests the tcl_platform variable and platform package.
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 © 1999 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
12package require tcltest 2.5
13
14namespace eval ::tcl::test::platform {
15    namespace import ::tcltest::testConstraint
16    namespace import ::tcltest::test
17    namespace import ::tcltest::cleanupTests
18
19    # This is not how [variable] works. See TIP 276.
20    #variable ::tcl_platform
21    namespace upvar :: tcl_platform tcl_platform
22
23::tcltest::loadTestedCommands
24catch [list package require -exact tcl::test [info patchlevel]]
25package require tcltests
26
27testConstraint testCPUID [llength [info commands testcpuid]]
28testConstraint testlongsize [llength [info commands testlongsize]]
29
30test platform-1.0 {tcl_platform(engine)} {
31  set tcl_platform(engine)
32} {Tcl}
33
34test platform-1.1 {TclpSetVariables: tcl_platform} {
35    interp create i
36    i eval {catch {unset tcl_platform(debug)}}
37    i eval {catch {unset tcl_platform(threaded)}}
38    set result [i eval {lsort [array names tcl_platform]}]
39    interp delete i
40    set result
41} {byteOrder engine machine os osVersion pathSeparator platform pointerSize user wordSize}
42
43test platform-2.1 {tcl_platform(wordSize) indicates size of native word} testlongsize {
44    expr {$tcl_platform(wordSize) == [testlongsize]}
45} {1}
46
47# On Windows/UNIX, test that the CPU ID works
48
49test platform-3.1 {CPU ID on Windows/UNIX} \
50    -constraints testCPUID \
51    -body {
52	set cpudata [testcpuid 0]
53	binary format iii \
54	    [lindex $cpudata 1] \
55	    [lindex $cpudata 3] \
56	    [lindex $cpudata 2]
57    } \
58    -match regexp \
59    -result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$}
60
61# The platform package makes very few promises, but does promise that the
62# format of string it produces consists of two non-empty words separated by a
63# hyphen.
64package require platform
65test platform-4.1 {format of platform::identify result} -constraints notValgrind -match regexp -body {
66    # [identify] may attempt to [exec] dpkg-architecture, which may not exist,
67    # in which case fork will not be followed by exec, and valgrind will issue
68    # "still reachable" reports.
69    platform::identify
70} -result {^([^-]+-)+[^-]+$}
71test platform-4.2 {format of platform::generic result} -match regexp -body {
72    platform::generic
73} -result {^([^-]+-)+[^-]+$}
74
75# cleanup
76cleanupTests
77
78}
79namespace delete ::tcl::test::platform
80return
81
82# Local Variables:
83# mode: tcl
84# End:
85