Itcl - the [incr Tcl] extension

     */
    if (iclsPtr->flags & ITCL_TYPE) {
        namePtr = Tcl_NewStringObj("type", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
            NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_TYPE_VAR;       /* mark as "type" variable */



    }

    if (iclsPtr->flags & (ITCL_ECLASS)) {
        namePtr = Tcl_NewStringObj("win", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
            NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_WIN_VAR;        /* mark as "win" variable */



    }
    if (iclsPtr->flags & (ITCL_TYPE|ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
        namePtr = Tcl_NewStringObj("self", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
            NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_SELF_VAR;       /* mark as "self" variable */




        namePtr = Tcl_NewStringObj("selfns", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
            NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_SELFNS_VAR;     /* mark as "selfns" variable */




        namePtr = Tcl_NewStringObj("win", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
            NULL, &ivPtr);
        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_WIN_VAR;        /* mark as "win" variable */



    }
    namePtr = Tcl_NewStringObj("this", -1);
    (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
            NULL, &ivPtr);

    ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
    ivPtr->flags |= ITCL_THIS_VAR;       /* mark as "this" variable */





    if (infoPtr->currClassFlags &
            (ITCL_ECLASS|ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET)) {
        /*
         *  Add the built-in "itcl_options" variable to the list of
	 *  data members.
         */
        namePtr = Tcl_NewStringObj("itcl_options", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
                NULL, &ivPtr);

        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_OPTIONS_VAR;    /* mark as "itcl_options"
	                                      * variable */





    }
    if (infoPtr->currClassFlags &
            ITCL_ECLASS) {
        /*
         *  Add the built-in "itcl_option_components" variable to the list of
	 *  data members.
         */
        namePtr = Tcl_NewStringObj("itcl_option_components", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
                NULL, &ivPtr);

        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_OPTION_COMP_VAR; /* mark as "itcl_option_components"
	                                      * variable */





    }
    if (infoPtr->currClassFlags & (ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
        /*
         *  Add the built-in "thiswin" variable to the list of data members.
         */
        namePtr = Tcl_NewStringObj("thiswin", -1);
        (void) Itcl_CreateVariable(interp, iclsPtr, namePtr, NULL,
                NULL, &ivPtr);

        ivPtr->protection = ITCL_PROTECTED;  /* always "protected" */
        ivPtr->flags |= ITCL_THIS_VAR;       /* mark as "thiswin" variable */




    }
    if (infoPtr->currClassFlags & (ITCL_WIDGET|ITCL_WIDGETADAPTOR)) {
        /* create the itcl_hull component */
        ItclComponent *icPtr;
        namePtr = Tcl_NewStringObj("itcl_hull", 9);
	/* itcl_hull must not be an ITCL_COMMON!! */
        if (ItclCreateComponent(interp, iclsPtr, namePtr, 0, &icPtr) !=

 *  removed from a class definition to rebuild the member lookup
 *  tables.  There are two tables:
 *
 *  METHODS:  resolveCmds
 *    Used primarily in Itcl_ClassCmdResolver() to resolve all
 *    command references in a namespace.
 *
 *  DATA MEMBERS:  resolveVars (built on demand, moved to ItclResolveVarEntry)
 *    Used primarily in Itcl_ClassVarResolver() to quickly resolve
 *    variable references in each class scope.
 *
 *  These tables store every possible name for each command/variable
 *  (member, class::member, namesp::class::member, etc.).  Members
 *  in a derived class may shadow members with the same name in a
 *  base class.  In that case, the simple name in the resolution

    Itcl_PreserveData(ioptPtr);
    Itcl_EventuallyFree(ioptPtr, (Tcl_FreeProc *) ItclDeleteOption);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  ItclCreateMethodVariable(), Itcl_CreateMethodVariable()
 *
 *  Creates a new class methdovariable definition.  If this is a public
 *  methodvariable,
 *
 *  Returns TCL_ERROR along with an error message in the specified
 *  interpreter if anything goes wrong.  Otherwise, this returns
 *  TCL_OK and a pointer to the new option definition in "imvPtr".
 * ------------------------------------------------------------------------
 */
int
ItclCreateMethodVariable(
    Tcl_Interp *interp,       /* interpreter managing this transaction */

    ItclVariable *ivPtr,      /* variable reference (from Itcl_CreateVariable) */
    Tcl_Obj* defaultPtr,      /* initial value */
    Tcl_Obj* callbackPtr,     /* code invoked when variable is set */
    ItclMethodVariable** imvPtrPtr)
                              /* returns: new methdovariable definition */
{
    int isNew;
    ItclMethodVariable *imvPtr;
    Tcl_HashEntry *hPtr;

    /*
     *  Add this methodvariable to the options table for the class.
     *  Make sure that the methodvariable name does not already exist.
     */
    hPtr = Tcl_CreateHashEntry(&ivPtr->iclsPtr->methodVariables,
            (char *)ivPtr->namePtr, &isNew);
    if (!isNew) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "methdovariable name \"", Tcl_GetString(ivPtr->namePtr),
	    "\" already defined in class \"",
            Tcl_GetString (ivPtr->iclsPtr->fullNamePtr), "\"",
            NULL);
        return TCL_ERROR;
    }


    /*
     *  If everything looks good, create the option definition.
     */
    imvPtr = (ItclMethodVariable*)ckalloc(sizeof(ItclMethodVariable));
    memset(imvPtr, 0, sizeof(ItclMethodVariable));
    imvPtr->iclsPtr      = ivPtr->iclsPtr;
    imvPtr->protection   = Itcl_Protection(interp, 0);
    imvPtr->namePtr      = ivPtr->namePtr;
    Tcl_IncrRefCount(imvPtr->namePtr);
    imvPtr->fullNamePtr = ivPtr->fullNamePtr;



    Tcl_IncrRefCount(imvPtr->fullNamePtr);
    imvPtr->defaultValuePtr    = defaultPtr;
    if (defaultPtr != NULL) {
        Tcl_IncrRefCount(imvPtr->defaultValuePtr);
    }
    imvPtr->callbackPtr    = callbackPtr;
    if (callbackPtr != NULL) {
        Tcl_IncrRefCount(imvPtr->callbackPtr);
    }

    if (imvPtr->protection == ITCL_DEFAULT_PROTECT) {
        imvPtr->protection = ITCL_PROTECTED;
    }

    Tcl_SetHashValue(hPtr, imvPtr);

    *imvPtrPtr = imvPtr;
    return TCL_OK;
}

/* 
 * TODO: remove this if unused (seems to be internal API only),
 *       now superseded by ItclCreateMethodVariable.
 */
int
Itcl_CreateMethodVariable(
    Tcl_Interp *interp,       /* interpreter managing this transaction */
    ItclClass* iclsPtr,       /* class containing this variable */
    Tcl_Obj* namePtr,         /* variable name */
    Tcl_Obj* defaultPtr,      /* initial value */
    Tcl_Obj* callbackPtr,     /* code invoked when variable is set */
    ItclMethodVariable** imvPtrPtr)
                              /* returns: new methdovariable definition */
{
    ItclVariable *ivPtr;
    Tcl_HashEntry *hPtr;

    /*
     *  Search variable reference (ivPtr).
     */
    hPtr = Tcl_FindHashEntry(&iclsPtr->variables, (char *)namePtr);
    if (!hPtr || !(ivPtr = (ItclVariable*)Tcl_GetHashValue(hPtr))) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "variable name \"", Tcl_GetString(namePtr),
	    "\" is not declared in class \"",
            Tcl_GetString (iclsPtr->fullNamePtr), "\"",
            NULL);
        return TCL_ERROR;
    }

    /*
     *  Create method variable.
     */
    return ItclCreateMethodVariable(interp, ivPtr, defaultPtr, callbackPtr,
		imvPtrPtr);
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_GetCommonVar()
 *
 *  Returns the current value for a common class variable.  The member

MODULE_SCOPE int Itcl_ClassCompiledVarResolver2(Tcl_Interp *interp,
        const char* name, int length, Tcl_Namespace *nsPtr,
        struct Tcl_ResolvedVarInfo **rPtr);
MODULE_SCOPE int ItclSetParserResolver(Tcl_Namespace *nsPtr);
MODULE_SCOPE void ItclProcErrorProc(Tcl_Interp *interp, Tcl_Obj *procNameObj);
MODULE_SCOPE int Itcl_CreateOption (Tcl_Interp *interp, ItclClass *iclsPtr,
	ItclOption *ioptPtr);
MODULE_SCOPE int ItclCreateMethodVariable(Tcl_Interp *interp,
	ItclVariable *ivPtr, Tcl_Obj* defaultPtr, Tcl_Obj* callbackPtr,
	ItclMethodVariable** imvPtrPtr);
MODULE_SCOPE int Itcl_CreateMethodVariable (Tcl_Interp *interp,
        ItclClass *iclsPtr, Tcl_Obj *name, Tcl_Obj *defaultPtr,
	Tcl_Obj *callbackPtr, ItclMethodVariable **imvPtr);
MODULE_SCOPE int DelegationInstall(Tcl_Interp *interp, ItclObject *ioPtr,
        ItclClass *iclsPtr);
MODULE_SCOPE ItclClass *ItclNamespace2Class(Tcl_Namespace *nsPtr);
MODULE_SCOPE const char* ItclGetCommonInstanceVar(Tcl_Interp *interp,

        /* create the itcl_hull variable */
        namePtr = Tcl_NewStringObj("itcl_hull", -1);
        if (ItclCreateComponent(interp, iclsPtr, namePtr, ITCL_COMMON,
	        &icPtr) != TCL_OK) {
            return TCL_ERROR;
        }
        iclsPtr->numVariables++;

    }
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp, Tcl_GetString(iclsPtr->fullNamePtr), NULL);
    return result;
}

/*

        Tcl_SetHashValue(hPtr, varPtr);
    }
    result = Itcl_PushCallFrame(interp, &frame, commonNsPtr,
        /* isProcCallFrame */ 0);
    Itcl_PopCallFrame(interp);

    /*






     *  If an initialization value was specified, then initialize
     *  the variable now, otherwise be sure the variable is uninitialized.
     */


    if (initStr != NULL) {
	const char *val;


	val = Tcl_SetVar2(interp, Tcl_GetString(ivPtr->fullNamePtr), NULL,

		initStr, TCL_NAMESPACE_ONLY);

        if (!val) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "cannot initialize common variable \"",
                Tcl_GetString(ivPtr->namePtr), "\"",
                NULL);
            return TCL_ERROR;
        }
    } else {
	/* previous var-lookup in class body (in ::itcl::parser) could obtain
	 * inherited common vars, so be sure it does not exists after new
	 * common creation (simply remove this reference). */
	Tcl_UnsetVar2(interp, Tcl_GetString(ivPtr->fullNamePtr), NULL,
		TCL_NAMESPACE_ONLY);
    }
    if (ivPtr->arrayInitPtr != NULL) {
	int i;
	int argc;
	const char **argv;
	const char *val;


	result = Tcl_SplitList(interp, Tcl_GetString(ivPtr->arrayInitPtr),
	        &argc, &argv);
	for (i = 0; i < argc; i++) {
            val = Tcl_SetVar2(interp, Tcl_GetString(ivPtr->fullNamePtr), argv[i],
                    argv[i + 1], TCL_NAMESPACE_ONLY);
            if (!val) {
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "cannot initialize common variable \"",
                    Tcl_GetString(ivPtr->namePtr), "\"",
                    NULL);
                return TCL_ERROR;

    }

    if (Itcl_CreateVariable(interp, iclsPtr, namePtr,
            Tcl_GetString(defaultPtr), NULL, &ivPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    iclsPtr->numVariables++;
    result = ItclCreateMethodVariable(interp, ivPtr, defaultPtr,
            callbackPtr, &imvPtr);
    if (result != TCL_OK) {
        return result;
    }
    objPtr = Tcl_NewStringObj("@itcl-builtin-setget ", -1);
    Tcl_AppendToObj(objPtr, Tcl_GetString(namePtr), -1);
    Tcl_AppendToObj(objPtr, " ", 1);

    test_arrays0 do array names undefined
} -result {}

test basic-6.8 {common variables can be redefined
} -body {
    test_arrays0 do set undefined "scalar"
} -result {scalar}

proc testVarResolver {{access private} {init 0}} {
  eval [string map [list \$access $access \$init $init] {
    itcl::class A {
	$access common cv "A::cv"
	public proc cv {} {set cv}
    }
    itcl::class B {
	inherit A
	public common res {}
	lappend res [info exists cv]
	if {$init} {
	    $access common cv ""
	} else {
	    $access common cv
	}
	lappend res [info exists cv]
	lappend cv "B::cv-add"
	public proc cv {} {set cv}
    }
    lappend B::res [A::cv] [B::cv]
    set B::res
  }]
}
test basic-7.1-a {variable lookup before a common creation (bug [777ae99cfb])} -body {
    # private uninitialized var:
    testVarResolver private 0
} -result {0 0 A::cv B::cv-add} -cleanup {
    itcl::delete class B A
}
test basic-7.1-b {variable lookup before a common creation (bug [777ae99cfb])} -body {
    # public uninitialized var:
    testVarResolver public 0
} -result {1 0 A::cv B::cv-add} -cleanup {
    itcl::delete class B A
}
test basic-7.2-a {variable lookup before a common creation (bug [777ae99cfb])} -body {
    # private initialized var:
    testVarResolver private 1
} -result {0 1 A::cv B::cv-add} -cleanup {
    itcl::delete class B A
}
test basic-7.2-b {variable lookup before a common creation (bug [777ae99cfb])} -body {
    # public initialized var:
    testVarResolver public 1
} -result {1 1 A::cv B::cv-add} -cleanup {
    itcl::delete class B A
}

if {[namespace which test_arrays] ne {}} {
    ::itcl::delete class test_arrays
}
check_itcl_basic_errors
rename check_itcl_basic_errors {}