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