summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2015-07-01 09:45:04 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2015-07-01 09:45:04 (GMT)
commit11c980f3f2f0b56543c09b737d17e6ddc8257d39 (patch)
treeabfbe9b19662a32a796369b5fadc4e66ee1e5d8b
parent27ce2290a6e107aa7e2b8a5995fa32e32106546c (diff)
downloadtcl-11c980f3f2f0b56543c09b737d17e6ddc8257d39.zip
tcl-11c980f3f2f0b56543c09b737d17e6ddc8257d39.tar.gz
tcl-11c980f3f2f0b56543c09b737d17e6ddc8257d39.tar.bz2
Implementation of TIP #436: Improve TclOO isa Introspection
-rw-r--r--generic/tclOOInfo.c59
1 files changed, 25 insertions, 34 deletions
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index 3217f98..a12208d 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -412,27 +412,25 @@ InfoObjectIsACmd(
return TCL_ERROR;
}
- if (idx == IsObject) {
- int ok = (Tcl_GetObjectFromObj(interp, objv[2]) != NULL);
-
- if (!ok) {
- Tcl_ResetResult(interp);
- }
- Tcl_SetObjResult(interp, Tcl_NewIntObj(ok ? 1 : 0));
- return TCL_OK;
- }
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
if (oPtr == NULL) {
- return TCL_ERROR;
+ goto failPrecondition;
}
switch ((enum IsACats) idx) {
+ case IsObject:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "objName");
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+ return TCL_OK;
case IsClass:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "objName");
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(oPtr->classPtr ? 1 : 0));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(!!oPtr->classPtr));
return TCL_OK;
case IsMetaclass:
if (objc != 3) {
@@ -440,12 +438,12 @@ InfoObjectIsACmd(
return TCL_ERROR;
}
if (oPtr->classPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
} else {
Class *classCls = TclOOGetFoundation(interp)->classCls;
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
- TclOOIsReachable(classCls, oPtr->classPtr) ? 1 : 0));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ TclOOIsReachable(classCls, oPtr->classPtr)));
}
return TCL_OK;
case IsMixin:
@@ -455,24 +453,19 @@ InfoObjectIsACmd(
}
o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
if (o2Ptr == NULL) {
- return TCL_ERROR;
+ goto failPrecondition;
}
- if (o2Ptr->classPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "non-classes cannot be mixins", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "NONCLASS", NULL);
- return TCL_ERROR;
- } else {
+ if (o2Ptr->classPtr != NULL) {
Class *mixinPtr;
FOREACH(mixinPtr, oPtr->mixins) {
if (mixinPtr == o2Ptr->classPtr) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
return TCL_OK;
}
}
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
return TCL_OK;
case IsType:
if (objc != 4) {
@@ -481,24 +474,22 @@ InfoObjectIsACmd(
}
o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
if (o2Ptr == NULL) {
- return TCL_ERROR;
+ goto failPrecondition;
}
if (o2Ptr->classPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "non-classes cannot be types", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "NONCLASS", NULL);
- return TCL_ERROR;
- }
- if (TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls)) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
} else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls)));
}
return TCL_OK;
- case IsObject:
- Tcl_Panic("unexpected fallthrough");
}
return TCL_ERROR;
+
+ failPrecondition:
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ return TCL_OK;
}
/*