summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2015-07-01 09:58:42 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2015-07-01 09:58:42 (GMT)
commitd73743625ca06bbbd8c8b013a31a9ffffce40bd1 (patch)
tree85ba2e76630705a3ca3f7859526113889908fc17 /generic
parent11c980f3f2f0b56543c09b737d17e6ddc8257d39 (diff)
downloadtcl-d73743625ca06bbbd8c8b013a31a9ffffce40bd1.zip
tcl-d73743625ca06bbbd8c8b013a31a9ffffce40bd1.tar.gz
tcl-d73743625ca06bbbd8c8b013a31a9ffffce40bd1.tar.bz2
Say what is meant more clearly, put syntax checks before semantic checks.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclOOInfo.c85
1 files changed, 43 insertions, 42 deletions
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index a12208d..0c22bcf 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -401,7 +401,7 @@ InfoObjectIsACmd(
IsClass, IsMetaclass, IsMixin, IsObject, IsType
};
Object *oPtr, *o2Ptr;
- int idx, i;
+ int idx, i, result = 0;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "category objName ?arg ...?");
@@ -412,45 +412,53 @@ InfoObjectIsACmd(
return TCL_ERROR;
}
- oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
- if (oPtr == NULL) {
- goto failPrecondition;
- }
+ /*
+ * Now we know what test we are doing, we can check we've got the right
+ * number of arguments.
+ */
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_NewBooleanObj(!!oPtr->classPtr));
- return TCL_OK;
case IsMetaclass:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "objName");
return TCL_ERROR;
}
- if (oPtr->classPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
- } else {
- Class *classCls = TclOOGetFoundation(interp)->classCls;
-
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
- TclOOIsReachable(classCls, oPtr->classPtr)));
- }
- return TCL_OK;
+ break;
case IsMixin:
+ case IsType:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "objName className");
return TCL_ERROR;
}
+ break;
+ }
+
+ /*
+ * Perform the check. Note that we can guarantee that we will not fail
+ * from here on; "failures" result in a false-TCL_OK result.
+ */
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+ if (oPtr == NULL) {
+ goto failPrecondition;
+ }
+
+ switch ((enum IsACats) idx) {
+ case IsObject:
+ result = 1;
+ break;
+ case IsClass:
+ result = (oPtr->classPtr != NULL);
+ break;
+ case IsMetaclass:
+ if (oPtr->classPtr != NULL) {
+ result = TclOOIsReachable(TclOOGetFoundation(interp)->classCls,
+ oPtr->classPtr);
+ }
+ break;
+ case IsMixin:
o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
if (o2Ptr == NULL) {
goto failPrecondition;
@@ -459,32 +467,25 @@ InfoObjectIsACmd(
Class *mixinPtr;
FOREACH(mixinPtr, oPtr->mixins) {
- if (mixinPtr == o2Ptr->classPtr) {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
- return TCL_OK;
+ if (TclOOIsReachable(o2Ptr->classPtr, mixinPtr)) {
+ result = 1;
+ break;
}
}
}
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
- return TCL_OK;
+ break;
case IsType:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "objName className");
- return TCL_ERROR;
- }
o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
if (o2Ptr == NULL) {
goto failPrecondition;
}
- if (o2Ptr->classPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
- } else {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
- TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls)));
+ if (o2Ptr->classPtr != NULL) {
+ result = TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls);
}
- return TCL_OK;
+ break;
}
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
+ return TCL_OK;
failPrecondition:
Tcl_ResetResult(interp);