Attachment #54127 for bug #81906

View | Details | Raw Unified | Return to bug 81906
Collapse All | Expand All




#

PORTNAME=	itcl
PORTVERSION=	${MAJOR}.${MINOR}.1
PORTREVISION=	2
CATEGORIES=	lang
MASTER_SITES=	${MASTER_SITE_SOURCEFORGE}
MASTER_SITE_SUBDIR=incrtcl
DISTNAME=	itcl${PORTVERSION}
EXTRACT_SUFX=	_src.tgz

MAINTAINER=	ports@FreeBSD.org
COMMENT=	[incr Tcl] (A.K.A. "itcl")

MAKE_ENV+=	${PLIST_SUB} \
		SHLIB_MAJOR=${SHLIB_MAJOR} SHLIB_MINOR=${SHLIB_MINOR}

EXTRACT_AFTER_ARGS=| ${TAR} -xf - itcl${PORTVERSION}/itcl

.if defined(MAKE_JOBS)
MAKE_ARGS+=	-j${MAKE_JOBS}

MANN+=		itcl.n itcl_class.n itcl_info.n itclvars.n local.n scope.n

ITCL_LIB_FILE=	${ITCL_LIB}.${SHLIB_MAJOR}

post-extract:
	${RM} ${WRKSRC}/pkgIndex.tcl

post-patch:
	${REINPLACE_CMD} \

Lines 1-2 Link Here

(-)itcl/distinfo (-2 / +2 lines)
1	MD5 (itcl3.2.tar.gz) = b41ed909969eaa5f0a06ab698393760f	1	MD5 (itcl3.2.1_src.tgz) = 44dcc2129232329cacd6c8abebf38403
2	SIZE (itcl3.2.tar.gz) = 1498517	2	SIZE (itcl3.2.1_src.tgz) = 427026

Lines 6-12 Link Here

(-)itcl/files/Makefile.lib (-1 / +1 lines)
6	-DHAVE_GETCWD=1 -DNO_VALUES_H=1 -DHAVE_UNISTD_H=1 -DUSE_TERMIOS=1\	6	-DHAVE_GETCWD=1 -DNO_VALUES_H=1 -DHAVE_UNISTD_H=1 -DUSE_TERMIOS=1\
7	-DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_TM_ZONE=1\	7	-DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_TM_ZONE=1\
8	-DHAVE_TM_GMTOFF=1 -DHAVE_ST_BLKSIZE=1 -DSTDC_HEADERS=1\	8	-DHAVE_TM_GMTOFF=1 -DHAVE_ST_BLKSIZE=1 -DSTDC_HEADERS=1\
9	-DNEED_MATHERR=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_SYS_IOCTL_H=1\	9	-DHAVE_SIGNED_CHAR=1 -DHAVE_SYS_IOCTL_H=1\
10	-DTCL_SHLIB_EXT=\".so\" \	10	-DTCL_SHLIB_EXT=\".so\" \
11	-DHAVE_SYS_FILIO_H=1 \	11	-DHAVE_SYS_FILIO_H=1 \
12	-DRETSIGTYPE=void \	12	-DRETSIGTYPE=void \




===================================================================
RCS file: /cvsroot/incrtcl/incrTcl/itcl/generic/itcl.h,v
retrieving revision 1.15
retrieving revision 1.19
diff -u -r1.15 -r1.19
--- generic/itcl.h	2001/05/25 00:12:29	1.15
+++ generic/itcl.h	2002/01/16 22:29:41	1.19
@@ -40,9 +40,9 @@
  *           http://www.tcltk.com/itcl
  *
  *       modified for Stubs 5/20/1999 by 
- *           David Gravereaux <davygrvy@bigfoot.com>
+ *           David Gravereaux <davygrvy@pobox.com>
  *
- *     RCS:  $Id: itcl.h,v 1.15 2001/05/25 00:12:29 davygrvy Exp $
+ *     RCS:  $Id: itcl.h,v 1.19 2002/01/16 22:29:41 andreas_kupries Exp $
  * ========================================================================
  *           Copyright (c) 1993-1998  Lucent Technologies, Inc.
  * ------------------------------------------------------------------------
@@ -54,17 +54,6 @@
 
 #include "tcl.h"
 
-#undef TCL_STORAGE_CLASS
-#ifdef BUILD_itcl
-# define TCL_STORAGE_CLASS DLLEXPORT
-#else
-# ifdef USE_ITCL_STUBS
-#  define TCL_STORAGE_CLASS
-# else
-#  define TCL_STORAGE_CLASS DLLIMPORT
-# endif
-#endif
-
 #define ITCL_VERSION "3.2"
 #define ITCL_PATCH_LEVEL "3.2.1"
 #define ITCL_MAJOR_VERSION 3
@@ -80,6 +69,58 @@
 
 #ifndef RC_INVOKED
 
+#undef TCL_STORAGE_CLASS
+#ifdef BUILD_itcl
+#   define TCL_STORAGE_CLASS DLLEXPORT
+#else
+#   ifdef USE_ITCL_STUBS
+#	define TCL_STORAGE_CLASS
+#   else
+#	define TCL_STORAGE_CLASS DLLIMPORT
+#   endif
+#endif
+
+/*
+ * Fix the Borland bug that's in the EXTERN macro from tcl.h.
+ */
+#ifndef TCL_EXTERN
+#   undef DLLIMPORT
+#   undef DLLEXPORT
+#   if defined(STATIC_BUILD)
+#	define DLLIMPORT
+#	define DLLEXPORT
+#   elif (defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) || (defined(__GNUC__) && defined(__declspec)))) \
+	    || (defined(MAC_TCL) && FUNCTION_DECLSPEC)
+#	define DLLIMPORT __declspec(dllimport)
+#	define DLLEXPORT __declspec(dllexport)
+#   elif defined(__BORLANDC__)
+#	define OLDBORLAND 1
+#	define DLLIMPORT __import
+#	define DLLEXPORT __export
+#   else
+#	define DLLIMPORT
+#	define DLLEXPORT
+#   endif
+
+    /*
+     * Make sure name mangling won't happen when the c++ language extensions
+     * are used.
+     */
+#   ifdef __cplusplus
+#	define TCL_CPP "C"
+#   else
+#	define TCL_CPP
+#   endif
+    /*
+     * Borland requires the attributes be placed after the return type.
+     */
+#   ifdef OLDBORLAND
+#	define TCL_EXTERN(rtnType) extern TCL_CPP rtnType TCL_STORAGE_CLASS
+#   else
+#	define TCL_EXTERN(rtnType) extern TCL_CPP TCL_STORAGE_CLASS rtnType
+#   endif
+#endif
+
 /*
  * Protection levels:
  *
@@ -152,9 +193,7 @@
 
 #ifdef USE_ITCL_STUBS
 
-#ifdef __cplusplus
-extern "C"
-#endif
+extern TCL_CPP
 CONST char *	Itcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *version, int exact));
 #else




===================================================================
RCS file: /cvsroot/incrtcl/incrTcl/itcl/generic/itclInt.h,v
retrieving revision 1.7
retrieving revision 1.11
diff -u -r1.7 -r1.11
--- generic/itclInt.h	2001/04/07 07:20:53	1.7
+++ generic/itclInt.h	2003/12/23 06:58:27	1.11
@@ -39,7 +39,7 @@
  *           mmclennan@lucent.com
  *           http://www.tcltk.com/itcl
  *
- *     RCS:  $Id: itclInt.h,v 1.7 2001/04/07 07:20:53 davygrvy Exp $
+ *     RCS:  $Id: itclInt.h,v 1.11 2003/12/23 06:58:27 davygrvy Exp $
  * ========================================================================
  *           Copyright (c) 1993-1998  Lucent Technologies, Inc.
  * ------------------------------------------------------------------------
@@ -49,14 +49,64 @@
 #ifndef ITCLINT_H
 #define ITCLINT_H
 
-#include "itcl.h"
 #include "tclInt.h"
+#include "itcl.h"
 
 #ifdef BUILD_itcl
 # undef TCL_STORAGE_CLASS
 # define TCL_STORAGE_CLASS DLLEXPORT
 #endif
 
+/*
+ * Fix Tcl bug #803489 the right way.  We need to always use the old Stub
+ * slot positions, not the new broken ones.  I do like that these functions
+ * have moved to the public space, but the slot change is the killer and is
+ * the painful side affect.
+ */
+
+#if defined(USE_TCL_STUBS) && \
+	(TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 5)
+#   undef Tcl_CreateNamespace
+#   define Tcl_CreateNamespace \
+	(tclIntStubsPtr->tcl_CreateNamespace)
+#   undef Tcl_DeleteNamespace
+#   define Tcl_DeleteNamespace \
+	(tclIntStubsPtr->tcl_DeleteNamespace)
+#   undef Tcl_AppendExportList
+#   define Tcl_AppendExportList \
+	(tclIntStubsPtr->tcl_AppendExportList)
+#   undef Tcl_Export
+#   define Tcl_Export \
+	(tclIntStubsPtr->tcl_Export)
+#   undef Tcl_Import
+#   define Tcl_Import \
+	(tclIntStubsPtr->tcl_Import)
+#   undef Tcl_ForgetImport
+#   define Tcl_ForgetImport \
+	(tclIntStubsPtr->tcl_ForgetImport)
+#   undef Tcl_GetCurrentNamespace
+#   define Tcl_GetCurrentNamespace \
+	(tclIntStubsPtr->tcl_GetCurrentNamespace)
+#   undef Tcl_GetGlobalNamespace
+#   define Tcl_GetGlobalNamespace \
+	(tclIntStubsPtr->tcl_GetGlobalNamespace)
+#   undef Tcl_FindNamespace
+#   define Tcl_FindNamespace \
+	(tclIntStubsPtr->tcl_FindNamespace)
+#   undef Tcl_FindCommand
+#   define Tcl_FindCommand \
+	(tclIntStubsPtr->tcl_FindCommand)
+#   undef Tcl_GetCommandFromObj
+#   define Tcl_GetCommandFromObj \
+	(tclIntStubsPtr->tcl_GetCommandFromObj)
+#   undef Tcl_GetCommandFullName
+#   define Tcl_GetCommandFullName \
+	(tclIntStubsPtr->tcl_GetCommandFullName)
+#endif
+
+#define TCL_DOES_STUBS \
+    (TCL_MAJOR_VERSION > 8 || TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION > 1 || \
+    (TCL_MINOR_VERSION == 1 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)))
 
 /*
  *  Common info for managing all known objects.
@@ -255,15 +305,11 @@
  */
 
 #undef  assert
-#ifdef  NDEBUG
+#ifndef  DEBUG
 #define assert(EX) ((void)0)
 #else
-#if defined(__STDC__)
-#define assert(EX) (void)((EX) || (Itcl_Assert(#EX, __FILE__, __LINE__), 0))
-#else
-#define assert(EX) (void)((EX) || (Itcl_Assert("EX", __FILE__, __LINE__), 0))
-#endif  /* __STDC__ */
-#endif  /* NDEBUG */
+#define assert(EX) (void)((EX) || (Itcl_Assert(STRINGIFY(EX), __FILE__, __LINE__), 0))
+#endif  /* DEBUG */
 
 #undef TCL_STORAGE_CLASS
 #define TCL_STORAGE_CLASS DLLIMPORT




===================================================================
RCS file: /cvsroot/incrtcl/incrTcl/itcl/generic/itcl_cmds.c,v
retrieving revision 1.13
retrieving revision 1.15
diff -u -r1.13 -r1.15
--- generic/itcl_cmds.c	2001/05/22 01:50:21	1.13
+++ generic/itcl_cmds.c	2002/01/10 11:43:37	1.15
@@ -21,7 +21,7 @@
  *           mmclennan@lucent.com
  *           http://www.tcltk.com/itcl
  *
- *     RCS:  $Id: itcl_cmds.c,v 1.13 2001/05/22 01:50:21 davygrvy Exp $
+ *     RCS:  $Id: itcl_cmds.c,v 1.15 2002/01/10 11:43:37 davygrvy Exp $
  * ========================================================================
  *           Copyright (c) 1993-1998  Lucent Technologies, Inc.
  * ------------------------------------------------------------------------
@@ -469,7 +469,7 @@
     int forceFullNames = 0;
 
     char *pattern;
-    CONST char *name;
+    CONST char *cmdName;
     int newEntry, handledActiveNs;
     Tcl_HashTable unique;
     Tcl_HashEntry *entry;
@@ -477,7 +477,7 @@
     Itcl_Stack search;
     Tcl_Command cmd, originalCmd;
     Namespace *nsPtr;
-    Tcl_Obj *listPtr, *objPtr;
+    Tcl_Obj *objPtr;
 
     if (objc > 2) {
         Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
@@ -485,7 +485,7 @@
     }
 
     if (objc == 2) {
-        pattern = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+        pattern = Tcl_GetString(objv[1]);
         forceFullNames = (strstr(pattern, "::") != NULL);
     } else {
         pattern = NULL;
@@ -497,7 +497,6 @@
      *  in this interpreter.  If we find any commands that
      *  represent classes, report them.
      */
-    listPtr = Tcl_NewListObj(0, (Tcl_Obj* CONST*)NULL);
 
     Itcl_InitStack(&search);
     Itcl_PushStack((ClientData)globalNs, &search);
@@ -532,10 +531,10 @@
 
                     objPtr = Tcl_NewStringObj((char*)NULL, 0);
                     Tcl_GetCommandFullName(interp, cmd, objPtr);
-                    name = Tcl_GetStringFromObj(objPtr, (int*)NULL);
+                    cmdName = Tcl_GetString(objPtr);
                 } else {
-                    name = Tcl_GetCommandName(interp, cmd);
-                    objPtr = Tcl_NewStringObj(name, -1);
+                    cmdName = Tcl_GetCommandName(interp, cmd);
+                    objPtr = Tcl_NewStringObj(cmdName, -1);
                 }
 
                 if (originalCmd) {
@@ -543,9 +542,10 @@
                 }
                 Tcl_CreateHashEntry(&unique, (char*)cmd, &newEntry);
 
-                if (newEntry && (!pattern || Tcl_StringMatch(name, pattern))) {
+                if (newEntry &&
+			(!pattern || Tcl_StringMatch(cmdName, pattern))) {
                     Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
-                        listPtr, objPtr);
+                        Tcl_GetObjResult(interp), objPtr);
                 }
             }
             entry = Tcl_NextHashEntry(&place);
@@ -565,7 +565,6 @@
     Tcl_DeleteHashTable(&unique);
     Itcl_DeleteStack(&search);
 
-    Tcl_SetObjResult(interp, listPtr);
     return TCL_OK;
 }
 
@@ -598,8 +597,8 @@
     ItclClass *classDefn = NULL;
     ItclClass *isaDefn = NULL;
 
-    char *name, *token;
-    CONST char *cmdName;
+    char *name = NULL, *token = NULL;
+    CONST char *cmdName = NULL;
     int pos, newEntry, match, handledActiveNs;
     ItclObject *contextObj;
     Tcl_HashTable unique;
@@ -609,7 +608,7 @@
     Tcl_Command cmd, originalCmd;
     Namespace *nsPtr;
     Command *cmdPtr;
-    Tcl_Obj *listPtr, *objPtr;
+    Tcl_Obj *objPtr;
 
     /*
      *  Parse arguments:
@@ -617,7 +616,7 @@
      */
     pos = 0;
     while (++pos < objc) {
-        token = Tcl_GetStringFromObj(objv[pos], (int*)NULL);
+        token = Tcl_GetString(objv[pos]);
         if (*token != '-') {
             if (!pattern) {
                 pattern = token;
@@ -627,7 +626,7 @@
             }
         }
         else if ((pos+1 < objc) && (strcmp(token,"-class") == 0)) {
-            name = Tcl_GetStringFromObj(objv[pos+1], (int*)NULL);
+            name = Tcl_GetString(objv[pos+1]);
             classDefn = Itcl_FindClass(interp, name, /* autoload */ 1);
             if (classDefn == NULL) {
                 return TCL_ERROR;
@@ -635,7 +634,7 @@
             pos++;
         }
         else if ((pos+1 < objc) && (strcmp(token,"-isa") == 0)) {
-            name = Tcl_GetStringFromObj(objv[pos+1], (int*)NULL);
+            name = Tcl_GetString(objv[pos+1]);
             isaDefn = Itcl_FindClass(interp, name, /* autoload */ 1);
             if (isaDefn == NULL) {
                 return TCL_ERROR;
@@ -669,7 +668,6 @@
      *  in this interpreter.  If we find any commands that
      *  represent objects, report them.
      */
-    listPtr = Tcl_NewListObj(0, (Tcl_Obj* CONST*)NULL);
 
     Itcl_InitStack(&search);
     Itcl_PushStack((ClientData)globalNs, &search);
@@ -709,7 +707,7 @@
 
                     objPtr = Tcl_NewStringObj((char*)NULL, 0);
                     Tcl_GetCommandFullName(interp, cmd, objPtr);
-                    name = Tcl_GetStringFromObj(objPtr, (int*)NULL);
+		    cmdName = Tcl_GetString(objPtr);
                 } else {
                     cmdName = Tcl_GetCommandName(interp, cmd);
                     objPtr = Tcl_NewStringObj(cmdName, -1);
@@ -718,7 +716,8 @@
                 Tcl_CreateHashEntry(&unique, (char*)cmd, &newEntry);
 
                 match = 0;
-                if (newEntry && (!pattern || Tcl_StringMatch(name, pattern))) {
+		if (newEntry &&
+			(!pattern || Tcl_StringMatch(cmdName, pattern))) {
                     if (!classDefn || (contextObj->classDefn == classDefn)) {
                         if (!isaDefn) {
                             match = 1;
@@ -736,10 +735,9 @@
 
                 if (match) {
                     Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
-                        listPtr, objPtr);
+                        Tcl_GetObjResult(interp), objPtr);
                 } else {
-                    Tcl_IncrRefCount(objPtr);  /* throw away the name */
-                    Tcl_DecrRefCount(objPtr);
+                    Tcl_DecrRefCount(objPtr);  /* throw away the name */
                 }
             }
             entry = Tcl_NextHashEntry(&place);
@@ -759,7 +757,6 @@
     Tcl_DeleteHashTable(&unique);
     Itcl_DeleteStack(&search);
 
-    Tcl_SetObjResult(interp, listPtr);
     return TCL_OK;
 }
 
@@ -821,9 +818,8 @@
     }
     else if (result != TCL_OK) {
         char mesg[256], *name;
-        name = Tcl_GetStringFromObj(objv[0], (int*)NULL);
-        sprintf(mesg, "\n    (%.100s body line %d)",
-            name, interp->errorLine);
+        name = Tcl_GetString(objv[0]);
+        sprintf(mesg, "\n    (%.100s body line %d)", name, interp->errorLine);
         Tcl_AddErrorInfo(interp, mesg);
     }
 
@@ -865,7 +861,7 @@
      *  then delete them.
      */
     for (i=1; i < objc; i++) {
-        name = Tcl_GetStringFromObj(objv[i], (int*)NULL);
+        name = Tcl_GetString(objv[i]);
         cdefn = Itcl_FindClass(interp, name, /* autoload */ 1);
         if (cdefn == NULL) {
             return TCL_ERROR;
@@ -873,7 +869,7 @@
     }
 
     for (i=1; i < objc; i++) {
-        name = Tcl_GetStringFromObj(objv[i], (int*)NULL);
+        name = Tcl_GetString(objv[i]);
         cdefn = Itcl_FindClass(interp, name, /* autoload */ 0);
 
         if (cdefn) {




===================================================================
RCS file: /cvsroot/incrtcl/incrTcl/itcl/tests/ensemble.test,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- tests/ensemble.test	2000/06/01 20:34:35	1.3
+++ tests/ensemble.test	2001/11/05 19:42:11	1.4
@@ -6,7 +6,7 @@
 #            mmclennan@lucent.com
 #            http://www.tcltk.com/itcl
 #
-#      RCS:  $Id: ensemble.test,v 1.3 2000/06/01 20:34:35 wart Exp $
+#      RCS:  $Id: ensemble.test,v 1.4 2001/11/05 19:42:11 hobbs Exp $
 # ----------------------------------------------------------------------
 #            Copyright (c) 1993-1998  Lucent Technologies, Inc.
 # ======================================================================
@@ -45,8 +45,13 @@
 } {{one: 1} {two: 2 3} {three: 3 4 5}}
 
 test ensemble-1.5 {invoking parts with improper arguments} {
-    list [catch "test_numbers three x" msg] $msg
-} {1 {no value given for parameter "y" to "test_numbers three"}}
+    set res [catch "test_numbers three x" msg]
+    if {[package vsatisfies [package provide Tcl] 8.4]} {
+	lappend res [string match "wrong # args*" $msg]
+    } else {
+	lappend res [string match "no value given*" $msg]
+    }
+} {1 1}
 
 test ensemble-1.6 {errors trigger a usage summary} {
     list [catch "test_numbers foo x y" msg] $msg

Return to bug 81906

Lines 6-17 Link Here

(-)itcl/Makefile (-6 / +3 lines)
6	#	6	#
7		7
8	PORTNAME= itcl	8	PORTNAME= itcl
9	PORTVERSION= ${MAJOR}.${MINOR}	9	PORTVERSION= ${MAJOR}.${MINOR}.1
10	PORTREVISION= 2
11	CATEGORIES= lang	10	CATEGORIES= lang
12	MASTER_SITES= ${MASTER_SITE_SOURCEFORGE}	11	MASTER_SITES= ${MASTER_SITE_SOURCEFORGE}
13	MASTER_SITE_SUBDIR=incrtcl	12	MASTER_SITE_SUBDIR=incrtcl
14	DISTNAME= itcl${PORTVERSION}	13	DISTNAME= itcl${PORTVERSION}
		14	EXTRACT_SUFX= _src.tgz
15		15
16	MAINTAINER= ports@FreeBSD.org	16	MAINTAINER= ports@FreeBSD.org
17	COMMENT= [incr Tcl] (A.K.A. "itcl")	17	COMMENT= [incr Tcl] (A.K.A. "itcl")
Lines 26-32 Link Here
26	MAKE_ENV+= ${PLIST_SUB} \	26	MAKE_ENV+= ${PLIST_SUB} \
27	SHLIB_MAJOR=${SHLIB_MAJOR} SHLIB_MINOR=${SHLIB_MINOR}	27	SHLIB_MAJOR=${SHLIB_MAJOR} SHLIB_MINOR=${SHLIB_MINOR}
28		28
29	EXTRACT_AFTER_ARGS=\| ${TAR} -xf - ./itcl${MAJOR}.${MINOR}/itcl	29	EXTRACT_AFTER_ARGS=\| ${TAR} -xf - itcl${PORTVERSION}/itcl
30		30
31	.if defined(MAKE_JOBS)	31	.if defined(MAKE_JOBS)
32	MAKE_ARGS+= -j${MAKE_JOBS}	32	MAKE_ARGS+= -j${MAKE_JOBS}
Lines 45-53 Link Here
45	MANN+= itcl.n itcl_class.n itcl_info.n itclvars.n local.n scope.n	45	MANN+= itcl.n itcl_class.n itcl_info.n itclvars.n local.n scope.n
46		46
47	ITCL_LIB_FILE= ${ITCL_LIB}.${SHLIB_MAJOR}	47	ITCL_LIB_FILE= ${ITCL_LIB}.${SHLIB_MAJOR}
48
49	post-extract:
50	${RM} ${WRKSRC}/pkgIndex.tcl
51		48
52	post-patch:	49	post-patch:
53	${REINPLACE_CMD} \	50	${REINPLACE_CMD} \

Line 0 Link Here

(-)itcl/files/patch-generic+itcl.h (+107 lines)
		1	===================================================================
		2	RCS file: /cvsroot/incrtcl/incrTcl/itcl/generic/itcl.h,v
		3	retrieving revision 1.15
		4	retrieving revision 1.19
		5	diff -u -r1.15 -r1.19
		6	--- generic/itcl.h 2001/05/25 00:12:29 1.15
		7	+++ generic/itcl.h 2002/01/16 22:29:41 1.19
		8	@@ -40,9 +40,9 @@
		9	* http://www.tcltk.com/itcl
		10	*
		11	* modified for Stubs 5/20/1999 by
		12	- * David Gravereaux <davygrvy@bigfoot.com>
		13	+ * David Gravereaux <davygrvy@pobox.com>
		14	*
		15	- * RCS: $Id: itcl.h,v 1.15 2001/05/25 00:12:29 davygrvy Exp $
		16	+ * RCS: $Id: itcl.h,v 1.19 2002/01/16 22:29:41 andreas_kupries Exp $
		17	* ========================================================================
		18	* Copyright (c) 1993-1998 Lucent Technologies, Inc.
		19	* ------------------------------------------------------------------------
		20	@@ -54,17 +54,6 @@
		21
		22	#include "tcl.h"
		23
		24	-#undef TCL_STORAGE_CLASS
		25	-#ifdef BUILD_itcl
		26	-# define TCL_STORAGE_CLASS DLLEXPORT
		27	-#else
		28	-# ifdef USE_ITCL_STUBS
		29	-# define TCL_STORAGE_CLASS
		30	-# else
		31	-# define TCL_STORAGE_CLASS DLLIMPORT
		32	-# endif
		33	-#endif
		34	-
		35	#define ITCL_VERSION "3.2"
		36	#define ITCL_PATCH_LEVEL "3.2.1"
		37	#define ITCL_MAJOR_VERSION 3
		38	@@ -80,6 +69,58 @@
		39
		40	#ifndef RC_INVOKED
		41
		42	+#undef TCL_STORAGE_CLASS
		43	+#ifdef BUILD_itcl
		44	+# define TCL_STORAGE_CLASS DLLEXPORT
		45	+#else
		46	+# ifdef USE_ITCL_STUBS
		47	+# define TCL_STORAGE_CLASS
		48	+# else
		49	+# define TCL_STORAGE_CLASS DLLIMPORT
		50	+# endif
		51	+#endif
		52	+
		53	+/*
		54	+ * Fix the Borland bug that's in the EXTERN macro from tcl.h.
		55	+ */
		56	+#ifndef TCL_EXTERN
		57	+# undef DLLIMPORT
		58	+# undef DLLEXPORT
		59	+# if defined(STATIC_BUILD)
		60	+# define DLLIMPORT
		61	+# define DLLEXPORT
		62	+# elif (defined(__WIN32__) && (defined(_MSC_VER) \|\| (__BORLANDC__ >= 0x0550) \|\| (defined(__GNUC__) && defined(__declspec)))) \
		63	+ \|\| (defined(MAC_TCL) && FUNCTION_DECLSPEC)
		64	+# define DLLIMPORT __declspec(dllimport)
65	+# define DLLEXPORT __declspec(dllexport)
66	+# elif defined(__BORLANDC__)
67	+# define OLDBORLAND 1
68	+# define DLLIMPORT __import
69	+# define DLLEXPORT __export
70	+# else
71	+# define DLLIMPORT
72	+# define DLLEXPORT
73	+# endif
74	+
75	+ /*
76	+ * Make sure name mangling won't happen when the c++ language extensions
77	+ * are used.
78	+ */
79	+# ifdef __cplusplus
80	+# define TCL_CPP "C"
81	+# else
82	+# define TCL_CPP
83	+# endif
84	+ /*
85	+ * Borland requires the attributes be placed after the return type.
86	+ */
87	+# ifdef OLDBORLAND
88	+# define TCL_EXTERN(rtnType) extern TCL_CPP rtnType TCL_STORAGE_CLASS
89	+# else
90	+# define TCL_EXTERN(rtnType) extern TCL_CPP TCL_STORAGE_CLASS rtnType
91	+# endif
92	+#endif
93	+
94	/*
95	* Protection levels:
96	*
97	@@ -152,9 +193,7 @@
98
99	#ifdef USE_ITCL_STUBS
100
101	-#ifdef __cplusplus
102	-extern "C"
103	-#endif
104	+extern TCL_CPP
105	CONST char * Itcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
106	char *version, int exact));
107	#else

Line 0 Link Here

(-)itcl/files/patch-generic+itclInt.h (+101 lines)
		1	===================================================================
		2	RCS file: /cvsroot/incrtcl/incrTcl/itcl/generic/itclInt.h,v
		3	retrieving revision 1.7
		4	retrieving revision 1.11
		5	diff -u -r1.7 -r1.11
		6	--- generic/itclInt.h 2001/04/07 07:20:53 1.7
		7	+++ generic/itclInt.h 2003/12/23 06:58:27 1.11
		8	@@ -39,7 +39,7 @@
		9	* mmclennan@lucent.com
		10	* http://www.tcltk.com/itcl
		11	*
		12	- * RCS: $Id: itclInt.h,v 1.7 2001/04/07 07:20:53 davygrvy Exp $
		13	+ * RCS: $Id: itclInt.h,v 1.11 2003/12/23 06:58:27 davygrvy Exp $
		14	* ========================================================================
		15	* Copyright (c) 1993-1998 Lucent Technologies, Inc.
		16	* ------------------------------------------------------------------------
		17	@@ -49,14 +49,64 @@
		18	#ifndef ITCLINT_H
		19	#define ITCLINT_H
		20
		21	-#include "itcl.h"
		22	#include "tclInt.h"
		23	+#include "itcl.h"
		24
		25	#ifdef BUILD_itcl
		26	# undef TCL_STORAGE_CLASS
		27	# define TCL_STORAGE_CLASS DLLEXPORT
		28	#endif
		29
		30	+/*
		31	+ * Fix Tcl bug #803489 the right way. We need to always use the old Stub
		32	+ * slot positions, not the new broken ones. I do like that these functions
		33	+ * have moved to the public space, but the slot change is the killer and is
		34	+ * the painful side affect.
		35	+ */
		36	+
		37	+#if defined(USE_TCL_STUBS) && \
		38	+ (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 5)
		39	+# undef Tcl_CreateNamespace
		40	+# define Tcl_CreateNamespace \
		41	+ (tclIntStubsPtr->tcl_CreateNamespace)
		42	+# undef Tcl_DeleteNamespace
		43	+# define Tcl_DeleteNamespace \
		44	+ (tclIntStubsPtr->tcl_DeleteNamespace)
		45	+# undef Tcl_AppendExportList
		46	+# define Tcl_AppendExportList \
		47	+ (tclIntStubsPtr->tcl_AppendExportList)
		48	+# undef Tcl_Export
		49	+# define Tcl_Export \
		50	+ (tclIntStubsPtr->tcl_Export)
		51	+# undef Tcl_Import
		52	+# define Tcl_Import \
		53	+ (tclIntStubsPtr->tcl_Import)
		54	+# undef Tcl_ForgetImport
		55	+# define Tcl_ForgetImport \
		56	+ (tclIntStubsPtr->tcl_ForgetImport)
		57	+# undef Tcl_GetCurrentNamespace
		58	+# define Tcl_GetCurrentNamespace \
		59	+ (tclIntStubsPtr->tcl_GetCurrentNamespace)
		60	+# undef Tcl_GetGlobalNamespace
		61	+# define Tcl_GetGlobalNamespace \
		62	+ (tclIntStubsPtr->tcl_GetGlobalNamespace)
		63	+# undef Tcl_FindNamespace
		64	+# define Tcl_FindNamespace \
65	+ (tclIntStubsPtr->tcl_FindNamespace)
66	+# undef Tcl_FindCommand
67	+# define Tcl_FindCommand \
68	+ (tclIntStubsPtr->tcl_FindCommand)
69	+# undef Tcl_GetCommandFromObj
70	+# define Tcl_GetCommandFromObj \
71	+ (tclIntStubsPtr->tcl_GetCommandFromObj)
72	+# undef Tcl_GetCommandFullName
73	+# define Tcl_GetCommandFullName \
74	+ (tclIntStubsPtr->tcl_GetCommandFullName)
75	+#endif
76	+
77	+#define TCL_DOES_STUBS \
78	+ (TCL_MAJOR_VERSION > 8 \|\| TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION > 1 \|\| \
79	+ (TCL_MINOR_VERSION == 1 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)))
80
81	/*
82	* Common info for managing all known objects.
83	@@ -255,15 +305,11 @@
84	*/
85
86	#undef assert
87	-#ifdef NDEBUG
88	+#ifndef DEBUG
89	#define assert(EX) ((void)0)
90	#else
91	-#if defined(__STDC__)
92	-#define assert(EX) (void)((EX) \|\| (Itcl_Assert(#EX, __FILE__, __LINE__), 0))
93	-#else
94	-#define assert(EX) (void)((EX) \|\| (Itcl_Assert("EX", __FILE__, __LINE__), 0))
95	-#endif /* __STDC__ */
96	-#endif /* NDEBUG */
97	+#define assert(EX) (void)((EX) \|\| (Itcl_Assert(STRINGIFY(EX), __FILE__, __LINE__), 0))
98	+#endif /* DEBUG */
99
100	#undef TCL_STORAGE_CLASS
101	#define TCL_STORAGE_CLASS DLLIMPORT

Line 0 Link Here

(-)itcl/files/patch-generic+itcl_cmds.c (+211 lines)
		1	===================================================================
		2	RCS file: /cvsroot/incrtcl/incrTcl/itcl/generic/itcl_cmds.c,v
		3	retrieving revision 1.13
		4	retrieving revision 1.15
		5	diff -u -r1.13 -r1.15
		6	--- generic/itcl_cmds.c 2001/05/22 01:50:21 1.13
		7	+++ generic/itcl_cmds.c 2002/01/10 11:43:37 1.15
		8	@@ -21,7 +21,7 @@
		9	* mmclennan@lucent.com
		10	* http://www.tcltk.com/itcl
		11	*
		12	- * RCS: $Id: itcl_cmds.c,v 1.13 2001/05/22 01:50:21 davygrvy Exp $
		13	+ * RCS: $Id: itcl_cmds.c,v 1.15 2002/01/10 11:43:37 davygrvy Exp $
		14	* ========================================================================
		15	* Copyright (c) 1993-1998 Lucent Technologies, Inc.
		16	* ------------------------------------------------------------------------
		17	@@ -469,7 +469,7 @@
		18	int forceFullNames = 0;
		19
		20	char *pattern;
		21	- CONST char *name;
		22	+ CONST char *cmdName;
		23	int newEntry, handledActiveNs;
		24	Tcl_HashTable unique;
		25	Tcl_HashEntry *entry;
		26	@@ -477,7 +477,7 @@
		27	Itcl_Stack search;
		28	Tcl_Command cmd, originalCmd;
		29	Namespace *nsPtr;
		30	- Tcl_Obj listPtr, objPtr;
		31	+ Tcl_Obj *objPtr;
		32
		33	if (objc > 2) {
		34	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
		35	@@ -485,7 +485,7 @@
		36	}
		37
		38	if (objc == 2) {
		39	- pattern = Tcl_GetStringFromObj(objv[1], (int*)NULL);
		40	+ pattern = Tcl_GetString(objv[1]);
		41	forceFullNames = (strstr(pattern, "::") != NULL);
		42	} else {
		43	pattern = NULL;
		44	@@ -497,7 +497,6 @@
		45	* in this interpreter. If we find any commands that
		46	* represent classes, report them.
		47	*/
		48	- listPtr = Tcl_NewListObj(0, (Tcl_Obj* CONST*)NULL);
		49
		50	Itcl_InitStack(&search);
		51	Itcl_PushStack((ClientData)globalNs, &search);
		52	@@ -532,10 +531,10 @@
		53
		54	objPtr = Tcl_NewStringObj((char*)NULL, 0);
		55	Tcl_GetCommandFullName(interp, cmd, objPtr);
		56	- name = Tcl_GetStringFromObj(objPtr, (int*)NULL);
		57	+ cmdName = Tcl_GetString(objPtr);
		58	} else {
		59	- name = Tcl_GetCommandName(interp, cmd);
		60	- objPtr = Tcl_NewStringObj(name, -1);
		61	+ cmdName = Tcl_GetCommandName(interp, cmd);
		62	+ objPtr = Tcl_NewStringObj(cmdName, -1);
		63	}
		64
65	if (originalCmd) {
66	@@ -543,9 +542,10 @@
67	}
68	Tcl_CreateHashEntry(&unique, (char*)cmd, &newEntry);
69
70	- if (newEntry && (!pattern \|\| Tcl_StringMatch(name, pattern))) {
71	+ if (newEntry &&
72	+ (!pattern \|\| Tcl_StringMatch(cmdName, pattern))) {
73	Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
74	- listPtr, objPtr);
75	+ Tcl_GetObjResult(interp), objPtr);
76	}
77	}
78	entry = Tcl_NextHashEntry(&place);
79	@@ -565,7 +565,6 @@
80	Tcl_DeleteHashTable(&unique);
81	Itcl_DeleteStack(&search);
82
83	- Tcl_SetObjResult(interp, listPtr);
84	return TCL_OK;
85	}
86
87	@@ -598,8 +597,8 @@
88	ItclClass *classDefn = NULL;
89	ItclClass *isaDefn = NULL;
90
91	- char name, token;
92	- CONST char *cmdName;
93	+ char name = NULL, token = NULL;
94	+ CONST char *cmdName = NULL;
95	int pos, newEntry, match, handledActiveNs;
96	ItclObject *contextObj;
97	Tcl_HashTable unique;
98	@@ -609,7 +608,7 @@
99	Tcl_Command cmd, originalCmd;
100	Namespace *nsPtr;
101	Command *cmdPtr;
102	- Tcl_Obj listPtr, objPtr;
103	+ Tcl_Obj *objPtr;
104
105	/*
106	* Parse arguments:
107	@@ -617,7 +616,7 @@
108	*/
109	pos = 0;
110	while (++pos < objc) {
111	- token = Tcl_GetStringFromObj(objv[pos], (int*)NULL);
112	+ token = Tcl_GetString(objv[pos]);
113	if (*token != '-') {
114	if (!pattern) {
115	pattern = token;
116	@@ -627,7 +626,7 @@
117	}
118	}
119	else if ((pos+1 < objc) && (strcmp(token,"-class") == 0)) {
120	- name = Tcl_GetStringFromObj(objv[pos+1], (int*)NULL);
121	+ name = Tcl_GetString(objv[pos+1]);
122	classDefn = Itcl_FindClass(interp, name, /* autoload */ 1);
123	if (classDefn == NULL) {
124	return TCL_ERROR;
125	@@ -635,7 +634,7 @@
126	pos++;
127	}
128	else if ((pos+1 < objc) && (strcmp(token,"-isa") == 0)) {
129	- name = Tcl_GetStringFromObj(objv[pos+1], (int*)NULL);
130	+ name = Tcl_GetString(objv[pos+1]);
131	isaDefn = Itcl_FindClass(interp, name, /* autoload */ 1);
132	if (isaDefn == NULL) {
133	return TCL_ERROR;
134	@@ -669,7 +668,6 @@
135	* in this interpreter. If we find any commands that
136	* represent objects, report them.
137	*/
138	- listPtr = Tcl_NewListObj(0, (Tcl_Obj* CONST*)NULL);
139
140	Itcl_InitStack(&search);
141	Itcl_PushStack((ClientData)globalNs, &search);
142	@@ -709,7 +707,7 @@
143
144	objPtr = Tcl_NewStringObj((char*)NULL, 0);
145	Tcl_GetCommandFullName(interp, cmd, objPtr);
146	- name = Tcl_GetStringFromObj(objPtr, (int*)NULL);
147	+ cmdName = Tcl_GetString(objPtr);
148	} else {
149	cmdName = Tcl_GetCommandName(interp, cmd);
150	objPtr = Tcl_NewStringObj(cmdName, -1);
151	@@ -718,7 +716,8 @@
152	Tcl_CreateHashEntry(&unique, (char*)cmd, &newEntry);
153
154	match = 0;
155	- if (newEntry && (!pattern \|\| Tcl_StringMatch(name, pattern))) {
156	+ if (newEntry &&
157	+ (!pattern \|\| Tcl_StringMatch(cmdName, pattern))) {
158	if (!classDefn \|\| (contextObj->classDefn == classDefn)) {
159	if (!isaDefn) {
160	match = 1;
161	@@ -736,10 +735,9 @@
162
163	if (match) {
164	Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
165	- listPtr, objPtr);
166	+ Tcl_GetObjResult(interp), objPtr);
167	} else {
168	- Tcl_IncrRefCount(objPtr); /* throw away the name */
169	- Tcl_DecrRefCount(objPtr);
170	+ Tcl_DecrRefCount(objPtr); /* throw away the name */
171	}
172	}
173	entry = Tcl_NextHashEntry(&place);
174	@@ -759,7 +757,6 @@
175	Tcl_DeleteHashTable(&unique);
176	Itcl_DeleteStack(&search);
177
178	- Tcl_SetObjResult(interp, listPtr);
179	return TCL_OK;
180	}
181
182	@@ -821,9 +818,8 @@
183	}
184	else if (result != TCL_OK) {
185	char mesg[256], *name;
186	- name = Tcl_GetStringFromObj(objv[0], (int*)NULL);
187	- sprintf(mesg, "\n (%.100s body line %d)",
188	- name, interp->errorLine);
189	+ name = Tcl_GetString(objv[0]);
190	+ sprintf(mesg, "\n (%.100s body line %d)", name, interp->errorLine);
191	Tcl_AddErrorInfo(interp, mesg);
192	}
193
194	@@ -865,7 +861,7 @@
195	* then delete them.
196	*/
197	for (i=1; i < objc; i++) {
198	- name = Tcl_GetStringFromObj(objv[i], (int*)NULL);
199	+ name = Tcl_GetString(objv[i]);
200	cdefn = Itcl_FindClass(interp, name, /* autoload */ 1);
201	if (cdefn == NULL) {
202	return TCL_ERROR;
203	@@ -873,7 +869,7 @@
204	}
205
206	for (i=1; i < objc; i++) {
207	- name = Tcl_GetStringFromObj(objv[i], (int*)NULL);
208	+ name = Tcl_GetString(objv[i]);
209	cdefn = Itcl_FindClass(interp, name, /* autoload */ 0);
210
211	if (cdefn) {

Line 0 Link Here

(-)itcl/files/patch-tests+ensemble.test (+32 lines)
	1	===================================================================
	2	RCS file: /cvsroot/incrtcl/incrTcl/itcl/tests/ensemble.test,v
	3	retrieving revision 1.3
	4	retrieving revision 1.4
	5	diff -u -r1.3 -r1.4
	6	--- tests/ensemble.test 2000/06/01 20:34:35 1.3
	7	+++ tests/ensemble.test 2001/11/05 19:42:11 1.4
	8	@@ -6,7 +6,7 @@
	9	# mmclennan@lucent.com
	10	# http://www.tcltk.com/itcl
	11	#
	12	-# RCS: $Id: ensemble.test,v 1.3 2000/06/01 20:34:35 wart Exp $
	13	+# RCS: $Id: ensemble.test,v 1.4 2001/11/05 19:42:11 hobbs Exp $
	14	# ----------------------------------------------------------------------
	15	# Copyright (c) 1993-1998 Lucent Technologies, Inc.
	16	# ======================================================================
	17	@@ -45,8 +45,13 @@
	18	} {{one: 1} {two: 2 3} {three: 3 4 5}}
	19
	20	test ensemble-1.5 {invoking parts with improper arguments} {
	21	- list [catch "test_numbers three x" msg] $msg
	22	-} {1 {no value given for parameter "y" to "test_numbers three"}}
	23	+ set res [catch "test_numbers three x" msg]
	24	+ if {[package vsatisfies [package provide Tcl] 8.4]} {
	25	+ lappend res [string match "wrong # args*" $msg]
	26	+ } else {
	27	+ lappend res [string match "no value given*" $msg]
	28	+ }
	29	+} {1 1}
	30
	31	test ensemble-1.6 {errors trigger a usage summary} {
	32	list [catch "test_numbers foo x y" msg] $msg