summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2012-05-03 13:10:09 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2012-05-03 13:10:09 (GMT)
commitf693213b4dade6f73baf86ae13b2129be2ed0ad1 (patch)
tree8a428c23c89df13b9d208f9c8b7194e6a8a331de /generic/tclTest.c
parent73dd8c4da919ada224a43fccf582ae5eb5d05d86 (diff)
parentb9ecc426358d3737357f0460caee4eae5be61a3a (diff)
downloadtcl-f693213b4dade6f73baf86ae13b2129be2ed0ad1.zip
tcl-f693213b4dade6f73baf86ae13b2129be2ed0ad1.tar.gz
tcl-f693213b4dade6f73baf86ae13b2129be2ed0ad1.tar.bz2
Move cpuid testcase from win-specific to generic tests
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c59
1 files changed, 59 insertions, 0 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 7631dee..b4c5bb9 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -419,6 +419,9 @@ static int TestNRELevels(ClientData clientData,
static int TestInterpResolverCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+static int TestcpuidCmd(ClientData dummy,
+ Tcl_Interp* interp, int objc,
+ Tcl_Obj *CONST objv[]);
static const Tcl_Filesystem testReportingFilesystem = {
"reporting",
@@ -676,6 +679,8 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
+ (ClientData) 0, NULL);
t3ArgTypes[0] = TCL_EITHER;
t3ArgTypes[1] = TCL_EITHER;
Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
@@ -6648,6 +6653,60 @@ TestNumUtfCharsCmd(
}
return TCL_OK;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestcpuidCmd --
+ *
+ * Retrieves CPU ID information.
+ *
+ * Usage:
+ * testwincpuid <eax>
+ *
+ * Parameters:
+ * eax - The value to pass in the EAX register to a CPUID instruction.
+ *
+ * Results:
+ * Returns a four-element list containing the values from the EAX, EBX,
+ * ECX and EDX registers returned from the CPUID instruction.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestcpuidCmd(
+ ClientData dummy,
+ Tcl_Interp* interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const * objv) /* Parameter vector */
+{
+ int status, index, i;
+ unsigned int regs[4];
+ Tcl_Obj *regsObjs[4];
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "eax");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ status = TclWinCPUID((unsigned) index, regs);
+ if (status != TCL_OK) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("operation not available", -1));
+ return status;
+ }
+ for (i=0 ; i<4 ; ++i) {
+ regsObjs[i] = Tcl_NewIntObj((int) regs[i]);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
+ return TCL_OK;
+}
/*
* Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag