397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
|
static const char *const categories[] = {
"class", "metaclass", "mixin", "object", "typeof", NULL
};
enum IsACats {
IsClass, IsMetaclass, IsMixin, IsObject, IsType
};
Object *oPtr, *o2Ptr;
int idx, i;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "category objName ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], categories, "category", 0,
&idx) != TCL_OK) {
return TCL_ERROR;
}
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
if (oPtr == NULL) {
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;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "objName");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(!!oPtr->classPtr));
return TCL_OK;
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;
case IsMixin:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "objName className");
return TCL_ERROR;
}
if (mixinPtr == o2Ptr->classPtr) {
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
return TCL_OK;
}
}
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
return TCL_OK;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "objName className");
return TCL_ERROR;
}
if (o2Ptr->classPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
} else {
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls)));
}
return TCL_OK;
}
return TCL_ERROR;
failPrecondition:
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
return TCL_OK;
}
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
<
<
<
<
|
|
<
<
<
<
|
|
<
<
<
<
|
<
<
|
<
<
|
|
<
<
<
<
|
|
|
<
|
<
<
<
<
|
<
<
<
|
|
>
|
|
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
|
static const char *const categories[] = {
"class", "metaclass", "mixin", "object", "typeof", NULL
};
enum IsACats {
IsClass, IsMetaclass, IsMixin, IsObject, IsType
};
Object *oPtr, *o2Ptr;
int idx, i, result = 0;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "category objName ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], categories, "category", 0,
&idx) != TCL_OK) {
return TCL_ERROR;
}
/*
* 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:
case IsClass:
case IsMetaclass:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "objName");
return TCL_ERROR;
}
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;
}
if (o2Ptr->classPtr != NULL) {
Class *mixinPtr;
FOREACH(mixinPtr, oPtr->mixins) {
if (TclOOIsReachable(o2Ptr->classPtr, mixinPtr)) {
result = 1;
break;
}
}
}
break;
case IsType:
o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
if (o2Ptr == NULL) {
goto failPrecondition;
}
if (o2Ptr->classPtr != NULL) {
result = TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls);
}
break;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
return TCL_OK;
failPrecondition:
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
return TCL_OK;
}
|