Update Tcl_Time for 32-bit systems and win64, being able to handle ti…

…me > 2038. Suggested in in ticket [86dd172271]
tcltk · Aug 24, 2023 · 4ca6172 · 4ca6172
1 parent 4a4195d
commit 4ca6172
Show file tree

Hide file tree

Showing 8 changed files with 38 additions and 30 deletions.
diff --git a/generic/tcl.h b/generic/tcl.h
@@ -1295,8 +1295,16 @@ typedef enum {
  */
 
 typedef struct Tcl_Time {
+#if TCL_MAJOR_VERSION > 8
+    long long sec;		/* Seconds. */
+#else
     long sec;			/* Seconds. */
+#endif
+#if defined(_WIN32) && TCL_MAJOR_VERSION > 8
+    long long usec;		/* Microseconds. */
+#else
     long usec;			/* Microseconds. */
+#endif
 } Tcl_Time;
 
 typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr);

diff --git a/generic/tclClock.c b/generic/tclClock.c
@@ -1761,7 +1761,7 @@ ClockClicksObjCmd(
     switch (index) {
     case CLICKS_MILLIS:
 	Tcl_GetTime(&now);
-	clicks = (Tcl_WideInt)(unsigned long)now.sec * 1000 + now.usec / 1000;
+	clicks = (Tcl_WideInt)(unsigned long long)now.sec * 1000 + now.usec / 1000;
 	break;
     case CLICKS_NATIVE:
 #ifdef TCL_WIDE_CLICKS
@@ -2039,7 +2039,7 @@ TzsetIfNecessary(void)
 {
     static WCHAR* tzWas = (WCHAR *)INT2PTR(-1);	 /* Previous value of TZ, protected by
 					  * clockMutex. */
-    static long	 tzLastRefresh = 0;	 /* Used for latency before next refresh */
+    static long long tzLastRefresh = 0;	 /* Used for latency before next refresh */
     static size_t tzEnvEpoch = 0;        /* Last env epoch, for faster signaling,
 					    that TZ changed via TCL */
     const WCHAR *tzIsNow;		 /* Current value of TZ */

diff --git a/generic/tclDecls.h b/generic/tclDecls.h
@@ -3975,9 +3975,9 @@ extern const TclStubs *tclStubsPtr;
 	TCL_ENCODING_PROFILE_TCL8, (ds), NULL), Tcl_DStringValue(ds))
 
 #if defined(USE_TCL_STUBS)
-#   if defined(_WIN32) && defined(_WIN64)
+#   if defined(_WIN32) && defined(_WIN64) && TCL_MAJOR_VERSION < 9
 #	undef Tcl_GetTime
-/* Handle Win64 tk.dll being loaded in Cygwin64. */
+/* Handle Win64 tk.dll being loaded in Cygwin64 (only needed for Tcl 8). */
 #	define Tcl_GetTime(t) \
 		do { \
 		    struct { \

diff --git a/generic/tclInterp.c b/generic/tclInterp.c
@@ -4831,14 +4831,14 @@ ChildTimeLimitCmd(
 		if (TclGetWideIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
 		    return TCL_ERROR;
 		}
-		if (tmp < 0 || tmp > LONG_MAX) {
-		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			    "milliseconds must be between 0 and %ld", LONG_MAX));
+		if (tmp < 0) {
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "milliseconds must be non-negative", -1));
 		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
 			    "BADVALUE", NULL);
 		    return TCL_ERROR;
 		}
-		limitMoment.usec = ((long)tmp)*1000;
+		limitMoment.usec = tmp*1000;
 		break;
 	    case OPT_SEC:
 		secObj = objv[i+1];
@@ -4849,14 +4849,14 @@ ChildTimeLimitCmd(
 		if (TclGetWideIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
 		    return TCL_ERROR;
 		}
-		if (tmp < 0 || tmp > LONG_MAX) {
-		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			    "seconds must be between 0 and %ld", LONG_MAX));
+		if (tmp < 0) {
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "seconds must be non-negative", -1));
 		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
 			    "BADVALUE", NULL);
 		    return TCL_ERROR;
 		}
-		limitMoment.sec = (long)tmp;
+		limitMoment.sec = (long long)tmp;
 		break;
 	    }
 	}

diff --git a/generic/tclTimer.c b/generic/tclTimer.c
@@ -117,19 +117,19 @@ static Tcl_ThreadDataKey dataKey;
  * side-effect free. The "prototypes" for these macros are:
  *
  * static int	TCL_TIME_BEFORE(Tcl_Time t1, Tcl_Time t2);
- * static long	TCL_TIME_DIFF_MS(Tcl_Time t1, Tcl_Time t2);
+ * static Tcl_WideInt TCL_TIME_DIFF_MS(Tcl_Time t1, Tcl_Time t2);
  */
 
 #define TCL_TIME_BEFORE(t1, t2) \
     (((t1).sec<(t2).sec) || ((t1).sec==(t2).sec && (t1).usec<(t2).usec))
 
 #define TCL_TIME_DIFF_MS(t1, t2) \
     (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
-	    ((long)(t1).usec - (long)(t2).usec)/1000)
+	    ((t1).usec - (t2).usec)/1000)
 
 #define TCL_TIME_DIFF_MS_CEILING(t1, t2) \
     (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
-	    ((long)(t1).usec - (long)(t2).usec + 999)/1000)
+	    ((t1).usec - (t2).usec + 999)/1000)
 
 /*
  * Sleeps under that number of milliseconds don't get double-checked
@@ -866,8 +866,8 @@ Tcl_AfterObjCmd(
 	afterPtr->id = tsdPtr->afterId;
 	tsdPtr->afterId += 1;
 	Tcl_GetTime(&wakeup);
-	wakeup.sec += (long)(ms / 1000);
-	wakeup.usec += ((long)(ms % 1000)) * 1000;
+	wakeup.sec += ms / 1000;
+	wakeup.usec += ms % 1000 * 1000;
 	if (wakeup.usec > 1000000) {
 	    wakeup.sec++;
 	    wakeup.usec -= 1000000;
@@ -1014,8 +1014,8 @@ AfterDelay(
 
     Tcl_GetTime(&now);
     endTime = now;
-    endTime.sec += (long)(ms / 1000);
-    endTime.usec += ((int)(ms % 1000)) * 1000;
+    endTime.sec += (ms / 1000);
+    endTime.usec += (ms % 1000) * 1000;
     if (endTime.usec >= 1000000) {
 	endTime.sec++;
 	endTime.usec -= 1000000;
@@ -1047,7 +1047,7 @@ AfterDelay(
                 diff = 1;
             }
 	    if (diff > 0) {
-		Tcl_Sleep((long) diff);
+		Tcl_Sleep((int) diff);
                 if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) {
                     break;
                 }

diff --git a/tests/interp.test b/tests/interp.test
@@ -3524,7 +3524,7 @@ test interp-35.19 {interp limit syntax} -body {
     interp limit $i time -seconds -1
 } -cleanup {
     interp delete $i
-} -match glob -returnCodes error -result {seconds must be between 0 and *}
+} -returnCodes error -result {seconds must be non-negative}
 test interp-35.20 {interp limit syntax} -body {
     set i [interp create]
     interp limit $i time -millis foobar
@@ -3536,7 +3536,7 @@ test interp-35.21 {interp limit syntax} -body {
     interp limit $i time -millis -1
 } -cleanup {
     interp delete $i
-} -match glob -returnCodes error -result {milliseconds must be between 0 and *}
+} -returnCodes error -result {milliseconds must be non-negative}
 test interp-35.22 {interp time limits normalize milliseconds} -body {
     set i [interp create]
     interp limit $i time -seconds 1 -millis 1500

diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c
@@ -95,7 +95,7 @@ TclpGetMicroseconds(void)
     Tcl_Time time;
 
     GetTime(&time);
-    return ((long long)(unsigned long) time.sec)*1000000 + time.usec;
+    return time.sec * 1000000 + time.usec;
 }
 
 /*

diff --git a/win/tclWinTime.c b/win/tclWinTime.c
@@ -178,7 +178,7 @@ TclpGetSeconds(void)
 	Tcl_Time t;
 
 	GetTime(&t);
-	return (unsigned long long)(unsigned long) t.sec;
+	return (unsigned long long)t.sec;
     }
 }
 
@@ -347,7 +347,7 @@ TclpGetMicroseconds(void)
 	Tcl_Time now;
 
 	GetTime(&now);
-	return (((long long) now.sec) * 1000000) + now.usec;
+	return now.sec * 1000000 + now.usec;
     }
 }
 
@@ -384,8 +384,8 @@ Tcl_GetTime(
      */
 
     if (IsTimeNative() && (usecSincePosixEpoch = NativeGetMicroseconds())) {
-	timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
-	timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
+	timePtr->sec = usecSincePosixEpoch / 1000000;
+	timePtr->usec = usecSincePosixEpoch % 1000000;
     } else {
 	GetTime(timePtr);
     }
@@ -687,8 +687,8 @@ NativeGetTime(
 
     usecSincePosixEpoch = NativeGetMicroseconds();
     if (usecSincePosixEpoch) {
-	timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
-	timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
+	timePtr->sec = usecSincePosixEpoch / 1000000;
+	timePtr->usec = usecSincePosixEpoch % 1000000;
     } else {
 	/*
 	 * High resolution timer is not available. Just use ftime.
@@ -697,7 +697,7 @@ NativeGetTime(
 	struct _timeb t;
 
 	_ftime(&t);
-	timePtr->sec = (long) t.time;
+	timePtr->sec = t.time;
 	timePtr->usec = t.millitm * 1000;
     }
 }