Diff
Not logged in

Differences From Artifact [809519fa0c]:

To Artifact [d62a7b62aa]:


183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
    TclGetNamespaceForQualName(interp, procName, NULL, 0,
	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);

    if (nsPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create procedure \"%s\": unknown namespace",
		procName));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL);
	return TCL_ERROR;
    }
    if (simpleName == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create procedure \"%s\": bad procedure name",
		procName));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Create the data structure to represent the procedure.
     */








|






|







183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
    TclGetNamespaceForQualName(interp, procName, NULL, 0,
	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);

    if (nsPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create procedure \"%s\": unknown namespace",
		procName));
	TclSetErrorCode(interp, "TCL", "VALUE", "COMMAND");
	return TCL_ERROR;
    }
    if (simpleName == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create procedure \"%s\": bad procedure name",
		procName));
	TclSetErrorCode(interp, "TCL", "VALUE", "COMMAND");
	return TCL_ERROR;
    }

    /*
     * Create the data structure to represent the procedure.
     */

690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
    }
    if (errorCode) {
	if (errorCode == TOOMANYARGS) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "procedure \"%s\": arg list contains too many (%"
		    TCL_SIZE_MODIFIER "d) entries", procName, numArgs));
	}
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		errorCode, (char *)NULL);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *







|
<







690
691
692
693
694
695
696
697

698
699
700
701
702
703
704
    }
    if (errorCode) {
	if (errorCode == TOOMANYARGS) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "procedure \"%s\": arg list contains too many (%"
		    TCL_SIZE_MODIFIER "d) entries", procName, numArgs));
	}
	TclSetErrorCode(interp, "TCL", "OPERATION", "PROC", errorCode);

    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
	}
    }
badLevel:
    if (name == NULL) {
	name = objPtr ? TclGetString(objPtr) : "1" ;
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, (char *)NULL);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UplevelObjCmd --







|







863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
	}
    }
badLevel:
    if (name == NULL) {
	name = objPtr ? TclGetString(objPtr) : "1" ;
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
    TclSetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UplevelObjCmd --
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130

	for (i=1 ; i<=numArgs ; i++, defPtr++) {
	    Tcl_Obj *argObj;
	    Tcl_Obj *namePtr = localName(framePtr, i-1);

	    if (defPtr->value.objPtr != NULL) {
		TclNewObj(argObj);
		Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?",
			(char *)NULL);
	    } else if (defPtr->flags & VAR_IS_ARGS) {
		numArgs--;
		final = "?arg ...?";
		break;
	    } else {
		argObj = namePtr;
		Tcl_IncrRefCount(namePtr);







|
<







1114
1115
1116
1117
1118
1119
1120
1121

1122
1123
1124
1125
1126
1127
1128

	for (i=1 ; i<=numArgs ; i++, defPtr++) {
	    Tcl_Obj *argObj;
	    Tcl_Obj *namePtr = localName(framePtr, i-1);

	    if (defPtr->value.objPtr != NULL) {
		TclNewObj(argObj);
		TclAppendStringsToObj(argObj, "?", TclGetString(namePtr), "?");

	    } else if (defPtr->flags & VAR_IS_ARGS) {
		numArgs--;
		final = "?arg ...?";
		break;
	    } else {
		argObj = namePtr;
		Tcl_IncrRefCount(namePtr);
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
	 * It's an error to get to this point from a 'break' or 'continue', so
	 * transform to an error now.
	 */

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invoked \"%s\" outside of a loop",
		((result == TCL_BREAK) ? "break" : "continue")));
	Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", (char *)NULL);
	result = TCL_ERROR;
	TCL_FALLTHROUGH();

    case TCL_ERROR:
	/*
	 * Now it _must_ be an error, so we need to log it as such. This means
	 * filling out the error trace. Luckily, we just hand this off to the







|







1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
	 * It's an error to get to this point from a 'break' or 'continue', so
	 * transform to an error now.
	 */

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invoked \"%s\" outside of a loop",
		((result == TCL_BREAK) ? "break" : "continue")));
	TclSetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED");
	result = TCL_ERROR;
	TCL_FALLTHROUGH();

    case TCL_ERROR:
	/*
	 * Now it _must_ be an error, so we need to log it as such. This means
	 * filling out the error trace. Luckily, we just hand this off to the
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
	    return TCL_OK;
	}

	if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
	    if ((Interp *) *codePtr->interpHandle != iPtr) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"a precompiled script jumped interps", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"CROSSINTERPBYTECODE", (char *)NULL);
		return TCL_ERROR;
	    }
	    codePtr->compileEpoch = iPtr->compileEpoch;
	    codePtr->nsPtr = nsPtr;
	} else {
	    Tcl_StoreInternalRep(bodyPtr, &tclByteCodeType, NULL);
	    codePtr = NULL;







|
|







1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
	    return TCL_OK;
	}

	if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
	    if ((Interp *) *codePtr->interpHandle != iPtr) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"a precompiled script jumped interps", -1));
		TclSetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"CROSSINTERPBYTECODE");
		return TCL_ERROR;
	    }
	    codePtr->compileEpoch = iPtr->compileEpoch;
	    codePtr->nsPtr = nsPtr;
	} else {
	    Tcl_StoreInternalRep(bodyPtr, &tclByteCodeType, NULL);
	    codePtr = NULL;
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
	     * to compile.
	     */

	    Tcl_Obj *message;

	    TclNewLiteralStringObj(message, "Compiling ");
	    Tcl_IncrRefCount(message);
	    Tcl_AppendStringsToObj(message, description, " \"", (char *)NULL);
	    Tcl_AppendLimitedToObj(message, procName, TCL_INDEX_NONE, 50, NULL);
	    fprintf(stdout, "%s\"\n", TclGetString(message));
	    Tcl_DecrRefCount(message);
	}
#else
    (void)description;
    (void)procName;







|







1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
	     * to compile.
	     */

	    Tcl_Obj *message;

	    TclNewLiteralStringObj(message, "Compiling ");
	    Tcl_IncrRefCount(message);
	    TclAppendStringsToObj(message, description, " \"");
	    Tcl_AppendLimitedToObj(message, procName, TCL_INDEX_NONE, 50, NULL);
	    fprintf(stdout, "%s\"\n", TclGetString(message));
	    Tcl_DecrRefCount(message);
	}
#else
    (void)description;
    (void)procName;
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
     */

    result = TclListObjLength(NULL, objPtr, &objc);
    if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't interpret \"%s\" as a lambda expression",
		Tcl_GetString(objPtr)));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (char *)NULL);
	return TCL_ERROR;
    }
    result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
    if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't interpret \"%s\" as a lambda expression",
		TclGetString(objPtr)));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (char *)NULL);
	return TCL_ERROR;
    }

    argsPtr = objv[0];
    bodyPtr = objv[1];

    /*







|







|







2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
     */

    result = TclListObjLength(NULL, objPtr, &objc);
    if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't interpret \"%s\" as a lambda expression",
		Tcl_GetString(objPtr)));
	TclSetErrorCode(interp, "TCL", "VALUE", "LAMBDA");
	return TCL_ERROR;
    }
    result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
    if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't interpret \"%s\" as a lambda expression",
		TclGetString(objPtr)));
	TclSetErrorCode(interp, "TCL", "VALUE", "LAMBDA");
	return TCL_ERROR;
    }

    argsPtr = objv[0];
    bodyPtr = objv[1];

    /*
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
	Tcl_Free(localPtr);
    }
    Tcl_Free(newProc);
    // Complain about the failure to allocate.
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "procedure \"%s\": arg list contains too many (%"
	    TCL_SIZE_MODIFIER "d) entries", cmdName, origProc->numArgs));
    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
	    TOOMANYARGS, (char *)NULL);
    return TCL_ERROR;
}

// Duplicate all the procedures in a namespace into another (new) namespace.
int
TclCopyNamespaceProcedures(
    Tcl_Interp *interp,







|
<







2978
2979
2980
2981
2982
2983
2984
2985

2986
2987
2988
2989
2990
2991
2992
	Tcl_Free(localPtr);
    }
    Tcl_Free(newProc);
    // Complain about the failure to allocate.
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "procedure \"%s\": arg list contains too many (%"
	    TCL_SIZE_MODIFIER "d) entries", cmdName, origProc->numArgs));
    TclSetErrorCode(interp, "TCL", "OPERATION", "PROC", TOOMANYARGS);

    return TCL_ERROR;
}

// Duplicate all the procedures in a namespace into another (new) namespace.
int
TclCopyNamespaceProcedures(
    Tcl_Interp *interp,