Diff
Not logged in

Differences From Artifact [914b035c11]:

To Artifact [efa691bf7d]:


1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18










-
+







/*
 * tclOOMethod.c --
 *
 *	This file contains code to create and manage methods.
 *
 * Copyright (c) 2005-2008 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclOOMethod.c,v 1.1.2.18 2010/09/22 02:42:51 dgp Exp $
 * RCS: @(#) $Id: tclOOMethod.c,v 1.1.2.19 2010/09/26 14:33:46 dgp Exp $
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"
924
925
926
927
928
929
930
931
932
933
934
935
936
937


938
939
940
941
942
943

944
945
946
947
948

949
950
951
952
953
954

955
956
957
958
959
960
961

962
963
964
965

966
967
968
969
970
971


972
973
974
975
976
977
978
979
980
981
982
983


984
985
986
987
988
989
990
924
925
926
927
928
929
930







931
932






933





934






935







936




937






938
939



940








941
942
943
944
945
946
947
948
949







-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
+
+
-
-
-

-
-
-
-
-
-
-
-
+
+







ProcedureMethodVarResolver(
    Tcl_Interp *interp,
    const char *varName,
    Tcl_Namespace *contextNs,
    int flags,
    Tcl_Var *varPtr)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    CallContext *contextPtr;
    Tcl_Obj *variableObj;
    Tcl_HashEntry *hPtr;
    int i, isNew;

    int result;
    Tcl_ResolvedVarInfo *rPtr;
    /*
     * Check that the variable is being requested in a context that is also a
     * method call; if not (i.e. we're evaluating in the object's namespace or
     * in a procedure of that namespace) then we do nothing.
     */

    
    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	return TCL_CONTINUE;
    }
    contextPtr = framePtr->clientData;

    result = ProcedureMethodCompiledVarResolver(interp, varName,
    /*
     * Check if the variable is one we want to resolve at all (i.e. whether it
     * is in the list provided by the user). If not, we mustn't do anything
     * either.
     */

	    strlen(varName), contextNs, &rPtr);
    if (contextPtr->callPtr->chain[contextPtr->index]
	    .mPtr->declaringClassPtr != NULL) {
	FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
		.mPtr->declaringClassPtr->variables) {
	    if (!strcmp(Tcl_GetString(variableObj), varName)) {
		goto gotMatch;
	    }

	}
    } else {
	FOREACH(variableObj, contextPtr->oPtr->variables) {
	    if (!strcmp(Tcl_GetString(variableObj), varName)) {
    if (result != TCL_OK) {
		goto gotMatch;
	    }
	}
    }
    return TCL_CONTINUE;

	return result;
    }
    /*
     * It is a variable we want to resolve, so resolve it.
     */

  gotMatch:
    hPtr = Tcl_CreateHashEntry(TclVarTable(contextNs), (char *) variableObj,
	    &isNew);
    if (isNew) {
	TclSetVarNamespaceVar((Var *) TclVarHashGetValue(hPtr));
    }
    *varPtr = TclVarHashGetValue(hPtr);
    return TCL_OK;
    *varPtr = rPtr->fetchProc(interp, rPtr);
    return (*varPtr? TCL_OK : TCL_CONTINUE);
}

static Tcl_Var
ProcedureMethodCompiledVarConnect(
    Tcl_Interp *interp,
    Tcl_ResolvedVarInfo *rPtr)
{