MkExceptionC_atl.c

Go to the documentation of this file.

 
/* LABEL-NO */
 
#define   META_FILE_NAME          "MkExceptionC_atl.c"
 
#include  "LibMkKernel_private_atl.h"
#include  "mk_check_atl.h"
 
/* LABEL-END */
 
//
// *********************************************************************************
//
 
 
void MK(MkExceptionC_Raise) (
  OT_Prefix_ARGS
  MK_MNGN const expobj,
  MK_STRN const doc,
  MK_STRN const callfunc,
  MK_I32        callline
)
{ 
  static MkThreadLocal bool in_duty = false; 
  static MkThreadLocal MK_ERR newerr = NULL;
  // Stop the 'raise' recursion
  if (in_duty) {
    Tcl_SetResult(interp, "WARNING: detect recursion on 'MkExceptionC_Raise'", TCL_VOLATILE);
    MkLogV_2(MK_ERROR_PRINT, "%s\n", Tcl_GetStringResult(interp));
    in_duty = false;
    return;
  }
  MK_ERR err = MkErrorFORMAT_1M(expobj);
  MkErrorStackFormat(err,doc,callfunc,callline);
  int lvl = 0;
  while (MK(Get_Call_Stack)(OT_MK_CALL err, lvl)) lvl--;
 
  if (newerr) MkRefDecr_X(newerr);
 
  newerr = MkErrCheck(expobj) && expobj != err ? (MK_ERR)expobj : MkErrorDup(err);
  MkRefIncr_1X(newerr);
 
  in_duty = true;
  OT_OBJ_T tclErrObj = NS(MkErrorC_ObjNew) (OT_MK_CALL newerr);
  in_duty = false;
 
  if (tclErrObj == NULL) {
    Tcl_SetResult(interp, "WARNING: failed to create an error-object", TCL_STATIC);
    Tcl_SetErrorCode(interp, "ATL", "ERROR", "CREATE", NULL);
    MkLogV_2(MK_ERROR_PRINT, "%s\n", Tcl_GetStringResult(interp));
    return;
  }
 
//printV("err=%p, object=%s\n", err, OT_LNG_NAME_FROM_OBJ(tclErrObj))
 
  OT_OBJ_T lst = Tcl_NewObj();
  check_LNG(Tcl_ListObjAppendElement(interp,lst,amkrt->MkExceptionC)) goto error;
  check_LNG(Tcl_ListObjAppendElement(interp,lst,tclErrObj)) goto error;
  Tcl_SetObjErrorCode(interp,lst);
  Tcl_SetVar2Ex(interp,"errorCode",NULL,lst,TCL_GLOBAL_ONLY);
  Tcl_SetResult(interp, (MK_STR) MkErrorGetText_0E(), TCL_VOLATILE);
 
  MkErrorReset_1(err);
error:
  return;
}
 
MK_ERR MK(MkExceptionC_Catch) (
  OT_Prefix_ARGS
  MK_MNG    const expobj,
  MK_EXP    const exception,
  MK_STRN   const callfunc
) {
  OT_OBJ_T errorCode = (OT_OBJ_T ) exception;
  MK_ERR err = MkErrorFORMAT_1M(expobj);
 
  if (interp==NULL) interp = amkrt->interp;
  OT_OBJ_T item;
  if (errorCode == NULL) {
    errorCode = Tcl_GetVar2Ex (interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
  }
 
//printLngObj(errorCode);
  
  //Tcl_Eval(interp,"::atlmkkernel::MkErrorC::ProcessStack xxx");
//printLngObj(Tcl_GetReturnOptions(interp,TCL_ERROR));
 
  if (
    errorCode == NULL ||                                            // "errorCode" not set
    Tcl_ListObjIndex (NULL, errorCode, 0, &item) == TCL_ERROR  ||   // index "0" is not in the list "code"
    strcmp (Tcl_GetString (item), "MkExceptionC") != 0              // error is not from "MkExceptionC"
  ) {
    // tcl error
    MK_STRN errorInfo = Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY);
    if (errorInfo == NULL) errorInfo = "unspecified error...";
    MkErrorSetC(err,errorInfo,callfunc,-1);
  } else {
    // atlmkkernel error
    if (Tcl_ListObjIndex (NULL, errorCode, 1, &item) == TCL_ERROR) {
      MkErrorSetV(err, callfunc, -1, "internal error: 'errorCode' return: %s", Tcl_GetStringResult(interp));
      goto end;
    }
 
    MK_OBJ obj = NULL;
    MkTestClassE flag;
    if (OT_LNG_OBJECT_IS_3 (item, &obj, &flag)) {
      switch (flag) {
        case MkTestClassE_OK                : break;
        case MkTestClassE_NULL              : break;
        case MkTestClassE_INVALID_SIGNATURE : {
          MkErrorSetV (err, callfunc, -1, "internal error: '%s' has no 'MkObjectC' type", VAL2STR(item));
          goto end;
        }
        default: {
          MkErrorSetV (err, callfunc, -1, "internal error: 'MkTestObject' return WRONG num '%d'", flag);
          goto end;
        }
      }
    } else {
      MkErrorSetV (err, callfunc, -1, "internal error: '%s' has no 'Object' type", VAL2STR(item));
      goto end;
    }
 
    MK_ERR newerr = MkErr(obj);
    if (newerr == NULL) {
      MkErrorSetC (err, "internal error: 'errorCode' has no 'MkExceptionC' type", callfunc, -1);
      goto end;
    }
    // the "ret = ..." is required because of send-1-4a-B-
    MkErrorSetE(err,newerr);
 
//printV("err=%p, object=%s, ret=%s\n", err, OT_LNG_NAME_FROM_OBJ(item), MkLogErrorE(ret))
 
    // need HARD delete MkErrorC -> indirect hard delete with "MkRefDecr" depends on internal MQ-refcount
    // tclOO does !!NOT!! allow 2 objects with SAME name:
    // error: can't create object "xxx": command already exists with that name
    // tclOO MQ object-name has '::<MkErrorE-0xPTR>' as name -> this mean NO object with SAME PTR is allowed !!
    //OT_OBJECT_DELETE_HARD(VAL2SELF(item));
    //MkRefDecr_X(err);
  }
end:
  Tcl_ResetResult(interp);
  return err;
}
 
//
// *********************************************************************************
//