diff options
author | dgp <dgp@users.sourceforge.net> | 2012-12-07 19:26:49 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2012-12-07 19:26:49 (GMT) |
commit | 64a4cb5635ebcaa6a114e48d9cf23d37fc4e9017 (patch) | |
tree | a26ad2430da36dea249328e02a574fdc36e3a386 | |
parent | cd4ea3194fc39818bd06e1ffec598e4230befcf5 (diff) | |
parent | f21757bb59b183ee82e709542e8d741db5648e9a (diff) | |
download | tcl-64a4cb5635ebcaa6a114e48d9cf23d37fc4e9017.zip tcl-64a4cb5635ebcaa6a114e48d9cf23d37fc4e9017.tar.gz tcl-64a4cb5635ebcaa6a114e48d9cf23d37fc4e9017.tar.bz2 |
merge trunk
-rw-r--r-- | ChangeLog | 6 | ||||
-rw-r--r-- | doc/NRE.3 | 2 | ||||
-rw-r--r-- | generic/tclInt.decls | 19 | ||||
-rw-r--r-- | generic/tclIntPlatDecls.h | 41 | ||||
-rw-r--r-- | generic/tclPkg.c | 4 | ||||
-rw-r--r-- | generic/tclStubInit.c | 8 | ||||
-rw-r--r-- | generic/tclStubLib.c | 2 | ||||
-rw-r--r-- | tests/load.test | 2 | ||||
-rw-r--r-- | unix/dltest/pkgb.c | 42 |
9 files changed, 90 insertions, 36 deletions
@@ -1,3 +1,9 @@ +2012-12-07 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/dltest/pkgb.c: Turn pkgb.so into a Tcl9 interoperability test + library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 9 should + either result in an error-message, either succeed, but never crash. + 2012-11-28 Donal K. Fellows <dkf@users.sf.net> * generic/tclZlib.c (ZlibStreamSubcmd): [Bug 3590483]: Use a mechanism @@ -295,7 +295,7 @@ int int result) { /* \fIdata[0] .. data[3]\fR are the four words of data - * passed to \fBTcl_NREvalObj\fR */ + * passed to \fBTcl_NRAddCallback\fR */ \fI... postprocessing ...\fR diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 8f8b992..f215d32 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -1148,9 +1148,6 @@ declare 27 win { declare 28 win { void TclWinResetInterfaces(void) } -declare 29 win { - int TclWinCPUID(unsigned int index, unsigned int *regs) -} ################################ # Unix specific functions @@ -1219,12 +1216,6 @@ declare 14 unix { const Tcl_StatBuf *statBufPtr, int dontCopyAtts) } -# Added in 8.6; core of TclpOpenTemporaryFile -declare 20 unix { - int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, - Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj) -} - ################################ # Mac OS X specific functions @@ -1248,9 +1239,17 @@ declare 18 macosx { declare 19 macosx { void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode) } -declare 29 unix { + +declare 29 {win unix} { int TclWinCPUID(unsigned int index, unsigned int *regs) } +# Added in 8.6; core of TclpOpenTemporaryFile +declare 30 {win unix} { + int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, + Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj) +} + + # Local Variables: # mode: tcl diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index f265e7e..dcf1753 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -84,10 +84,7 @@ EXTERN int TclUnixCopyFile(const char *src, const char *dst, /* Slot 17 is reserved */ /* Slot 18 is reserved */ /* Slot 19 is reserved */ -/* 20 */ -EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, - Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, - Tcl_Obj *resultingNameObj); +/* Slot 20 is reserved */ /* Slot 21 is reserved */ /* Slot 22 is reserved */ /* Slot 23 is reserved */ @@ -98,6 +95,10 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, /* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); +/* 30 */ +EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, + Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, + Tcl_Obj *resultingNameObj); #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ /* 0 */ @@ -169,6 +170,10 @@ EXTERN void TclWinFlushDirtyChannels(void); EXTERN void TclWinResetInterfaces(void); /* 29 */ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); +/* 30 */ +EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, + Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, + Tcl_Obj *resultingNameObj); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ @@ -228,10 +233,7 @@ EXTERN int TclMacOSXMatchType(Tcl_Interp *interp, /* 19 */ EXTERN void TclMacOSXNotifierAddRunLoopMode( const void *runLoopMode); -/* 20 */ -EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, - Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, - Tcl_Obj *resultingNameObj); +/* Slot 20 is reserved */ /* Slot 21 is reserved */ /* Slot 22 is reserved */ /* Slot 23 is reserved */ @@ -242,6 +244,10 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, /* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); +/* 30 */ +EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, + Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, + Tcl_Obj *resultingNameObj); #endif /* MACOSX */ typedef struct TclIntPlatStubs { @@ -269,7 +275,7 @@ typedef struct TclIntPlatStubs { void (*reserved17)(void); void (*reserved18)(void); void (*reserved19)(void); - int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 20 */ + void (*reserved20)(void); void (*reserved21)(void); void (*reserved22)(void); void (*reserved23)(void); @@ -279,6 +285,7 @@ typedef struct TclIntPlatStubs { void (*reserved27)(void); void (*reserved28)(void); int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ + int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ void (*tclWinConvertError) (DWORD errCode); /* 0 */ @@ -311,6 +318,7 @@ typedef struct TclIntPlatStubs { void (*tclWinFlushDirtyChannels) (void); /* 27 */ void (*tclWinResetInterfaces) (void); /* 28 */ int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ + int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */ @@ -333,7 +341,7 @@ typedef struct TclIntPlatStubs { int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */ int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */ void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */ - int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 20 */ + void (*reserved20)(void); void (*reserved21)(void); void (*reserved22)(void); void (*reserved23)(void); @@ -343,6 +351,7 @@ typedef struct TclIntPlatStubs { void (*reserved27)(void); void (*reserved28)(void); int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */ + int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* MACOSX */ } TclIntPlatStubs; @@ -395,8 +404,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; /* Slot 17 is reserved */ /* Slot 18 is reserved */ /* Slot 19 is reserved */ -#define TclUnixOpenTemporaryFile \ - (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 20 */ +/* Slot 20 is reserved */ /* Slot 21 is reserved */ /* Slot 22 is reserved */ /* Slot 23 is reserved */ @@ -407,6 +415,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; /* Slot 28 is reserved */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ +#define TclUnixOpenTemporaryFile \ + (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ #define TclWinConvertError \ @@ -467,6 +477,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ +#define TclUnixOpenTemporaryFile \ + (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ #define TclGetAndDetachPids \ @@ -508,8 +520,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */ #define TclMacOSXNotifierAddRunLoopMode \ (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ -#define TclUnixOpenTemporaryFile \ - (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 20 */ +/* Slot 20 is reserved */ /* Slot 21 is reserved */ /* Slot 22 is reserved */ /* Slot 23 is reserved */ @@ -520,6 +531,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; /* Slot 28 is reserved */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ +#define TclUnixOpenTemporaryFile \ + (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* MACOSX */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 9b6e942..5b09ddb 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -356,6 +356,10 @@ PkgRequireCore( char *script, *pkgVersionI; Tcl_DString command; + if (TCL_OK != CheckAllRequirements(interp, reqc, reqv)) { + return NULL; + } + /* * It can take up to three passes to find the package: one pass to run the * "package unknown" script, one to run the "package ifneeded" script for diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 0bede56..88ada19 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -65,6 +65,7 @@ static unsigned short TclWinNToHS(unsigned short ns) { #ifdef __WIN32__ # define TclUnixWaitForFile 0 # define TclUnixCopyFile 0 +# define TclUnixOpenTemporaryFile 0 # define TclpReaddir 0 # define TclpIsAtty 0 #elif defined(__CYGWIN__) @@ -465,7 +466,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { 0, /* 17 */ 0, /* 18 */ 0, /* 19 */ - TclUnixOpenTemporaryFile, /* 20 */ + 0, /* 20 */ 0, /* 21 */ 0, /* 22 */ 0, /* 23 */ @@ -475,6 +476,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { 0, /* 27 */ 0, /* 28 */ TclWinCPUID, /* 29 */ + TclUnixOpenTemporaryFile, /* 30 */ #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ TclWinConvertError, /* 0 */ @@ -507,6 +509,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclWinFlushDirtyChannels, /* 27 */ TclWinResetInterfaces, /* 28 */ TclWinCPUID, /* 29 */ + TclUnixOpenTemporaryFile, /* 30 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ TclGetAndDetachPids, /* 0 */ @@ -529,7 +532,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclMacOSXCopyFileAttributes, /* 17 */ TclMacOSXMatchType, /* 18 */ TclMacOSXNotifierAddRunLoopMode, /* 19 */ - TclUnixOpenTemporaryFile, /* 20 */ + 0, /* 20 */ 0, /* 21 */ 0, /* 22 */ 0, /* 23 */ @@ -539,6 +542,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { 0, /* 27 */ 0, /* 28 */ TclWinCPUID, /* 29 */ + TclUnixOpenTemporaryFile, /* 30 */ #endif /* MACOSX */ }; diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 91012fd..0efaf50 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -111,7 +111,7 @@ Tcl_InitStubs( while (*p && (*p == *q)) { p++; q++; } - if (*p) { + if (*p || isDigit(*q)) { /* Construct error message */ Tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); return NULL; diff --git a/tests/load.test b/tests/load.test index eef677f..cded85d 100644 --- a/tests/load.test +++ b/tests/load.test @@ -188,7 +188,7 @@ test load-8.3 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded teststaticpkg] { load [file join $testDir pkgb$ext] pkgb list [info loaded {}] [lsort [info commands pkgb_*]] -} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_sub pkgb_unsafe}] +} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_demo pkgb_sub pkgb_unsafe}] interp delete child test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} \ diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index fe0d365..9884a64 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -30,6 +30,8 @@ static int Pkgb_SubObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int Pkgb_UnsafeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int Pkgb_DemoObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* *---------------------------------------------------------------------- @@ -93,7 +95,33 @@ Pkgb_UnsafeObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1)); + return Tcl_EvalEx(interp, "list unsafe command invoked", -1, TCL_EVAL_GLOBAL); +} + +#if (TCL_MAJOR_VERSION > 8) +const char *Tcl_GetDefaultEncodingDir(void) +{ + int numDirs; + Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath(); + + Tcl_ListObjLength(NULL, searchPath, &numDirs); + if (numDirs == 0) { + return NULL; + } + Tcl_ListObjIndex(NULL, searchPath, 0, &first); + + return Tcl_GetString(first); +} +#endif + +static int +Pkgb_DemoObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetDefaultEncodingDir(), -1)); return TCL_OK; } @@ -121,16 +149,16 @@ Pkgb_Init( { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "8.5-9.1", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgb", "2.3"); + code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL); if (code != TCL_OK) { return code; } Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd, NULL, - NULL); + Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "pkgb_demo", Pkgb_DemoObjCmd, NULL, NULL); return TCL_OK; } @@ -158,10 +186,10 @@ Pkgb_SafeInit( { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "8.5-9.1", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgb", "2.3"); + code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL); if (code != TCL_OK) { return code; } |