Merge 9.0

Author: jan.nijtmans

.github/workflows/mac-build.yml

@@ -11,7 +11,7 @@ permissions:
   contents: read
 jobs:
   xcode:
-    runs-on: macos-14
+    runs-on: macos-15
     defaults:
       run:
         shell: bash
@@ -36,7 +36,7 @@ jobs:
           MAC_CI: 1
         timeout-minutes: 15
   clang:
-    runs-on: macos-14
+    runs-on: macos-15
     strategy:
       matrix:
         config:

doc/timerate.n

@@ -78,10 +78,10 @@ implementation.
 .
 The \fB\-overhead\fR parameter supplies an estimate (in microseconds, which may
 be a floating point number) of the
-measurement overhead of each iteration of the tested script. This quantity
-will be subtracted from the measured time prior to reporting results. This can
-be useful for removing the cost of interpreter state reset commands from the
-script being measured.
+measurement overhead of each iteration of the tested script. The passed value
+overrides, for the current invocation of \fBtimerate\fR, the overhead
+estimated by a previous calibration. Overrides may themselves be measured
+using \fBtimerate\fR as illustrated by a later example.
 .\" OPTION: -direct
 .TP
 \fB\-direct\fR
@@ -134,7 +134,7 @@ it to calculate:
 
 \fI# estimate overhead\fR
 set tm 0
-set ovh [lindex [\fBtimerate\fR {
+set ovh [lindex [\fBtimerate -overhead 0\fR {
     incr tm [expr {24*60*60}]
 }] 0]
 
@@ -145,6 +145,14 @@ set tm 0
     incr tm [expr {24*60*60}]; # overhead for this is ignored
 } 5000
 .CE
+.PP
+In this last example, note that the overhead itself is measured using
+\fBtimerate\fR invoked with \fB-overhead 0\fR. This is necessary
+because explicit overheads are assumed to be absolute values,
+and not an increment over the default calibrated overhead. It is
+therefore important that the calibrated overhead is excluded in the
+measurement of the overhead value itself. This is accomplished by
+passing \fB-overhead 0\fR when measuring the overhead.
 .SH "SEE ALSO"
 time(n)
 .SH KEYWORDS

generic/tclCmdMZ.c

@@ -4134,18 +4134,30 @@ Tcl_TimeRateObjCmd(
     int result, i;
     Tcl_Obj *calibrate = NULL, *direct = NULL;
     Tcl_WideUInt count = 0;	/* Holds repetition count */
+    Tcl_WideUInt lastCount = 0;	/* Repetition count since last calculation. */
     Tcl_WideInt maxms = WIDE_MIN;
 				/* Maximal running time (in milliseconds) */
-    Tcl_WideUInt maxcnt = WIDE_MAX;
+    Tcl_WideUInt maxcnt = UWIDE_MAX;
 				/* Maximal count of iterations. */
     Tcl_WideUInt threshold = 1;	/* Current threshold for check time (faster
 				 * repeat count without time check) */
-    Tcl_WideUInt maxIterTm = 1;	/* Max time of some iteration as max
-				 * threshold, additionally avoiding divide to
-				 * zero (i.e., never < 1) */
-    unsigned short factor = 50;	/* Factor (4..50) limiting threshold to avoid
+    Tcl_WideUInt avgIterTm = 1;	/* Average time of all processed iterations. */
+    Tcl_WideUInt lastIterTm = 1;/* Average time of last block of iterations. */
+    double estIterTm = 1.0;	/* Estimated time of next iteration,
+				 * considering the growth of lastIterTm. */
+#ifdef TCL_WIDE_CLICKS
+#   define TR_SCALE 10		/* Fraction is 10ns (from wide click 100ns). */
+#else
+#   define TR_SCALE 100		/* Fraction is 10ns (from 1us = 1000ns). */
+#endif
+#define TR_MIN_FACTOR 2		/* Min allowed factor calculating threshold. */
+#define TR_MAX_FACTOR 50	/* Max allowed factor calculating threshold. */
+#define TR_FACT_SINGLE_ITER 25  /* This or larger factor value will force the
+				 * threshold 1, to avoid drastic growth of
+				 * execution time by quadratic O() complexity. */
+    unsigned short factor = 16;	/* Factor (2..50) limiting threshold to avoid
 				 * growth of execution time. */
-    Tcl_WideInt start, middle, stop;
+    Tcl_WideInt start, last, middle, stop;
 #ifndef TCL_WIDE_CLICKS
     Tcl_Time now;
 #endif /* !TCL_WIDE_CLICKS */
@@ -4351,7 +4363,7 @@ Tcl_TimeRateObjCmd(
      */
 
 #ifdef TCL_WIDE_CLICKS
-    start = middle = TclpGetWideClicks();
+    start = last = middle = TclpGetWideClicks();
 
     /*
      * Time to stop execution (in wide clicks).
@@ -4363,7 +4375,7 @@ Tcl_TimeRateObjCmd(
     start = now.sec;
     start *= 1000000;
     start += now.usec;
-    middle = start;
+    last = middle = start;
 
     /*
      * Time to stop execution (in microsecs).
@@ -4444,61 +4456,93 @@ Tcl_TimeRateObjCmd(
 	    }
 
 	    /*
-	     * Don't calculate threshold by few iterations, because sometimes
-	     * first iteration(s) can be too fast or slow (cached, delayed
-	     * clean up, etc).
+	     * Average iteration time (scaled) in fractions of wide clicks
+	     * or microseconds.
 	     */
 
-	    if (count < 10) {
-		threshold = 1;
-		continue;
-	    }
-
-	    /*
-	     * Average iteration time in microsecs.
-	     */
-
-	    threshold = (middle - start) / count;
-	    if (threshold > maxIterTm) {
-		maxIterTm = threshold;
+	    threshold = (Tcl_WideUInt)(middle - start) * TR_SCALE / count;
+	    if (threshold > avgIterTm) {
 
 		/*
 		 * Iterations seem to be longer.
 		 */
 
-		if (threshold > maxIterTm * 2) {
+		if (threshold > avgIterTm * 2) {
 		    factor *= 2;
-		    if (factor > 50) {
-			factor = 50;
-		    }
 		} else {
-		    if (factor < 50) {
-			factor++;
-		    }
+		    factor++;
 		}
-	    } else if (factor > 4) {
+		if (factor > TR_MAX_FACTOR) {
+		    factor = TR_MAX_FACTOR;
+		}
+	    } else if (factor > TR_MIN_FACTOR) {
 		/*
 		 * Iterations seem to be shorter.
 		 */
 
-		if (threshold < (maxIterTm / 2)) {
+		if (threshold < (avgIterTm / 2)) {
 		    factor /= 2;
-		    if (factor < 4) {
-			factor = 4;
+		    if (factor < TR_MIN_FACTOR) {
+			factor = TR_MIN_FACTOR;
 		    }
 		} else {
 		    factor--;
 		}
 	    }
 
+	    if (!threshold) {
+		/* too short and too few iterations */
+		threshold = 1;
+		continue;
+	    }
+	    avgIterTm = threshold;
+
 	    /*
-	     * As relation between remaining time and time since last check,
-	     * maximal some % of time (by factor), so avoid growing of the
-	     * execution time if iterations are not consistent, e.g. was
-	     * continuously on time).
+	     * Estimate last iteration time growth and time of next iteration.
 	     */
+	    lastCount = count - lastCount;
+	    if (last != start && lastCount) {
+		Tcl_WideUInt lastTm;
+
+		lastTm = (Tcl_WideUInt)(middle - last) * TR_SCALE / lastCount;
+		estIterTm = (double)lastTm / (lastIterTm ? lastIterTm : avgIterTm);
+		lastIterTm = lastTm > avgIterTm ? lastTm : avgIterTm;
+	    } else {
+		lastIterTm = avgIterTm;
+	    }
+	    estIterTm *= lastIterTm;
+	    last = middle; lastCount = count;
 
-	    threshold = ((stop - middle) / maxIterTm) / factor + 1;
+	    /*
+	     * Calculate next threshold to check.
+	     * Firstly check iteration time is not larger than remaining time,
+	     * considering last known iteration growth factor.
+	     */
+	    threshold = (Tcl_WideUInt)(stop - middle) * TR_SCALE;
+	     /* 
+	      * Estimated count of iteration til the end of execution.
+	      * Thereby 2.5% longer execution time would be OK.
+	      */
+	    if (threshold / estIterTm < 0.975) {
+		/* estimated time for next iteration is too large */
+		break;
+	    }
+	    threshold /= estIterTm;
+	    /*
+	     * Don't use threshold by few iterations, because sometimes
+	     * first iteration(s) can be too fast or slow (cached, delayed
+	     * clean up, etc). Also avoid unexpected execution time growth,
+	     * so if iterations continuously grow, stay by single iteration.
+	     */
+	    if (count < 10 || factor >= TR_FACT_SINGLE_ITER) {
+		threshold = 1;
+		continue;
+	    }
+	    /*
+	     * Reduce it by last known factor, to avoid unexpected execution
+	     * time growth if iterations are not consistent (may be longer).
+	     */
+	    threshold = threshold / factor + 1;
 	    if (threshold > 100000) {	/* fix for too large threshold */
 		threshold = 100000;
 	    }
@@ -4648,6 +4692,10 @@ Tcl_TimeRateObjCmd(
 	TclReleaseByteCode(codePtr);
     }
     return result;
+#undef TR_SCALE
+#undef TR_MIN_FACTOR
+#undef TR_MAX_FACTOR
+#undef TR_FACT_SINGLE_ITER
 }
 
 /*

generic/tclIO.c

@@ -6446,10 +6446,21 @@ ReadChars(
 			|| BytesLeft(bufPtr->nextPtr) == 0 || 0 ==
 			(statePtr->inputEncodingFlags & TCL_ENCODING_END));
 
-		Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
-		(statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE),
-		&statePtr->inputEncodingState, buffer, sizeof(buffer),
-		&read, &decoded, &count);
+		/*
+		 * bug 73bb42fb: the result was not checked for an encoding error.
+		 * So, add a check as above for testing.
+		 * Leave eof check out, as typically only two characters are
+		 * handled.
+		 */
+
+		code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
+			(statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE),
+			&statePtr->inputEncodingState, buffer, sizeof(buffer),
+			&read, &decoded, &count);
+		if (code == TCL_CONVERT_UNKNOWN || code == TCL_CONVERT_SYNTAX) {
+		    SetFlag(statePtr, CHANNEL_ENCODING_ERROR);
+		    code = TCL_OK;
+		}
 
 		if (count == 2) {
 		    if (buffer[1] == '\n') {

generic/tclIcu.c

@@ -1434,7 +1434,7 @@ TclIcuInit(
 	}
 #endif // _WIN32
 
-	/* Symbol may have version (Windows, FreeBSD), or not (Linux) */
+	/* Symbol may have version (Linux), or not (Windows, FreeBSD) */
 
 #define ICUUC_SYM(name)                                                   \
     do {                                                                  \

library/init.tcl

@@ -590,8 +590,10 @@ proc auto_execok name {
     }
     set auto_execs($name) ""
 
-    set shellBuiltins [list assoc cls copy date del dir echo erase exit ftype \
-	    md mkdir mklink move rd ren rename rmdir start time type ver vol]
+    set shellBuiltins [list assoc call cd cls color copy date del dir echo \
+                           erase exit ftype for if md mkdir mklink move path \
+                           pause prompt rd ren rename rmdir set start time \
+                           title type ver vol]
     if {[info exists env(PATHEXT)]} {
 	# Add an initial ; to have the {} extension check first.
 	set execExtensions [split ";$env(PATHEXT)" ";"]

tests/cmdMZ.test

@@ -485,6 +485,26 @@ test cmdMZ-6.12 {Tcl_TimeRateObjCmd: done optimization: nested call of self insi
     }
     list [lindex [timerate $m1 1000 5] 2] $x
 } {5 20}
+test cmdMZ-6.13 {Tcl_TimeRateObjCmd: stability by O(n**2), avoid long execution time on growing iteration time} {
+    set result {}
+    # test the function with quadratic complexity (iteration growth 2x, 10x, 100x):
+    foreach e {2 10 100} {
+	set x 1
+	set m1 [timerate {
+	    apply {x {
+		while {[incr x -1]} {}
+	    }} [set x [expr {$x*$e}]]
+	} 50]
+	lappend result "${e}x"
+	# check it was too slow (it is OK to use factor 2 to prevent sporadic
+	# errors on some slow systems or time issues, because if it is not fixed,
+	# the execution time may grow hundreds and thousand times):
+	if {[lindex $m1 6] > 50 * 2} {
+	    lappend result "unexpected long: $m1"
+	}
+    }
+    set result
+} {2x 10x 100x}
 
 test cmdMZ-try-1.0 {
 

tests/exec.test

@@ -23,6 +23,12 @@ source [file join [file dirname [info script]] tcltests.tcl]
 # Some skips when running in a macOS CI environment
 testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}]
 
+# Need a App Exec Alias for testing exec of reparse points
+if {[info exists ::env(LOCALAPPDATA)] &&
+    [file exists [file join $::env(LOCALAPPDATA) "Microsoft" "WindowsApps" "winget.exe"]]} {
+        testConstraint haveWinget 1
+}
+
 unset -nocomplain path
 
 # Utilities that are like Bourne shell stalwarts, but cross-platform.
@@ -741,6 +747,24 @@ test exec-21.2 {exec encoding mismatch on stderr} -setup {
     list [catch {exec [info nameofexecutable] $path(script)} r] $r
 } -result [list 1 a\uFFFDb]
 
+test exec-bug-4f0b5767ac {exec App Execution Alias} -constraints haveWinget -body {
+    exec winget --info
+} -result "Windows Package Manager*" -match glob
+
+foreach cmdBuiltin {
+    assoc call cd cls color copy date del dir echo 
+    erase exit ftype for if md mkdir mklink move path 
+    pause prompt rd ren rename rmdir set start time 
+    title type ver vol
+} {
+    test auto_execok-$cmdBuiltin-1.0 "auto_execok $cmdBuiltin" \
+        -constraints win \
+        -body {
+            string equal [auto_execok $cmdBuiltin] \
+                "[file normalize $::env(COMSPEC)] /c $cmdBuiltin"
+        } -result 1
+}
+unset cmdBuiltin
 
 # ----------------------------------------------------------------------
 # cleanup

tests/io.test

@@ -1855,6 +1855,32 @@ test io-13.12 {TranslateInputEOL: find EOF char in src} {
     close $f
     set x
 } "\n\n\nab\n\nd"
+test io-13.13 {Translation crlf: \r followed by encoding error before buffer boundary - TCL bug 73bb42fb}\
+-setup {
+	set buffersize 8
+	writeFile $path(test1) binary\
+			[string repeat x [expr $buffersize-1]]\r\xe9XXXXXXXXXXXXXXXXXXXXXXXX
+} -body {
+	set fd [open $path(test1)]
+	fconfigure $fd -encoding utf-8 -buffersize [expr {$buffersize+1}] -translation crlf
+	catch {read $fd $buffersize} e d
+	list [dict get $d -data] [dict get $d -code] [dict get $d -errorcode]
+} -cleanup {
+	close $fd
+} -result {xxxxxxx 1 {POSIX EILSEQ {invalid or incomplete multibyte or wide character}}}
+test io-13.14 {Translation crlf: \r followed by encoding error after buffer boundary - TCL bug 73bb42fb (crash)}\
+-setup {
+	set buffersize 8
+	writeFile $path(test1) binary\
+			[string repeat x [expr $buffersize-1]]\r\xe9XXXXXXXXXXXXXXXXXXXXXXXX
+} -body {
+	set fd [open $path(test1)]
+	fconfigure $fd -encoding utf-8 -buffersize $buffersize -translation crlf
+	catch {read $fd $buffersize} e d
+	list [dict get $d -data] [dict get $d -code] [dict get $d -errorcode]
+} -cleanup {
+	close $fd
+} -result {xxxxxxx 1 {POSIX EILSEQ {invalid or incomplete multibyte or wide character}}}
 
 # Test standard handle management. The functions tested are
 # Tcl_SetStdChannel and Tcl_GetStdChannel. Incidentally we are