summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog6
-rw-r--r--doc/NRE.32
-rw-r--r--generic/tclInt.decls19
-rw-r--r--generic/tclIntPlatDecls.h41
-rw-r--r--generic/tclPkg.c4
-rw-r--r--generic/tclStubInit.c8
-rw-r--r--generic/tclStubLib.c2
-rw-r--r--tests/load.test2
-rw-r--r--unix/dltest/pkgb.c42
9 files changed, 90 insertions, 36 deletions
diff --git a/ChangeLog b/ChangeLog
index 6f8c8ae..37c3e2e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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
diff --git a/doc/NRE.3 b/doc/NRE.3
index be2c58b..4ad78b3 100644
--- a/doc/NRE.3
+++ b/doc/NRE.3
@@ -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;
}
generated by cgit v0.12 at 2024-07-09 10:56:14 (GMT)