108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
int
Tcl_LoadObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
|
>
>
>
>
|
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
void TclPanicWhenFreed(char *ptr) {
Tcl_Panic("This extension still uses interp->result");
}
int
Tcl_LoadObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
|
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
|
/*
* Test for whether the initialization failed. If so, transfer the error
* from the target interpreter to the originating one.
*/
if (code != TCL_OK) {
Interp *iPtr = (Interp *) target;
if (iPtr->legacyResult && !iPtr->legacyFreeProc) {
/*
* A call to Tcl_InitStubs() determined the caller extension and
* this interp are incompatible in their stubs mechanisms, and
* recorded the error in the oldest legacy place we have to do so.
*/
Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1));
iPtr->legacyResult = NULL;
iPtr->legacyFreeProc = (void (*) (void))-1;
}
Tcl_TransferResult(target, code, interp);
goto done;
}
/*
* Record the fact that the package has been loaded in the target
|
|
>
>
>
>
>
>
>
|
|
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
496
497
498
499
|
/*
* Test for whether the initialization failed. If so, transfer the error
* from the target interpreter to the originating one.
*/
if (code != TCL_OK) {
Interp *iPtr = (Interp *) target;
if (iPtr->legacyFreeProc != TclPanicWhenFreed) {
/*
* A call to Tcl_InitStubs() determined the caller extension and
* this interp are incompatible in their stubs mechanisms, and
* recorded the error in the oldest legacy place we have to do so.
*/
Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1));
/* Properly clean up legacyResult according to the legacy rules. */
if (iPtr->legacyFreeProc == TCL_DYNAMIC) {
Tcl_Free((void *)iPtr->legacyResult);
} else if (iPtr->legacyFreeProc != TCL_STATIC) {
iPtr->legacyFreeProc((void *)iPtr->legacyResult);
}
iPtr->legacyResult = NULL;
iPtr->legacyFreeProc = TclPanicWhenFreed;
}
Tcl_TransferResult(target, code, interp);
goto done;
}
/*
* Record the fact that the package has been loaded in the target
|