merge trunk

11 files changed, 79 insertions, 45 deletions

diff --git a/compat/fake-rfc2553.h b/compat/fake-rfc2553.h
index cc26f55..6413170 100644
--- a/compat/fake-rfc2553.h
+++ b/compat/fake-rfc2553.h
@@ -1,7 +1,7 @@
 /*
  * Copyright (C) 2000-2003 Damien Miller.  All rights reserved.
  * Copyright (C) 1999 WIDE Project.  All rights reserved.
- * 
+ *
  * Redistribution and use in source and binary forms, with or without
  * modification, are permitted provided that the following conditions
  * are met:
@@ -13,7 +13,7 @@
  * 3. Neither the name of the project nor the names of its contributors
  *    may be used to endorse or promote products derived from this software
  *    without specific prior written permission.
- * 
+ *
  * THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
@@ -39,7 +39,7 @@
 #define _FAKE_RFC2553_H
 
 /*
- * First, socket and INET6 related definitions 
+ * First, socket and INET6 related definitions
  */
 #ifndef HAVE_STRUCT_SOCKADDR_STORAGE
 # define	_SS_MAXSIZE	128	/* Implementation specific max size */
@@ -146,7 +146,7 @@ struct addrinfo {
 # undef getaddrinfo
 #endif
 #define getaddrinfo(a,b,c,d)    (fake_getaddrinfo(a,b,c,d))
-int getaddrinfo(const char *, const char *, 
+int getaddrinfo(const char *, const char *,
     const struct addrinfo *, struct addrinfo **);
 #endif /* !HAVE_GETADDRINFO */
 
@@ -162,7 +162,7 @@ void freeaddrinfo(struct addrinfo *);
 
 #ifndef HAVE_GETNAMEINFO
 #define getnameinfo(a,b,c,d,e,f,g) (fake_getnameinfo(a,b,c,d,e,f,g))
-int getnameinfo(const struct sockaddr *, size_t, char *, size_t, 
+int getnameinfo(const struct sockaddr *, size_t, char *, size_t,
     char *, size_t, int);
 #endif /* !HAVE_GETNAMEINFO */
 
diff --git a/compat/unistd.h b/compat/unistd.h
index 2de5bd0..a8f14f2 100644
--- a/compat/unistd.h
+++ b/compat/unistd.h
@@ -20,7 +20,7 @@
 #define NULL    0
 #endif
 
-/* 
+/*
  * Strict POSIX stuff goes here. Extensions go down below, in the ifndef
  * _POSIX_SOURCE section.
  */
diff --git a/generic/tcl.h b/generic/tcl.h
index e938328..e059a67 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1913,7 +1913,7 @@ typedef struct Tcl_EncodingType {
  *				Tcl_ExternalToUtf takes the initial value
  *				of *dstCharsPtr is taken as a limit of the
  *				maximum number of chars to produce in the
- *				encoded UTF-8 content.  Otherwise, the 
+ *				encoded UTF-8 content.  Otherwise, the
  *				number of chars produced is controlled only
  *				by other limiting factors.
  */
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 800e6af..39b5c6b 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1171,7 +1171,7 @@ MODULE_SCOPE void	TclPushVarName(Tcl_Interp *interp,
 			    int flags, int *localIndexPtr,
 			    int *isScalarPtr);
 MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
-MODULE_SCOPE void	TclInvalidateCmdLiteral(Tcl_Interp *interp, 
+MODULE_SCOPE void	TclInvalidateCmdLiteral(Tcl_Interp *interp,
 			    const char *name, Namespace *nsPtr);
 MODULE_SCOPE int	TclSingleOpCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
@@ -1194,7 +1194,7 @@ MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
 MODULE_SCOPE void	TclLogCommandInfo(Tcl_Interp *interp,
 			    const char *script, const char *command,
 			    int length, const unsigned char *pc,
-			    Tcl_Obj **tosPtr); 
+			    Tcl_Obj **tosPtr);
 MODULE_SCOPE Tcl_Obj	*TclGetInnerContext(Tcl_Interp *interp,
 			    const unsigned char *pc, Tcl_Obj **tosPtr);
 MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
@@ -1660,7 +1660,7 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 
 #define PushVarNameWord(i,v,e,f,l,sc,word) \
     SetLineInformation(word);						\
-    TclPushVarName(i,v,e,f,l,sc)					
+    TclPushVarName(i,v,e,f,l,sc)
 
 /*
  * Often want to issue one of two versions of an instruction based on whether
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 107a966..5a871be 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3002,7 +3002,7 @@ CloseChannel(
 
     if (chanPtr == statePtr->bottomChanPtr) {
 	if (statePtr->channelName != NULL) {
-	    ckfree(statePtr->channelName);
+	    ckfree((char *)statePtr->channelName);
 	    statePtr->channelName = NULL;
 	}
 
diff --git a/generic/tclIO.h b/generic/tclIO.h
index ca74c3e..7aa07eb 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -126,7 +126,7 @@ typedef struct Channel {
  */
 
 typedef struct ChannelState {
-    const char *channelName;	/* The name of the channel instance in Tcl
+    char *channelName;	/* The name of the channel instance in Tcl
 				 * commands. Storage is owned by the generic
 				 * IO code, is dynamically allocated. */
     int	flags;			/* ORed combination of the flags defined
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 1eae1fc..16a1a58 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -2874,9 +2874,13 @@ int
 Tcl_FSChdir(
     Tcl_Obj *pathPtr)
 {
-    const Tcl_Filesystem *fsPtr;
+    const Tcl_Filesystem *fsPtr, *oldFsPtr = NULL;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
     int retVal = -1;
 
+    if (tsdPtr->cwdPathPtr != NULL) {
+	oldFsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
+    }
     if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) {
 	Tcl_SetErrno(ENOENT);
 	return retVal;
@@ -2976,7 +2980,6 @@ Tcl_FSChdir(
 	     * instead. This should be examined by someone on Unix.
 	     */
 
-	    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
 	    ClientData cd;
 	    ClientData oldcd = tsdPtr->cwdClientData;
 
@@ -2993,6 +2996,14 @@ Tcl_FSChdir(
 	} else {
 	    FsUpdateCwd(normDirName, NULL);
 	}
+
+	/*
+	 * If the filesystem changed between old and new cwd
+	 * force filesystem refresh on path objects.
+	 */
+	if (oldFsPtr != NULL && fsPtr != oldFsPtr) {
+	    Tcl_FSMountsChanged(NULL);
+	}
     }
 
     return retVal;
@@ -3134,7 +3145,7 @@ TclSkipUnlink (Tcl_Obj* shlibFile)
      *
      * Ad 2: This variable can disable/override the AUFS detection, i.e. for
      * testing if a newer AUFS does not have the bug any more.
-     * 
+     *
      * Ad 3: This is conditionally compiled in. Condition currently must be set manually.
      *       This part needs proper tests in the configure(.in).
      */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index d076ae1..9a0e346 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1177,25 +1177,25 @@ typedef struct CmdFrame {
      *
      * Field	  TEBC		  EvalEx
      * =======	  ====		  ======
-     * level	  yes		  yes	
+     * level	  yes		  yes
      * type	  BC/PREBC	  SRC/EVAL
-     * line0	  yes		  yes	
-     * framePtr	  yes		  yes	
+     * line0	  yes		  yes
+     * framePtr	  yes		  yes
      * =======	  ====		  ======
      *
      * =======	  ====		  ========= union data
-     * line1	  -		  yes	
-     * line3	  -		  yes	
-     * path	  -		  yes	
+     * line1	  -		  yes
+     * line3	  -		  yes
+     * path	  -		  yes
      * -------	  ----		  ------
-     * codePtr	  yes		  -	
-     * pc	  yes		  -	
+     * codePtr	  yes		  -
+     * pc	  yes		  -
      * =======	  ====		  ======
      *
      * =======	  ====		  ========= union cmd
-     * str.cmd	  yes		  yes	
-     * str.len	  yes		  yes	
-     * -------	  ----		  ------	
+     * str.cmd	  yes		  yes
+     * str.len	  yes		  yes
+     * -------	  ----		  ------
      */
 
     union {
@@ -3179,15 +3179,15 @@ MODULE_SCOPE Tcl_Obj *	TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
 MODULE_SCOPE int	Tcl_DisassembleObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-			    
-/* Assemble command function */			    
+
+/* Assemble command function */
 MODULE_SCOPE int	Tcl_AssembleObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);			    
+			    Tcl_Obj *const objv[]);
 MODULE_SCOPE int	TclNRAssembleObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);			    
-			    
+			    Tcl_Obj *const objv[]);
+
 MODULE_SCOPE int	Tcl_EncodingObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -3858,7 +3858,7 @@ MODULE_SCOPE int	TclStreqOpCmd(ClientData clientData,
 MODULE_SCOPE int	TclCompileStreqOpCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
-			    
+
 MODULE_SCOPE int	TclCompileAssembleCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 61215de..f586e8c 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -1351,7 +1351,7 @@ CloneProcedureMethod(
 /*
  * ----------------------------------------------------------------------
  *
- * TclOONewForwardMethod --
+ * TclOONewForwardInstanceMethod --
  *
  *	Create a forwarded method for an object.
  *
@@ -1369,7 +1369,6 @@ TclOONewForwardInstanceMethod(
 {
     int prefixLen;
     register ForwardMethod *fmPtr;
-    Tcl_Obj *cmdObj;
 
     if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
 	return NULL;
@@ -1383,7 +1382,6 @@ TclOONewForwardInstanceMethod(
 
     fmPtr = ckalloc(sizeof(ForwardMethod));
     fmPtr->prefixObj = prefixObj;
-    Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
     Tcl_IncrRefCount(prefixObj);
     return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr,
 	    nameObj, flags, &fwdMethodType, fmPtr);
@@ -1410,7 +1408,6 @@ TclOONewForwardMethod(
 {
     int prefixLen;
     register ForwardMethod *fmPtr;
-    Tcl_Obj *cmdObj;
 
     if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
 	return NULL;
@@ -1424,7 +1421,6 @@ TclOONewForwardMethod(
 
     fmPtr = ckalloc(sizeof(ForwardMethod));
     fmPtr->prefixObj = prefixObj;
-    Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
     Tcl_IncrRefCount(prefixObj);
     return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj,
 	    flags, &fwdMethodType, fmPtr);
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 30a72ba..a18c8ef 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -1478,7 +1478,7 @@ MakeLowPrecisionDouble(
      * Test for the easy cases.
      */
 
-    if (numSigDigs <= DBL_DIG) {
+    if (numSigDigs <= QUICK_MAX) {
 	if (exponent >= 0) {
 	    if (exponent <= mmaxpow) {
 		/*
@@ -1491,7 +1491,7 @@ MakeLowPrecisionDouble(
 			((Tcl_WideInt)significand * pow10vals[exponent]);
 		goto returnValue;
 	    } else {
-		int diff = DBL_DIG - numSigDigs;
+		int diff = QUICK_MAX - numSigDigs;
 
 		if (exponent-diff <= mmaxpow) {
 		    /*
@@ -1728,6 +1728,12 @@ RefineApproximation(
     double quot;		/* Correction term. */
     double minincr;		/* Lower bound on the absolute value of the
 				 * correction term. */
+    int roundToEven;		/* Flag == TRUE if we need to invoke
+				 * "round to even" functionality */
+    double rteSignificand;	/* Significand of the round-to-even result */
+    int rteExponent;		/* Exponent of the round-to-even result */
+    Tcl_WideInt rteSigWide;	/* Wide integer version of the significand
+				 * for testing evenness */
     int i;
 
     /*
@@ -1823,17 +1829,34 @@ RefineApproximation(
 	mp_div_2d(&twoMv, -multiplier, &twoMv, NULL);
     }
 
-    /*
-     * If the result is less than unity, the error is less than 1/2 unit in
-     * the last place, so there's no correction to make.
-     */
-
-    if (mp_cmp_mag(&twoMd, &twoMv) == MP_LT) {
+    switch (mp_cmp_mag(&twoMd, &twoMv)) {
+    case MP_LT:
+	/*
+	 * If the result is less than unity, the error is less than 1/2 unit in
+	 * the last place, so there's no correction to make.
+	 */
 	mp_clear(&twoMd);
 	mp_clear(&twoMv);
 	return approxResult;
+    case MP_EQ:
+	/*
+	 * If the result is exactly unity, we need to round to even.
+	 */
+	roundToEven = 1;
+	break;
+    case MP_GT:
+	roundToEven = 0;
+	break;
     }
 
+    if (roundToEven) {
+	rteSignificand = frexp(approxResult, &rteExponent);
+	rteSigWide = (Tcl_WideInt) ldexp(rteSignificand, FP_PRECISION);
+	if ((rteSigWide & 1) == 0) {
+	    return approxResult;
+	}
+    }	
+
     /*
      * Convert the numerator and denominator of the corrector term accurately
      * to floating point numbers.
diff --git a/tests/expr.test b/tests/expr.test
index 29fb967..6fb3b76 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -7134,6 +7134,10 @@ test expr-50.1 {test sqrt() of bignums with non-Inf answer} {
     expr {sqrt("1[string repeat 0 616]") == 1e308}
 } 1
 
+test expr-51.1 {test round-to-even on input} {
+    expr 6.9294956446009195e15
+} 6929495644600920.0
+
 
 
 # cleanup