Tcl Source Code

Artifact [f48e4c75c5]
Login

Artifact f48e4c75c57e03cff39decbde949e17e57903149:

Attachment "1077229.patch" to ticket [1077229fff] added by dgp 2005-07-28 01:59:58.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.2723
diff -u -r1.2723 ChangeLog
--- ChangeLog	27 Jul 2005 18:12:24 -0000	1.2723
+++ ChangeLog	27 Jul 2005 18:16:52 -0000
@@ -1,10 +1,20 @@
 2005-07-27  Don Porter  <[email protected]>
 
+	* generic/tclUtil.c:	Converted the $::tcl_precision value to be
+	kept per-thread to prevent different threads from stomping on each
+	others' formatting prescriptions.
+
+	***POTENTIAL INCOMPATIBILITY*** Multi-threaded programs that set
+	the value of ::tcl_precision will now have to set it in each thread.
+
 	* tests/expr.test:	Consolidated equivalent constraints into
 	* tests/fileName.test:	single definitions and (more precise) names:
 	* tests/get.test:	longis32bit, 32bit, !intsAre64bit => longIs32bit
 	* tests/listObj.test:	empty => emptyTest; winOnly => win
 	* tests/obj.test:	intsAre64bit => longIs64bit
+	Also updated some "nonPortable" tests to use constraints that mark
+	precisely what about them isn't portable, so the tests can run where
+	they work.
 
 	* library/init.tcl ([unknown]):	Corrected return code handling
 	in the portions of [unknown] that expand incomplete commands
Index: generic/tclUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclUtil.c,v
retrieving revision 1.62
diff -u -r1.62 tclUtil.c
--- generic/tclUtil.c	24 Jul 2005 22:56:44 -0000	1.62
+++ generic/tclUtil.c	27 Jul 2005 18:16:53 -0000
@@ -72,16 +72,11 @@
 #define BRACES_UNMATCHED	4
 
 /*
- * The following values determine the precision used when converting
- * floating-point values to strings. This information is linked to all of the
- * tcl_precision variables in all interpreters via the function
- * TclPrecTraceProc.
+ * The following key is used by Tcl_PrintDouble and TclPrecTraceProc to
+ * access the precision to be used for double formatting.
  */
 
-static int precision = 0;	/* Precision of floating point conversions, in
-				 * the range 0-17 inclusive. */
-
-TCL_DECLARE_MUTEX(precisionMutex)
+static Tcl_ThreadDataKey precisionKey;
 
 /*
  * Prototypes for functions defined later in this file.
@@ -1887,24 +1882,21 @@
 				 * at least TCL_DOUBLE_SPACE characters. */
 {
     char *p, c;
-    int prec;
     int exp;
     int signum;
     char buffer[TCL_DOUBLE_SPACE];
     Tcl_UniChar ch;
 
-    Tcl_MutexLock(&precisionMutex);
-    prec = precision;
-    Tcl_MutexUnlock(&precisionMutex);
+    int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int)sizeof(int));
 
     /*
-     * If prec == 0, then use TclDoubleDigits to develop a decimal significand
-     * and exponent, then format it in E or F format as appropriate. If prec
-     * != 0, use the native sprintf and then add a trailing ".0" if there is
-     * no decimal point in the rep.
+     * If *precisionPtr == 0, then use TclDoubleDigits to develop a decimal
+     * significand and exponent, then format it in E or F format as
+     * appropriate.  If *precisionPtr != 0, use the native sprintf and then
+     * add a trailing ".0" if there is no decimal point in the rep.
      */
 
-    if ( prec == 0 ) {
+    if ( *precisionPtr == 0 ) {
 	/*
 	 * Handle NaN.
 	 */
@@ -1935,7 +1927,6 @@
 	if (signum) {
 	    *dst++ = '-';
 	}
-	prec = strlen(buffer);
 	p = buffer;
 	if (exp < -3 || exp > 17) {
 	    /*
@@ -1989,7 +1980,7 @@
 	 * tcl_precision is supplied, pass it to the native sprintf.
 	 */
 
-	sprintf(dst, "%.*g", prec, value);
+	sprintf(dst, "%.*g", *precisionPtr, value);
 
 	/*
 	 * If the ASCII result looks like an integer, add ".0" so that it
@@ -2047,6 +2038,7 @@
 {
     Tcl_Obj* value;
     int prec;
+    int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int)sizeof(int));
 
     /*
      * If the variable is unset, then recreate the trace.
@@ -2069,10 +2061,8 @@
 
 
     if (flags & TCL_TRACE_READS) {
-	Tcl_MutexLock(&precisionMutex);
-	Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(precision),
+	Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(*precisionPtr),
 		flags & TCL_GLOBAL_ONLY);
-	Tcl_MutexUnlock(&precisionMutex);
 	return (char *) NULL;
     }
 
@@ -2083,10 +2073,6 @@
      */
 
     if (Tcl_IsSafe(interp)) {
-	Tcl_MutexLock(&precisionMutex);
-	Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(precision),
-		flags & TCL_GLOBAL_ONLY);
-	Tcl_MutexUnlock(&precisionMutex);
 	return "can't modify precision from a safe interpreter";
     }
     value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
@@ -2095,9 +2081,7 @@
 	    || prec < 0 || prec > TCL_MAX_PREC) {
 	return "improper value for precision";
     }
-    Tcl_MutexLock(&precisionMutex);
-    precision = prec;
-    Tcl_MutexUnlock(&precisionMutex);
+    *precisionPtr = prec;
     return (char *) NULL;
 }