1 files changed, 69 insertions, 0 deletions
diff --git a/tests/platform.test b/tests/platform.test
new file mode 100644
index 0000000..6596975
--- /dev/null
+++ b/tests/platform.test
@@ -0,0 +1,69 @@
+# 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.
+
+package require tcltest 2
+
+namespace eval ::tcl::test::platform {
+    namespace import ::tcltest::testConstraint
+    namespace import ::tcltest::test
+    namespace import ::tcltest::cleanupTests
+
+    variable ::tcl_platform
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testCPUID [llength [info commands testcpuid]]
+
+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 pathSeparator platform pointerSize 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 {int(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 ^ int($result - 1)}]
+} {1 -1}
+
+# On Windows/UNIX, test that the CPU ID works
+
+test platform-3.1 {CPU ID on Windows/UNIX} \
+    -constraints testCPUID \
+    -body {		
+	set cpudata [testcpuid 0]
+	binary format iii \
+	    [lindex $cpudata 1] \
+	    [lindex $cpudata 3] \
+	    [lindex $cpudata 2] 
+    } \
+    -match regexp \
+    -result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$}
+
+# cleanup
+cleanupTests
+
+}
+namespace delete ::tcl::test::platform
+return
+
+# Local Variables:
+# mode: tcl
+# End: