summaryrefslogtreecommitdiffstats
path: root/generic/tclProc.c
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2006-02-01 20:17:27 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2006-02-01 20:17:27 (GMT)
commit7c8477dc94e07b3d0bf87a4e81902b5dd52ebd5b (patch)
treeb551123e6dddf2303ed0013b4c2125be088b4ae9 /generic/tclProc.c
parentfe312f9881e59765486f5f1d6314a5f1e0050875 (diff)
downloadtcl-7c8477dc94e07b3d0bf87a4e81902b5dd52ebd5b.zip
tcl-7c8477dc94e07b3d0bf87a4e81902b5dd52ebd5b.tar.gz
tcl-7c8477dc94e07b3d0bf87a4e81902b5dd52ebd5b.tar.bz2
* generic/tclProc.c: minor improvements to [apply]
* tests/apply.test: new tests; apply-5.1 currently fails to indicate missing work in error reporting
Diffstat (limited to 'generic/tclProc.c')
-rw-r--r--generic/tclProc.c54
1 files changed, 27 insertions, 27 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c
index c2dab7e..438fa5e 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclProc.c,v 1.85 2006/02/01 19:26:02 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.86 2006/02/01 20:17:28 msofer Exp $
*/
#include "tclInt.h"
@@ -1893,15 +1893,15 @@ TclCompileNoOp(
*
*/
-static void DupLambdaInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
- Tcl_Obj *copyPtr));
-static void FreeLambdaInternalRep _ANSI_ARGS_((
- Tcl_Obj *objPtr));
-static int SetLambdaFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
+static void DupLambdaInternalRep(Tcl_Obj *objPtr,
+ Tcl_Obj *copyPtr);
+static void FreeLambdaInternalRep(
+ Tcl_Obj *objPtr);
+static int SetLambdaFromAny(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
Tcl_ObjType lambdaType = {
- "lambda", /* name */
+ "lambdaExpr", /* name */
FreeLambdaInternalRep, /* freeIntRepProc */
DupLambdaInternalRep, /* dupIntRepProc */
(Tcl_UpdateStringProc *) NULL, /* updateStringProc */
@@ -1909,7 +1909,7 @@ Tcl_ObjType lambdaType = {
};
/*
- * a Lambda Tcl_Obj has the form
+ * a lambdaType Tcl_Obj has the form
*
* ptr1 is a *Proc: pointer to a proc structure
* ptr2 is a *Tcl_Obj: the lambda's namespace
@@ -1967,11 +1967,9 @@ SetLambdaFromAny(interp, objPtr)
result = Tcl_ListObjGetElements(interp, objPtr, &objc, &objv);
if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
errPtr = Tcl_NewStringObj("can't interpret \"",-1);
- Tcl_IncrRefCount(errPtr);
Tcl_AppendObjToObj(errPtr, objPtr);
Tcl_AppendToObj(errPtr, "\" as a lambda expression", -1);
Tcl_SetObjResult(interp, errPtr);
- Tcl_DecrRefCount(errPtr);
return TCL_ERROR;
}
@@ -1987,9 +1985,9 @@ SetLambdaFromAny(interp, objPtr)
if (TclCreateProc(interp, /*ignored nsPtr*/ NULL, name, argsPtr,
bodyPtr, &procPtr) != TCL_OK) {
- Tcl_AddErrorInfo(interp, "\n (parsing lambda expression \"");
- Tcl_AddErrorInfo(interp, name);
- Tcl_AddErrorInfo(interp, "\")");
+ TclFormatToErrorInfo(interp,
+ "\n (parsing lambda expression \"%s\")",
+ Tcl_GetString(objPtr), NULL);
return TCL_ERROR;
}
procPtr->refCount++;
@@ -2000,14 +1998,20 @@ SetLambdaFromAny(interp, objPtr)
* as a global reference, or else global per default.
*/
- nsObjPtr = Tcl_NewStringObj("::", 2);
- Tcl_IncrRefCount(nsObjPtr);
-
- if (objc == 3) {
- Tcl_AppendObjToObj(nsObjPtr, objv[2]);
+ if (objc == 2) {
+ nsObjPtr = Tcl_NewStringObj("::", 2);
+ } else {
+ char *nsName = Tcl_GetString(objv[2]);
+ if ((*nsName != ':') || (*(nsName+1) != ':')) {
+ nsObjPtr = Tcl_NewStringObj("::", 2);
+ Tcl_AppendObjToObj(nsObjPtr, objv[2]);
+ } else {
+ nsObjPtr = objv[2];
+ }
}
-
-
+
+ Tcl_IncrRefCount(nsObjPtr);
+
/*
* Free the list internalrep of objPtr - this will free argsPtr, but
* bodyPtr retains a reference from the Proc structure. Then finish
@@ -2088,19 +2092,15 @@ Tcl_ApplyObjCmd(dummy, interp, objc, objv)
if (result != TCL_OK) {
return result;
}
+
if (nsPtr == (Tcl_Namespace *) NULL) {
errPtr = Tcl_NewStringObj("cannot find namespace \"",-1);
- Tcl_IncrRefCount(errPtr);
Tcl_AppendObjToObj(errPtr, nsObjPtr);
Tcl_AppendToObj(errPtr, "\"", -1);
Tcl_SetObjResult(interp, errPtr);
- Tcl_DecrRefCount(errPtr);
return TCL_ERROR;
}
-
- /*
- cmd = *((Command *) Tcl_GetCommandFromObj(interp, objv[0]));
- */
+
cmd.nsPtr = (Namespace *) nsPtr;
return ObjInterpProcEx((ClientData) procPtr, interp, objc, objv, 2);