Tcl Source Code

Artifact [53ae31e766]
Login

Artifact 53ae31e766c4f2ac98a15473748025264f40b53b:

Attachment "tcl-pkg.patch" to ticket [2997642fff] added by nijtmans 2010-05-06 21:38:15.
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.174
diff -c -r1.174 tcl.decls
*** generic/tcl.decls	2 Apr 2010 23:11:55 -0000	1.174
--- generic/tcl.decls	5 May 2010 22:56:20 -0000
***************
*** 30,41 ****
  
  declare 0 generic {
      int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name,
! 	    const char *version, ClientData clientData)
  }
  declare 1 generic {
      CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp,
  	    const char *name, const char *version, int exact,
! 	    ClientData *clientDataPtr)
  }
  declare 2 generic {
      void Tcl_Panic(const char *format, ...)
--- 30,41 ----
  
  declare 0 generic {
      int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name,
! 	    const char *version, const void *clientData)
  }
  declare 1 generic {
      CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp,
  	    const char *name, const char *version, int exact,
! 	    void *clientDataPtr)
  }
  declare 2 generic {
      void Tcl_Panic(const char *format, ...)
***************
*** 966,972 ****
  declare 272 generic {
      CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp,
  	    const char *name, const char *version, int exact,
! 	    ClientData *clientDataPtr)
  }
  declare 273 generic {
      int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
--- 966,972 ----
  declare 272 generic {
      CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp,
  	    const char *name, const char *version, int exact,
! 	    void *clientDataPtr)
  }
  declare 273 generic {
      int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
***************
*** 2085,2091 ****
  # TIP#268 (extended version numbers and requirements) akupries
  declare 573 generic {
      int Tcl_PkgRequireProc(Tcl_Interp *interp, const char *name,
! 	    int objc, Tcl_Obj *const objv[], ClientData *clientDataPtr)
  }
  
  # TIP#270 (utility C routines for string formatting) dgp
--- 2085,2091 ----
  # TIP#268 (extended version numbers and requirements) akupries
  declare 573 generic {
      int Tcl_PkgRequireProc(Tcl_Interp *interp, const char *name,
! 	    int objc, Tcl_Obj *const objv[], void *clientDataPtr)
  }
  
  # TIP#270 (utility C routines for string formatting) dgp
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.176
diff -c -r1.176 tclDecls.h
*** generic/tclDecls.h	2 Apr 2010 23:11:55 -0000	1.176
--- generic/tclDecls.h	5 May 2010 22:56:39 -0000
***************
*** 42,55 ****
  /* 0 */
  EXTERN int		Tcl_PkgProvideEx(Tcl_Interp *interp,
  				const char *name, const char *version,
! 				ClientData clientData);
  #endif
  #ifndef Tcl_PkgRequireEx_TCL_DECLARED
  #define Tcl_PkgRequireEx_TCL_DECLARED
  /* 1 */
  EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
  				const char *name, const char *version,
! 				int exact, ClientData *clientDataPtr);
  #endif
  #ifndef Tcl_Panic_TCL_DECLARED
  #define Tcl_Panic_TCL_DECLARED
--- 42,55 ----
  /* 0 */
  EXTERN int		Tcl_PkgProvideEx(Tcl_Interp *interp,
  				const char *name, const char *version,
! 				const void *clientData);
  #endif
  #ifndef Tcl_PkgRequireEx_TCL_DECLARED
  #define Tcl_PkgRequireEx_TCL_DECLARED
  /* 1 */
  EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
  				const char *name, const char *version,
! 				int exact, void *clientDataPtr);
  #endif
  #ifndef Tcl_Panic_TCL_DECLARED
  #define Tcl_Panic_TCL_DECLARED
***************
*** 1641,1647 ****
  /* 272 */
  EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp,
  				const char *name, const char *version,
! 				int exact, ClientData *clientDataPtr);
  #endif
  #ifndef Tcl_PkgProvide_TCL_DECLARED
  #define Tcl_PkgProvide_TCL_DECLARED
--- 1641,1647 ----
  /* 272 */
  EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp,
  				const char *name, const char *version,
! 				int exact, void *clientDataPtr);
  #endif
  #ifndef Tcl_PkgProvide_TCL_DECLARED
  #define Tcl_PkgProvide_TCL_DECLARED
***************
*** 3372,3379 ****
  /* 573 */
  EXTERN int		Tcl_PkgRequireProc(Tcl_Interp *interp,
  				const char *name, int objc,
! 				Tcl_Obj *const objv[],
! 				ClientData *clientDataPtr);
  #endif
  #ifndef Tcl_AppendObjToErrorInfo_TCL_DECLARED
  #define Tcl_AppendObjToErrorInfo_TCL_DECLARED
--- 3372,3378 ----
  /* 573 */
  EXTERN int		Tcl_PkgRequireProc(Tcl_Interp *interp,
  				const char *name, int objc,
! 				Tcl_Obj *const objv[], void *clientDataPtr);
  #endif
  #ifndef Tcl_AppendObjToErrorInfo_TCL_DECLARED
  #define Tcl_AppendObjToErrorInfo_TCL_DECLARED
***************
*** 3714,3721 ****
      int magic;
      const struct TclStubHooks *hooks;
  
!     int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, ClientData clientData); /* 0 */
!     CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, ClientData *clientDataPtr); /* 1 */
      void (*tcl_Panic) (const char *format, ...); /* 2 */
      char * (*tcl_Alloc) (unsigned int size); /* 3 */
      void (*tcl_Free) (char *ptr); /* 4 */
--- 3713,3720 ----
      int magic;
      const struct TclStubHooks *hooks;
  
!     int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
!     CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
      void (*tcl_Panic) (const char *format, ...); /* 2 */
      char * (*tcl_Alloc) (unsigned int size); /* 3 */
      void (*tcl_Free) (char *ptr); /* 4 */
***************
*** 4010,4016 ****
      char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
      CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */
      CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
!     CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, ClientData *clientDataPtr); /* 272 */
      int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
      CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
      void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
--- 4009,4015 ----
      char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
      CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */
      CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
!     CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
      int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
      CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
      void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
***************
*** 4311,4317 ****
      Tcl_Obj * (*tcl_GetEncodingSearchPath) (void); /* 570 */
      int (*tcl_SetEncodingSearchPath) (Tcl_Obj *searchPath); /* 571 */
      const char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */
!     int (*tcl_PkgRequireProc) (Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], ClientData *clientDataPtr); /* 573 */
      void (*tcl_AppendObjToErrorInfo) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 574 */
      void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, const char *bytes, int length, int limit, const char *ellipsis); /* 575 */
      Tcl_Obj * (*tcl_Format) (Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); /* 576 */
--- 4310,4316 ----
      Tcl_Obj * (*tcl_GetEncodingSearchPath) (void); /* 570 */
      int (*tcl_SetEncodingSearchPath) (Tcl_Obj *searchPath); /* 571 */
      const char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */
!     int (*tcl_PkgRequireProc) (Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr); /* 573 */
      void (*tcl_AppendObjToErrorInfo) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 574 */
      void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, const char *bytes, int length, int limit, const char *ellipsis); /* 575 */
      Tcl_Obj * (*tcl_Format) (Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); /* 576 */
Index: generic/tclStubLib.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubLib.c,v
retrieving revision 1.32
diff -c -r1.32 tclStubLib.c
*** generic/tclStubLib.c	6 Mar 2010 06:29:24 -0000	1.32
--- generic/tclStubLib.c	5 May 2010 22:56:41 -0000
***************
*** 84,90 ****
      int exact)
  {
      const char *actualVersion = NULL;
!     ClientData pkgData = NULL;
  
      /*
       * We can't optimize this check by caching tclStubsPtr because that
--- 84,90 ----
      int exact)
  {
      const char *actualVersion = NULL;
!     const TclStubs *stubsPtr;
  
      /*
       * We can't optimize this check by caching tclStubsPtr because that
***************
*** 92,103 ****
       * times. [Bug 615304]
       */
  
!     tclStubsPtr = HasStubSupport(interp);
!     if (!tclStubsPtr) {
  	return NULL;
      }
  
!     actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
      if (actualVersion == NULL) {
  	return NULL;
      }
--- 92,104 ----
       * times. [Bug 615304]
       */
  
!     stubsPtr = HasStubSupport(interp);
!     if (!stubsPtr) {
  	return NULL;
      }
  
!     tclStubsPtr = stubsPtr;
!     actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, 0, &stubsPtr);
      if (actualVersion == NULL) {
  	return NULL;
      }
***************
*** 127,133 ****
  	    }
  	}
      }
!     tclStubsPtr = (TclStubs *) pkgData;
  
      if (tclStubsPtr->hooks) {
  	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
--- 128,134 ----
  	    }
  	}
      }
!     tclStubsPtr = stubsPtr;
  
      if (tclStubsPtr->hooks) {
  	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
Index: generic/tclTomMathStubLib.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTomMathStubLib.c,v
retrieving revision 1.1
diff -c -r1.1 tclTomMathStubLib.c
*** generic/tclTomMathStubLib.c	4 Mar 2010 22:29:05 -0000	1.1
--- generic/tclTomMathStubLib.c	5 May 2010 22:56:41 -0000
***************
*** 57,71 ****
      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;
  
      if (actualVersion == NULL) {
  	return NULL;
      }
!     if (pkgClientData == NULL) {
  	errMsg = "missing stub table pointer";
      } else if ((stubsPtr->tclBN_epoch)() != epoch) {
  	errMsg = "epoch number mismatch";
--- 57,70 ----
      int exact = 0;
      const char *packageName = "tcl::tommath";
      const char *errMsg = NULL;
!     const TclTomMathStubs *stubsPtr;
      const char *actualVersion =
! 	Tcl_PkgRequireEx(interp, packageName, version, exact, &stubsPtr);
  
      if (actualVersion == NULL) {
  	return NULL;
      }
!     if (stubsPtr == NULL) {
  	errMsg = "missing stub table pointer";
      } else if ((stubsPtr->tclBN_epoch)() != epoch) {
  	errMsg = "epoch number mismatch";
Index: generic/tclPkg.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclPkg.c,v
retrieving revision 1.42
diff -c -r1.42 tclPkg.c
*** generic/tclPkg.c	5 May 2010 22:43:46 -0000	1.42
--- generic/tclPkg.c	5 May 2010 22:56:40 -0000
***************
*** 48,54 ****
  				 * exist in this interpreter yet. */
      PkgAvail *availPtr;		/* First in list of all available versions of
  				 * this package. */
!     ClientData clientData;	/* Client data. */
  } Package;
  
  /*
--- 48,54 ----
  				 * exist in this interpreter yet. */
      PkgAvail *availPtr;		/* First in list of all available versions of
  				 * this package. */
!     const void *clientData;	/* Client data. */
  } Package;
  
  /*
***************
*** 73,79 ****
  static Package *	FindPackage(Tcl_Interp *interp, const char *name);
  static const char *	PkgRequireCore(Tcl_Interp *interp, const char *name,
  			    int reqc, Tcl_Obj *const reqv[],
! 			    ClientData *clientDataPtr);
  
  /*
   * Helper macros.
--- 73,79 ----
  static Package *	FindPackage(Tcl_Interp *interp, const char *name);
  static const char *	PkgRequireCore(Tcl_Interp *interp, const char *name,
  			    int reqc, Tcl_Obj *const reqv[],
! 			    void *clientDataPtr);
  
  /*
   * Helper macros.
***************
*** 124,130 ****
  				 * available. */
      const char *name,		/* Name of package. */
      const char *version,	/* Version string for package. */
!     ClientData clientData)	/* clientdata for this package (normally used
  				 * for C callback function table) */
  {
      Package *pkgPtr;
--- 124,130 ----
  				 * available. */
      const char *name,		/* Name of package. */
      const char *version,	/* Version string for package. */
!     const void *clientData)	/* clientdata for this package (normally used
  				 * for C callback function table) */
  {
      Package *pkgPtr;
***************
*** 212,218 ****
      int exact,			/* Non-zero means that only the particular
  				 * version given is acceptable. Zero means use
  				 * the latest compatible version. */
!     ClientData *clientDataPtr)	/* Used to return the client data for this
  				 * package. If it is NULL then the client data
  				 * is not returned. This is unchanged if this
  				 * call fails for any reason. */
--- 212,218 ----
      int exact,			/* Non-zero means that only the particular
  				 * version given is acceptable. Zero means use
  				 * the latest compatible version. */
!     void *clientDataPtr)	/* Used to return the client data for this
  				 * package. If it is NULL then the client data
  				 * is not returned. This is unchanged if this
  				 * call fails for any reason. */
***************
*** 323,329 ****
  				 * version. */
      Tcl_Obj *const reqv[],	/* 0 means to use the latest version
  				 * available. */
!     ClientData *clientDataPtr)
  {
      const char *result =
  	    PkgRequireCore(interp, name, reqc, reqv, clientDataPtr);
--- 323,329 ----
  				 * version. */
      Tcl_Obj *const reqv[],	/* 0 means to use the latest version
  				 * available. */
!     void *clientDataPtr)
  {
      const char *result =
  	    PkgRequireCore(interp, name, reqc, reqv, clientDataPtr);
***************
*** 344,350 ****
  				 * version. */
      Tcl_Obj *const reqv[],	/* 0 means to use the latest version
  				 * available. */
!     ClientData *clientDataPtr)
  {
      Interp *iPtr = (Interp *) interp;
      Package *pkgPtr;
--- 344,350 ----
  				 * version. */
      Tcl_Obj *const reqv[],	/* 0 means to use the latest version
  				 * available. */
!     void *clientDataPtr)
  {
      Interp *iPtr = (Interp *) interp;
      Package *pkgPtr;
***************
*** 621,627 ****
  
      if (satisfies) {
  	if (clientDataPtr) {
! 	    *clientDataPtr = pkgPtr->clientData;
  	}
  	return pkgPtr->version;
      }
--- 621,628 ----
  
      if (satisfies) {
  	if (clientDataPtr) {
! 		const void **ptr = clientDataPtr;
! 	    *ptr = pkgPtr->clientData;
  	}
  	return pkgPtr->version;
      }
***************
*** 677,683 ****
      int exact,			/* Non-zero means that only the particular
  				 * version given is acceptable. Zero means use
  				 * the latest compatible version. */
!     ClientData *clientDataPtr)	/* Used to return the client data for this
  				 * package. If it is NULL then the client data
  				 * is not returned. This is unchanged if this
  				 * call fails for any reason. */
--- 678,684 ----
      int exact,			/* Non-zero means that only the particular
  				 * version given is acceptable. Zero means use
  				 * the latest compatible version. */
!     void *clientDataPtr)	/* Used to return the client data for this
  				 * package. If it is NULL then the client data
  				 * is not returned. This is unchanged if this
  				 * call fails for any reason. */
Index: generic/tclTomMathInterface.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTomMathInterface.c,v
retrieving revision 1.15
diff -c -r1.15 tclTomMathInterface.c
*** generic/tclTomMathInterface.c	27 Apr 2010 12:36:21 -0000	1.15
--- generic/tclTomMathInterface.c	5 May 2010 22:56:41 -0000
***************
*** 44,50 ****
      /* TIP #268: Full patchlevel instead of just major.minor */
  
      if (Tcl_PkgProvideEx(interp, "tcl::tommath", TCL_PATCH_LEVEL,
! 	    (ClientData) &tclTomMathStubs) != TCL_OK) {
  	return TCL_ERROR;
      }
      return TCL_OK;
--- 44,50 ----
      /* TIP #268: Full patchlevel instead of just major.minor */
  
      if (Tcl_PkgProvideEx(interp, "tcl::tommath", TCL_PATCH_LEVEL,
! 	    &tclTomMathStubs) != TCL_OK) {
  	return TCL_ERROR;
      }
      return TCL_OK;
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.456
diff -c -r1.456 tclBasic.c
*** generic/tclBasic.c	3 May 2010 14:36:41 -0000	1.456
--- generic/tclBasic.c	5 May 2010 22:56:30 -0000
***************
*** 920,927 ****
       * TIP #268: Full patchlevel instead of just major.minor
       */
  
!     Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL,
! 	    (ClientData) &tclStubs);
  
      if (TclTommath_Init(interp) != TCL_OK) {
  	Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
--- 920,926 ----
       * TIP #268: Full patchlevel instead of just major.minor
       */
  
!     Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
  
      if (TclTommath_Init(interp) != TCL_OK) {
  	Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
Index: doc/PkgRequire.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/PkgRequire.3,v
retrieving revision 1.13
diff -c -r1.13 PkgRequire.3
*** doc/PkgRequire.3	27 Nov 2009 14:35:10 -0000	1.13
--- doc/PkgRequire.3	5 May 2010 22:56:17 -0000
***************
*** 36,42 ****
  int
  \fBTcl_PkgProvideEx\fR(\fIinterp, name, version, clientData\fR)
  .SH ARGUMENTS
! .AS ClientData clientDataPtr out
  .AP Tcl_Interp *interp in
  Interpreter where package is needed or available.
  .AP "const char" *name in
--- 36,42 ----
  int
  \fBTcl_PkgProvideEx\fR(\fIinterp, name, version, clientData\fR)
  .SH ARGUMENTS
! .AS void clientDataPtr out
  .AP Tcl_Interp *interp in
  Interpreter where package is needed or available.
  .AP "const char" *name in
***************
*** 50,58 ****
  Zero means that newer versions than \fIversion\fR are also
  acceptable as long as they have the same major version number
  as \fIversion\fR.
! .AP ClientData clientData in
  Arbitrary value to be associated with the package.
! .AP ClientData *clientDataPtr out
  Pointer to place to store the value associated with the matching
  package. It is only changed if the pointer is not NULL and the
  function completed successfully.
--- 50,58 ----
  Zero means that newer versions than \fIversion\fR are also
  acceptable as long as they have the same major version number
  as \fIversion\fR.
! .AP "const void" *clientData in
  Arbitrary value to be associated with the package.
! .AP void *clientDataPtr out
  Pointer to place to store the value associated with the matching
  package. It is only changed if the pointer is not NULL and the
  function completed successfully.