Diff
Not logged in

Differences From Artifact [7e8819ff66]:

To Artifact [64ffe32db5]:


8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004-2006 Miguel Sofer
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * 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.179 2010/03/05 14:34:04 dkf Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"

/*







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004-2006 Miguel Sofer
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * 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.179.2.1 2010/09/17 12:55:39 rmax Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"

/*
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
		cfPtr->data.eval.path = contextPtr->data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);

		cfPtr->cmd.str.cmd = NULL;
		cfPtr->cmd.str.len = 0;

		hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
			(char *) procPtr, &isNew);
		if (!isNew) {
		    /*
		     * Get the old command frame and release it. See also
		     * TclProcCleanupProc in this file. Currently it seems as
		     * if only the procbodytest::proc command of the testsuite
		     * is able to trigger this situation.
		     */







|







268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
		cfPtr->data.eval.path = contextPtr->data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);

		cfPtr->cmd.str.cmd = NULL;
		cfPtr->cmd.str.len = 0;

		hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
			procPtr, &isNew);
		if (!isNew) {
		    /*
		     * Get the old command frame and release it. See also
		     * TclProcCleanupProc in this file. Currently it seems as
		     * if only the procbodytest::proc command of the testsuite
		     * is able to trigger this situation.
		     */
1102
1103
1104
1105
1106
1107
1108



1109
1110
1111
1112
1113
1114
1115

1116
1117
1118
1119
1120
1121
1122
     * Build up desired argument list for Tcl_WrongNumArgs
     */

    numArgs = framePtr->procPtr->numArgs;
    desiredObjs = TclStackAlloc(interp,
	    (int) sizeof(Tcl_Obj *) * (numArgs+1));




#ifdef AVOID_HACKS_FOR_ITCL
    desiredObjs[0] = framePtr->objv[skip-1];
#else
    desiredObjs[0] = ((framePtr->isProcCallFrame & FRAME_IS_LAMBDA)
	    ? framePtr->objv[skip-1]
	    : Tcl_NewListObj(skip, framePtr->objv));
#endif /* AVOID_HACKS_FOR_ITCL */

    Tcl_IncrRefCount(desiredObjs[0]);

    defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
    for (i=1 ; i<=numArgs ; i++, defPtr++) {
	Tcl_Obj *argObj;
	Tcl_Obj *namePtr = localName(framePtr, i-1);








>
>
>

|

<
<
|

>







1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114


1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
     * Build up desired argument list for Tcl_WrongNumArgs
     */

    numArgs = framePtr->procPtr->numArgs;
    desiredObjs = TclStackAlloc(interp,
	    (int) sizeof(Tcl_Obj *) * (numArgs+1));

    if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
	desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
    } else {
#ifdef AVOID_HACKS_FOR_ITCL
	desiredObjs[0] = framePtr->objv[skip-1];
#else


	desiredObjs[0] = Tcl_NewListObj(skip, framePtr->objv);
#endif /* AVOID_HACKS_FOR_ITCL */
    }
    Tcl_IncrRefCount(desiredObjs[0]);

    defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
    for (i=1 ; i<=numArgs ; i++, defPtr++) {
	Tcl_Obj *argObj;
	Tcl_Obj *namePtr = localName(framePtr, i-1);

1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
	    }
	}
    }
    localPtr = firstLocalPtr;
    codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;

    /*
     * Initialize the array of local variables stored in the call frame.  Some
     * variables may have special resolution rules. In that case, we call
     * their "resolver" procs to get our hands on the variable, and we make
     * the compiled local a link to the real variable.
     */

  doInitResolvedLocals:
    for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {







|







1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
	    }
	}
    }
    localPtr = firstLocalPtr;
    codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;

    /*
     * Initialize the array of local variables stored in the call frame. Some
     * variables may have special resolution rules. In that case, we call
     * their "resolver" procs to get our hands on the variable, and we make
     * the compiled local a link to the real variable.
     */

  doInitResolvedLocals:
    for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
		cfPtr->data.eval.path = contextPtr->data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);

		cfPtr->cmd.str.cmd = NULL;
		cfPtr->cmd.str.len = 0;

		Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr,
			(char *) procPtr, &isNew), cfPtr);
	    }

	    /*
	     * 'contextPtr' is going out of scope. Release the reference that
	     * it's holding to the source file path
	     */








|







2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
		cfPtr->data.eval.path = contextPtr->data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);

		cfPtr->cmd.str.cmd = NULL;
		cfPtr->cmd.str.len = 0;

		Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr,
			procPtr, &isNew), cfPtr);
	    }

	    /*
	     * 'contextPtr' is going out of scope. Release the reference that
	     * it's holding to the source file path
	     */