Further changes to the TIP 72 patch to make it compile under VC++

10 files changed, 81 insertions, 21 deletions

diff --git a/ChangeLog b/ChangeLog
index 8591a93..bb3063b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2002-02-15  Kevin Kenny  <kennykb@acm.org>
+
+	* compat/strtoll.c:
+	* compat/strtoul.c:
+	* compat/strtoull.c:
+	* generic/tclIOUtil.c:
+	* generic/tclPosixStr.c:
+	* generic/tclTest.c:
+	* generic/tclTestObj.c:
+	* tests/get.test:
+	* win/Makefile.vc: Further tweaks to the TIP 72 patch to make it
+	compile under VC++.
+	
 2002-02-15  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
 
 	* tclExecute.c:
diff --git a/compat/strtoll.c b/compat/strtoll.c
index 2872006..1105040 100644
--- a/compat/strtoll.c
+++ b/compat/strtoll.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: strtoll.c,v 1.2 2002/02/15 14:28:47 dkf Exp $
+ * RCS: @(#) $Id: strtoll.c,v 1.3 2002/02/15 23:42:12 kennykb Exp $
  */
 
 #include "tcl.h"
@@ -82,7 +82,7 @@ strtoll(string, endPtr, base)
 	    } else if (uwResult > TCL_WIDEINT_MAX) {
 		return ~((Tcl_WideInt)TCL_WIDEINT_MAX);
 	    } else {
-		result = -uwResult;
+		result = -((Tcl_WideInt) uwResult);
 	    }
 	}
     } else {
diff --git a/compat/strtoul.c b/compat/strtoul.c
index 3b7918c..e31299d 100644
--- a/compat/strtoul.c
+++ b/compat/strtoul.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: strtoul.c,v 1.2 1998/09/14 18:39:45 stanton Exp $
+ * RCS: @(#) $Id: strtoul.c,v 1.3 2002/02/15 23:42:12 kennykb Exp $
  */
 
 #include <ctype.h>
@@ -152,14 +152,14 @@ strtoul(string, endPtr, base)
 	    result = (result << 4) + digit;
 	    anyDigits = 1;
 	}
-    } else {
+    } else if ( base >= 2 && base <= 36 ) {
 	for ( ; ; p += 1) {
 	    digit = *p - '0';
 	    if (digit > ('z' - '0')) {
 		break;
 	    }
 	    digit = cvtIn[digit];
-	    if (digit >= base) {
+	    if (digit >= ( (unsigned) base )) {
 		break;
 	    }
 	    result = result*base + digit;
diff --git a/compat/strtoull.c b/compat/strtoull.c
index 8658eb0..af508d0 100644
--- a/compat/strtoull.c
+++ b/compat/strtoull.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: strtoull.c,v 1.2 2002/02/15 14:28:47 dkf Exp $
+ * RCS: @(#) $Id: strtoull.c,v 1.3 2002/02/15 23:42:12 kennykb Exp $
  */
 
 #include "tcl.h"
@@ -149,6 +149,9 @@ strtoull(string, endPtr, base)
 		goto overflow;
 	    }
 	    result = shifted + digit;
+	    if ( result < shifted ) {
+		goto overflow;
+	    }
 	    anyDigits = 1;
 	}
     } else if (base == 10) {
@@ -162,6 +165,9 @@ strtoull(string, endPtr, base)
 		goto overflow;
 	    }
 	    result = shifted + digit;
+	    if ( result < shifted ) {
+		goto overflow;
+	    }
 	    anyDigits = 1;
 	}
     } else if (base == 16) {
@@ -179,16 +185,19 @@ strtoull(string, endPtr, base)
 		goto overflow;
 	    }
 	    result = shifted + digit;
+	    if ( result < shifted ) {
+		goto overflow;
+	    }
 	    anyDigits = 1;
 	}
-    } else {
+    } else if ( base >= 2 && base <= 36 ) {
 	for ( ; ; p += 1) {
 	    digit = *p - '0';
 	    if (digit > ('z' - '0')) {
 		break;
 	    }
 	    digit = cvtIn[digit];
-	    if (digit >= base) {
+	    if (digit >= (unsigned) base) {
 		break;
 	    }
 	    shifted = result * base;
@@ -196,6 +205,9 @@ strtoull(string, endPtr, base)
 		goto overflow;
 	    }
 	    result = shifted + digit;
+	    if ( result < shifted ) {
+		goto overflow;
+	    }
 	    anyDigits = 1;
 	}
     }
@@ -235,7 +247,7 @@ strtoull(string, endPtr, base)
 		break;
 	    }
 	    digit = cvtIn[digit];
-	    if (digit >= base) {
+	    if (digit >= (unsigned) base) {
 		break;
 	    }
 	}
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index bdea467..2172bfd 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOUtil.c,v 1.35 2002/02/15 14:28:49 dkf Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.36 2002/02/15 23:42:12 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -106,8 +106,19 @@ Tcl_Stat(path, oldStyleBuf)
 	 */
 
         if (OUT_OF_URANGE(buf.st_ino) || OUT_OF_RANGE(buf.st_size)
-		|| OUT_OF_RANGE(buf.st_blocks)) {
+#ifdef HAVE_ST_BLOCKS
+		|| OUT_OF_RANGE(buf.st_blocks)
+#endif
+	    ) {
+#ifdef EFBIG
+	    errno = EFBIG;
+#else
+#  ifdef EOVERFLOW
 	    errno = EOVERFLOW;
+#  else
+#    error  "What status should be returned for file size out of range?"
+#  endif
+#endif
 	    return -1;
 	}
 
@@ -134,8 +145,10 @@ Tcl_Stat(path, oldStyleBuf)
 	oldStyleBuf->st_atime   = buf.st_atime;
 	oldStyleBuf->st_mtime   = buf.st_mtime;
 	oldStyleBuf->st_ctime   = buf.st_ctime;
+#ifdef HAVE_ST_BLOCKS
 	oldStyleBuf->st_blksize = buf.st_blksize;
 	oldStyleBuf->st_blocks  = (blkcnt_t) buf.st_blocks;
+#endif
     }
     return ret;
 }
@@ -1415,7 +1428,7 @@ Tcl_FSStat(pathPtr, buf)
 	 * assignments should all be widening (if not identity.)
 	 */
 	buf->st_mode = oldStyleStatBuffer.st_mode;
-	buf->st_ino = (Tcl_WideUInt) Tcl_LongAsWide(oldStyleStatBuffer.st_ino);
+	buf->st_ino = oldStyleStatBuffer.st_ino;
 	buf->st_dev = oldStyleStatBuffer.st_dev;
 	buf->st_rdev = oldStyleStatBuffer.st_rdev;
 	buf->st_nlink = oldStyleStatBuffer.st_nlink;
@@ -1425,8 +1438,10 @@ Tcl_FSStat(pathPtr, buf)
 	buf->st_atime = oldStyleStatBuffer.st_atime;
 	buf->st_mtime = oldStyleStatBuffer.st_mtime;
 	buf->st_ctime = oldStyleStatBuffer.st_ctime;
+#ifdef HAVE_ST_BLOCKS
 	buf->st_blksize = oldStyleStatBuffer.st_blksize;
 	buf->st_blocks = Tcl_LongAsWide(oldStyleStatBuffer.st_blocks);
+#endif
         return retVal;
     }
 #endif /* USE_OBSOLETE_FS_HOOKS */
diff --git a/generic/tclPosixStr.c b/generic/tclPosixStr.c
index 2af10b1..2dbe357 100644
--- a/generic/tclPosixStr.c
+++ b/generic/tclPosixStr.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclPosixStr.c,v 1.7 2002/01/15 21:19:07 dgp Exp $
+ * RCS: @(#) $Id: tclPosixStr.c,v 1.8 2002/02/15 23:42:12 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -339,6 +339,9 @@ Tcl_ErrnoId()
 #if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
 	case EOPNOTSUPP: return "EOPNOTSUPP";
 #endif
+#if defined(EOVERFLOW) && ( !defined(EFBIG) || (EOVERFLOW != EFBIG) )
+        case EOVERFLOW: return "EOVERFLOW";
+#endif
 #ifdef EPERM
 	case EPERM: return "EPERM";
 #endif
@@ -786,6 +789,9 @@ Tcl_ErrnoMsg(err)
 #if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
 	case EOPNOTSUPP: return "operation not supported on socket";
 #endif
+#if defined(EOVERFLOW) && ( !defined(EFBIG) || (EOVERFLOW != EFBIG) )
+        case EOVERFLOW: return "file too big";
+#endif
 #ifdef EPERM
 	case EPERM: return "not owner";
 #endif
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 7da18fd..4c34d31 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.44 2002/02/15 14:28:49 dkf Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.45 2002/02/15 23:42:12 kennykb Exp $
  */
 
 #define TCL_TEST
@@ -4347,8 +4347,19 @@ static int PretendTclpStat(path, buf)
 	 */
 
         if (OUT_OF_URANGE(realBuf.st_ino) || OUT_OF_RANGE(realBuf.st_size)
-		|| OUT_OF_RANGE(realBuf.st_blocks)) {
+#   ifdef HAVE_ST_BLOCKS
+		|| OUT_OF_RANGE(realBuf.st_blocks)
+#   endif
+	    ) {
+#   ifdef EOVERFLOW
 	    errno = EOVERFLOW;
+#   else
+#       ifdef EFBIG
+            errno = EFBIG;
+#       else
+#           error "what error should be returned for a value out of range?"
+#       endif
+#   endif
 	    return -1;
 	}
 
@@ -4374,8 +4385,10 @@ static int PretendTclpStat(path, buf)
 	buf->st_atime   = realBuf.st_atime;
 	buf->st_mtime   = realBuf.st_mtime;
 	buf->st_ctime   = realBuf.st_ctime;
+#   ifdef HAVE_ST_BLOCKS
 	buf->st_blksize = realBuf.st_blksize;
 	buf->st_blocks  = (blkcnt_t) realBuf.st_blocks;
+#   endif
     }
     return ret;
 #endif /* TCL_WIDE_INT_IS_LONG */
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 5d36cc0..ec489d6 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTestObj.c,v 1.10 2002/02/15 14:28:49 dkf Exp $
+ * RCS: @(#) $Id: tclTestObj.c,v 1.11 2002/02/15 23:42:12 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -465,7 +465,8 @@ TestindexobjCmd(clientData, interp, objc, objv)
      * the index object, clear out the object's cached state.
      */
 
-    if (objv[3]->typePtr == &tclIndexType) {
+    if ( objv[3]->typePtr != NULL
+	 && !strcmp( "index", objv[3]->typePtr->name ) ) {
 	indexRep = (struct IndexRep *) objv[3]->internalRep.otherValuePtr;
 	if (indexRep->tablePtr == (VOID *) argv) {
 	    objv[3]->typePtr->freeIntRepProc(objv[3]);
diff --git a/tests/get.test b/tests/get.test
index a2efcea..0d9bea8 100644
--- a/tests/get.test
+++ b/tests/get.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: get.test,v 1.6 2002/02/15 14:28:50 dkf Exp $
+# RCS: @(#) $Id: get.test,v 1.7 2002/02/15 23:42:12 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -48,7 +48,7 @@ test get-1.6 {Tcl_GetInt procedure} {
 if {wide(0x80000000) > wide(0)} {
     test get-1.7 {Tcl_GetInt procedure} {
 	set x 44
-	list [catch {incr x 18446744073709551616} msg] $msg $errorCode
+	list [catch {eval incr x 18446744073709551616} msg] $msg $errorCode
     } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
     test get-1.8 {Tcl_GetInt procedure} {
 	set x 0
diff --git a/win/makefile.vc b/win/makefile.vc
index 430671d..a15edd2 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -12,7 +12,7 @@
 # Copyright (c) 2001 Tomasoft Engineering.
 #
 #------------------------------------------------------------------------------
-# RCS: @(#) $Id: makefile.vc,v 1.78 2002/02/15 14:28:51 dkf Exp $
+# RCS: @(#) $Id: makefile.vc,v 1.79 2002/02/15 23:42:12 kennykb Exp $
 #------------------------------------------------------------------------------
 
 !if "$(MSVCDIR)" == ""
@@ -219,7 +219,7 @@ TCLOBJS = \
 	$(TMP_DIR)\regerror.obj \
 	$(TMP_DIR)\strftime.obj \
 	$(TMP_DIR)\strtoll.obj \
-	$(TMP_DIR)\strtoul.obj
+	$(TMP_DIR)\strtoull.obj \
 	$(TMP_DIR)\tclAlloc.obj \
 	$(TMP_DIR)\tclAsync.obj \
 	$(TMP_DIR)\tclBasic.obj \