diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-01-07 14:40:56 (GMT) | 
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-01-07 14:40:56 (GMT) | 
| commit | f6f2a3b144eb75edbc33ea0c15c40bc40e0158bd (patch) | |
| tree | 2bd8baf6c11fe4d3786667b319b3d80f37e291e6 /generic | |
| parent | 7acea3af7b9aead1af0702058bb8fca92ab11449 (diff) | |
| download | tcl-f6f2a3b144eb75edbc33ea0c15c40bc40e0158bd.zip tcl-f6f2a3b144eb75edbc33ea0c15c40bc40e0158bd.tar.gz tcl-f6f2a3b144eb75edbc33ea0c15c40bc40e0158bd.tar.bz2  | |
Restrict the stub library to only use Tcl_PkgRequireEx, Tcl_ResetResult	and Tcl_AppendResult, not any other function. 
This puts least restrictions on eventual Tcl 9 stubs re-organization, and it works on the widest range of Tcl versions.
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclOOStubLib.c | 72 | ||||
| -rw-r--r-- | generic/tclTomMathStubLib.c | 32 | 
2 files changed, 39 insertions, 65 deletions
diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c index 55f2378..921aced 100644 --- a/generic/tclOOStubLib.c +++ b/generic/tclOOStubLib.c @@ -2,19 +2,6 @@   * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17   */ -/* - * We need to ensure that we use the tcl stub macros so that this file - * contains no references to any of the tcl stub functions. - */ - -#undef USE_TCL_STUBS -#define USE_TCL_STUBS - -#ifdef HAVE_CONFIG_H -#include "config.h" -#endif - -#define USE_TCLOO_STUBS 1  #include "tclOOInt.h"  MODULE_SCOPE const TclOOStubs *tclOOStubsPtr; @@ -35,51 +22,48 @@ const TclOOIntStubs *tclOOIntStubsPtr = NULL;   *	to indicate that an error occurred.   *   * Side effects: - *	Sets the stub table pointer. + *	Sets the stub table pointers.   *   *----------------------------------------------------------------------   */  MODULE_SCOPE const char *  TclOOInitializeStubs( -    Tcl_Interp *interp, const char *version) +    Tcl_Interp *interp, +    const char *version)  {      int exact = 0;      const char *packageName = "TclOO";      const char *errMsg = NULL; -    ClientData clientData = NULL; -    const char *actualVersion = -	    Tcl_PkgRequireEx(interp, packageName,version, exact, &clientData); +    TclOOStubs *stubsPtr = NULL; +    const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, +	    packageName, version, exact, &stubsPtr); -    if (clientData == NULL) { -	Tcl_ResetResult(interp); -	Tcl_SetObjResult(interp, Tcl_ObjPrintf( -		"error loading %s package; package not present or incomplete", -		packageName)); +    if (actualVersion == NULL) {  	return NULL; +    } +    if (stubsPtr == NULL) { +	errMsg = "missing stub table pointer";      } else { -	const TclOOStubs * const stubsPtr = clientData; -	const TclOOIntStubs * const intStubsPtr = stubsPtr->hooks ? -		stubsPtr->hooks->tclOOIntStubs : NULL; - -	if (!actualVersion) { -	    return NULL; -	} - -	if (!stubsPtr || !intStubsPtr) { -	    errMsg = "missing stub table pointer"; -	    goto error; -	} -  	tclOOStubsPtr = stubsPtr; -	tclOOIntStubsPtr = intStubsPtr; +	if (stubsPtr->hooks) { +	    tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs; +	} else { +	    tclOOIntStubsPtr = NULL; +	}  	return actualVersion; - -    error: -	Tcl_ResetResult(interp); -	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error loading %s package" -		" (requested version '%s', loaded version '%s'): %s", -		packageName, version, actualVersion, errMsg)); -	return NULL;      } +    tclStubsPtr->tcl_ResetResult(interp); +    tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName, +	    " (requested version ", version, ", actual version ", +	    actualVersion, "): ", errMsg, NULL); +    return NULL;  } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclTomMathStubLib.c b/generic/tclTomMathStubLib.c index a3bc4b3..324f2a3 100644 --- a/generic/tclTomMathStubLib.c +++ b/generic/tclTomMathStubLib.c @@ -11,15 +11,6 @@   * this file, and for a DISCLAIMER OF ALL WARRANTIES.   */ -/* - * We need to ensure that we use the stub macros so that this file contains no - * references to any of the stub functions. This will make it possible to - * build an extension that references Tcl_InitStubs but doesn't end up - * including the rest of the stub functions. - */ - -#define USE_TCL_STUBS -  #include "tclInt.h"  MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr; @@ -55,31 +46,30 @@ TclTomMathInitializeStubs(      int exact = 0;      const char *packageName = "tcl::tommath";      const char *errMsg = NULL; -    ClientData pkgClientData = NULL; -    const char *actualVersion = -	Tcl_PkgRequireEx(interp, packageName, version, exact, &pkgClientData); -    const TclTomMathStubs *stubsPtr = pkgClientData; +    TclTomMathStubs *stubsPtr = NULL; +    const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, +	    packageName, version, exact, &stubsPtr);      if (actualVersion == NULL) {  	return NULL;      } -    if (pkgClientData == NULL) { +    if (stubsPtr == NULL) {  	errMsg = "missing stub table pointer"; -    } else if ((stubsPtr->tclBN_epoch)() != epoch) { +    } else if(stubsPtr->tclBN_epoch() != epoch) {  	errMsg = "epoch number mismatch"; -    } else if ((stubsPtr->tclBN_revision)() != revision) { +    } else if(stubsPtr->tclBN_revision() != revision) {  	errMsg = "requires a later revision";      } else {  	tclTomMathStubsPtr = stubsPtr;  	return actualVersion;      } - -    Tcl_SetObjResult(interp, Tcl_ObjPrintf( -	    "error loading %s (requested version %s, actual version %s): %s", -	    packageName, version, actualVersion, errMsg)); +    tclStubsPtr->tcl_ResetResult(interp); +    tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName, +	    " (requested version ", version, ", actual version ", +	    actualVersion, "): ", errMsg, NULL);      return NULL;  } - +  /*   * Local Variables:   * mode: c  | 
