Merge 9.0

.github/workflows/linux-build.yml

@@ -3,7 +3,6 @@ on:
   push:
     branches:
     - "main"
-    - "trunk"
     - "core-8-branch"
     tags:
     - "core-**"

.github/workflows/mac-build.yml

@@ -3,7 +3,6 @@ on:
   push:
     branches:
     - "main"
-    - "trunk"
     - "core-8-branch"
     tags:
     - "core-**"

.github/workflows/onefiledist.yml

@@ -3,7 +3,6 @@ on:
   push:
     branches:
     - "main"
-    - "trunk"
     - "core-8-branch"
     tags:
     - "core-**"

.github/workflows/win-build.yml

@@ -3,7 +3,6 @@ on:
   push:
     branches:
     - "main"
-    - "trunk"
     - "core-8-branch"
     tags:
     - "core-**"

generic/tclArithSeries.c

@@ -757,52 +757,6 @@ SetArithSeriesFromAny(
     return TCL_ERROR;
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * TclArithSeriesObjCopy --
- *
- *	Makes a "pure arithSeries" copy of an ArithSeries value. This provides for the C
- *	level a counterpart of the [lrange $list 0 end] command, while using
- *	internals details to be as efficient as possible.
- *
- * Results:
- *
- *	Normally returns a pointer to a new Tcl_Obj, that contains the same
- *	arithSeries value as *arithSeriesObj does. The returned Tcl_Obj has a
- *	refCount of zero. If *arithSeriesObj does not hold an arithSeries,
- *	NULL is returned, and if interp is non-NULL, an error message is
- *	recorded there.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclArithSeriesObjCopy(
-    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
-    Tcl_Obj *arithSeriesObj)	/* List object for which an element array is
-				 * to be returned. */
-{
-    Tcl_Obj *copyPtr;
-    ArithSeries *arithSeriesRepPtr;
-
-    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
-    if (NULL == arithSeriesRepPtr) {
-	if (SetArithSeriesFromAny(interp, arithSeriesObj) != TCL_OK) {
-	    /* We know this is going to panic, but it's the message we want */
-	    return NULL;
-	}
-    }
-
-    TclNewObj(copyPtr);
-    TclInvalidateStringRep(copyPtr);
-    DupArithSeriesInternalRep(arithSeriesObj, copyPtr);
-    return copyPtr;
-}
-
 /*
  *----------------------------------------------------------------------
  *

generic/tclArithSeries.h

@@ -34,8 +34,6 @@ typedef struct {
 } ArithSeriesDbl;
 
 
-MODULE_SCOPE Tcl_Obj *	TclArithSeriesObjCopy(Tcl_Interp *interp,
-			    Tcl_Obj *arithSeriesPtr);
 MODULE_SCOPE  Tcl_Obj *TclArithSeriesObjIndex(Tcl_Interp *, Tcl_Obj *,
 			    Tcl_WideInt index);
 MODULE_SCOPE Tcl_Obj *	TclArithSeriesObjRange(Tcl_Interp *interp,

generic/tclAssembly.c

@@ -2247,7 +2247,7 @@ static int
 GetListIndexOperand(
     AssemblyEnv* assemEnvPtr,	/* Assembly environment */
     Tcl_Token** tokenPtrPtr,	/* Current token from the parser */
-    int* result)		/* OUTPUT: Integer extracted from the token */
+    int* result)		/* OUTPUT: encoded index derived from the token */
 {
     CompileEnv* envPtr = assemEnvPtr->envPtr;
 				/* Compilation environment */

generic/tclCmdAH.c

@@ -2811,7 +2811,7 @@ EachloopCmd(
 	/* Values */
 	if (TclHasInternalRep(objv[2+i*2],&tclArithSeriesType.objType)) {
 	    /* Special case for Arith Series */
-	    statePtr->aCopyList[i] = TclArithSeriesObjCopy(interp, objv[2+i*2]);
+	    statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]);
 	    if (statePtr->aCopyList[i] == NULL) {
 		result = TCL_ERROR;
 		goto done;

generic/tclCompile.c

@@ -720,8 +720,8 @@ const Tcl_ObjType tclByteCodeType = {
 };
 
 /*
- * subtCodeType provides the standard type managemnt procedures for the
- * substcode type, which represents substiution within a Tcl value.
+ * substCodeType provides the standard type management procedures for the
+ * substcode type, which represents substitution within a Tcl value.
  */
 
 static const Tcl_ObjType substCodeType = {

generic/tclEncoding.c

@@ -1165,7 +1165,7 @@ Tcl_ExternalToUtfDString(
  * Tcl_ExternalToUtfDStringEx --
  *
  *	Convert a source buffer from the specified encoding into UTF-8.
- *	The parameter flags controls the behavior, if any of the bytes in
+ *	"flags" controls the behavior if any of the bytes in
  *	the source buffer are invalid or cannot be represented in utf-8.
  *	Possible flags values:
  *	target encoding. It should be composed by OR-ing the following:
@@ -2588,10 +2588,10 @@ UtfToUtfProc(
 	} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
 	    /*
 	     * Incomplete byte sequence.
-	     * Always check before using TclUtfToUCS4. Not doing can so
-	     * cause it run beyond the end of the buffer! If we happen such an
-	     * incomplete char its bytes are made to represent themselves
-	     * unless the user has explicitly asked to be told.
+		 * Always check before using TclUtfToUCS4. Not doing so can cause it
+		 * run beyond the end of the buffer! If we happen on such an incomplete
+		 * char its bytes are made to represent themselves unless the user has
+		 * explicitly asked to be told.
 	     */
 
 	    if (flags & ENCODING_INPUT) {

generic/tclExecute.c

@@ -113,9 +113,8 @@ typedef struct {
     ByteCode *codePtr;		/* Constant until the BC returns */
 				/* -----------------------------------------*/
     Tcl_Obj **catchTop;		/* These fields are used on return TO this */
-    Tcl_Obj *auxObjList;	/* this level: they record the state when a */
-    CmdFrame cmdFrame;		/* new codePtr was received for NR */
-                                /* execution. */
+    Tcl_Obj *auxObjList;	/* level: they record the state when a new */
+    CmdFrame cmdFrame;		/* codePtr was received for NR execution. */
     Tcl_Obj *stack[1];		/* Start of the actual combined catch and obj
 				 * stacks; the struct will be expanded as
 				 * necessary */

generic/tclIO.c

@@ -5931,7 +5931,7 @@ DoReadChars(
 
     if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
 	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
-	/* TODO: We don't need this call? */
+	/* TODO: UpdateInterest not needed here? */
 	UpdateInterest(chanPtr);
 	Tcl_SetErrno(EILSEQ);
 	return -1;
@@ -5948,7 +5948,7 @@ DoReadChars(
 	assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
 	assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR));
 
-	/* TODO: We don't need this call? */
+	/* TODO: UpdateInterest not needed here? */
 	UpdateInterest(chanPtr);
 	return 0;
     }
@@ -5962,7 +5962,7 @@ DoReadChars(
 	}
 	ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
 	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
-	/* TODO: We don't need this call? */
+	/* TODO: UpdateInterest not needed here? */
 	UpdateInterest(chanPtr);
 	return 0;
     }
@@ -6009,7 +6009,7 @@ DoReadChars(
 	    }
 
 	    /*
-	     * If the current buffer is empty recycle it.
+	     * Recycle current buffer if empty.
 	     */
 
 	    bufPtr = statePtr->inQueueHead;

generic/tclListObj.c

@@ -304,8 +304,8 @@ ListSpanMerited(
     Tcl_Size allocatedStorageLength) /* Length of the currently allocation */
 {
     /*
-     * Possible optimizations for future consideration 
-     * - heuristic LIST_SPAN_THRESHOLD 
+     * Possible optimizations for future consideration
+     * - heuristic LIST_SPAN_THRESHOLD
      * - currently, information about the sharing (ref count) of existing
      * storage is not passed. Perhaps it should be. For example if the
      * existing storage has a "large" ref count, then it might make sense
@@ -828,7 +828,7 @@ ListStoreNew(
  *
  * ListStoreReallocate --
  *
- *    Reallocates the memory for a ListStore allocating extra for 
+ *    Reallocates the memory for a ListStore allocating extra for
  *    possible future growth.
  *
  * Results:
@@ -1386,7 +1386,7 @@ TclListObjCopy(
 
     if (!TclHasInternalRep(listObj, &tclListType.objType)) {
 	if (TclHasInternalRep(listObj,&tclArithSeriesType.objType)) {
-	    return TclArithSeriesObjCopy(interp, listObj);
+	    return Tcl_DuplicateObj(listObj);
 	}
 	if (SetListFromAny(interp, listObj) != TCL_OK) {
 	    return NULL;

tests-perf/listPerf.tcl

@@ -3,8 +3,9 @@
 #
 # listPerf.tcl --
 #
-#  This file provides performance tests for list operations.
-#
+#  This file provides performance tests for list operations. Run
+#     tclsh listPerf.tcl help
+#  for options.
 # ------------------------------------------------------------------------
 #
 # See the file "license.terms" for information on usage and redistribution
@@ -77,7 +78,9 @@ namespace eval perf::list {
                     break
                 }
                 --* {
-                    error "Unknown option $arg"
+                    puts stderr "Unknown option $arg"
+                    print_usage
+                    exit 1
                 }
                 default {
                     # Remaining will be passed back to the caller
@@ -383,6 +386,8 @@ namespace eval perf::list {
             comment Create a list from two lists - real test of expansion speed
             perf measure [list_describe $len "from a {*}list {*}list"] {list {*}$L {*}$L} [list len [expr {$len/2}]]
         }
+
+        perf destroy
     }
 
     proc lappend_describe {share_mode len num iters} {
@@ -1217,7 +1222,7 @@ namespace eval perf::list {
             set commands [lmap sel $selections {
                 if {$sel eq "help"} {
                     print_usage
-                    continue
+                    exit 0
                 }
                 set cmd ::perf::list::${sel}_perf
                 if {$cmd ni [info commands ::perf::list::*_perf]} {

tests/chanio.test

@@ -1098,7 +1098,7 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup {
     chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
     chan close $f
     set f [open $path(test1)]
-    chan configure $f -encoding shiftjis
+    chan configure $f -encoding shiftjis -profile tcl8
     lappend x [chan gets $f line] $line
     lappend x [chan tell $f] [testchannel inputbuffered $f] [chan eof $f]
     lappend x [chan gets $f line] $line

tests/cmdInfo.test

@@ -36,7 +36,7 @@ test cmdinfo-1.3 {command procedure and clientData} {testcmdinfo} {
     testcmdinfo create x1
     testcmdinfo modify x1
     testcmdinfo get x1
-} {CmdProc2 new_command_data CmdDelProc2 new_delete_data :: nativeObjectProc2}
+} {CmdProc2 new_command_data CmdDelProc2 new_delete_data :: stringProc}
 test cmdinfo-1.4 {command procedure and clientData} {testcmdinfo} {
     testcmdinfo create x1
     testcmdinfo modify x1

tests/encoding.test

@@ -464,7 +464,10 @@ test encoding-15.24 {UtfToUtfProc CESU-8 bug [048dd20b4171c8da]} {
 test encoding-15.25 {UtfToUtfProc CESU-8} {
     encoding convertfrom cesu-8 \x00
 } \x00
-test encoding-15.26 {UtfToUtfProc CESU-8} {
+test {encoding-15.26 cesu-8 tclnull strict} {UtfToUtfProc CESU-8} {
+    encoding convertfrom -profile tcl8 cesu-8 \xC0\x80
+} \x00
+test {encoding-15.26 cesu-8 tclnull tcl8} {UtfToUtfProc CESU-8} {
     encoding convertfrom -profile tcl8 cesu-8 \xC0\x80
 } \x00
 test encoding-15.27 {UtfToUtfProc -profile strict CESU-8} {
@@ -562,24 +565,35 @@ test encoding-16.18 {
 	return done
     } [namespace current]]
 } -result done
-test encoding-16.19 {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
+test {encoding-16.19 strict} {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
+    encoding convertfrom -profile strict utf-16 "\x41\x41\x41"
+} -returnCodes 1 -result {unexpected byte sequence starting at index 2: '\x41'}
+test {encoding-16.19 tcl8} {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
     encoding convertfrom -profile tcl8 utf-16 "\x41\x41\x41"
 } -result \u4141\uFFFD
-test encoding-16.20 {Utf16ToUtfProc, bug [d19fe0a5b]} -constraints deprecated -body {
+test encoding-16.20 {utf16ToUtfProc, bug [d19fe0a5b]} \
+    -constraints deprecated -body {
     encoding convertfrom utf-16 "\xD8\xD8"
 } -result \uD8D8
-test encoding-16.21 {Utf32ToUtfProc, bug [d19fe0a5b]} -body {
+test encoding-16.21.tcl8 {Utf32ToUtfProc, bug [d19fe0a5b]} -body {
     encoding convertfrom -profile tcl8 utf-32 "\x00\x00\x00\x00\x41\x41"
 } -result \x00\uFFFD
+test encoding-16.21.strict {Utf32ToUtfProc, bug [d19fe0a5b]} -body {
+    encoding convertfrom -profile strict utf-32 "\x00\x00\x00\x00\x41\x41"
+} -returnCodes 1 -result {unexpected byte sequence starting at index 4: '\x41'}
+
 test encoding-16.22 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body {
     encoding convertfrom -profile strict utf-16le \x00\xD8
 } -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'}
 test encoding-16.23 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body {
     encoding convertfrom -profile strict utf-16le \x00\xDC
 } -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'}
-test encoding-16.24 {Utf32ToUtfProc} -body {
-    encoding convertfrom -profile tcl8 utf-32 "\xFF\xFF\xFF\xFF"
-} -result \uFFFD
+test {encoding-24.4 utf-8 invalid strict} {Parse invalid utf-8, strict} -body {
+    string length [encoding convertfrom -profile strict utf-8 "\xC0\x80"]
+} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
+test {encoding-24.4 utf-8 invalid tcl8} {UtfToUtfProc utf-8} {
+    encoding convertfrom -profile tcl8 utf-8 \xC0\x80
+} \x00
 test encoding-16.25 {Utf32ToUtfProc} -body {
     encoding convertfrom -profile tcl8 utf-32 "\x01\x00\x00\x01"
 } -result \uFFFD
@@ -789,16 +803,19 @@ test encoding-24.10 {Parse valid or invalid utf-8} {
 test encoding-24.11 {Parse valid or invalid utf-8} {
     string length [encoding convertfrom -profile tcl8 utf-8 "\xEF\xBF\xBF"]
 } 1
-test encoding-24.12 {Parse valid or invalid utf-8} -body {
+test encoding-24.12 {Parse invalid utf-8} -body {
     encoding convertfrom -profile strict utf-8 "\xC0\x81"
 } -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
-test encoding-24.13 {Parse valid or invalid utf-8} -body {
+test encoding-24.13 {Parse invalid utf-8} -body {
     encoding convertfrom -profile strict utf-8 "\xC1\xBF"
 } -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC1'}
-test encoding-24.14 {Parse valid or invalid utf-8} {
-    string length [encoding convertfrom utf-8 "\xC2\x80"]
+test encoding-24.14 {Parse valid utf-8} {
+    expr {[encoding convertfrom utf-8 "\xC2\x80"] eq "\u80"}
 } 1
-test encoding-24.15 {Parse valid or invalid utf-8} -body {
+test encoding-24.15.strict {Parse invalid utf-8, -profile strict} -body {
+    encoding convertfrom -profile strict utf-8 "Z\xE0\x80"
+} -returnCodes 1 -result "unexpected byte sequence starting at index 1: '\\xE0'"
+test encoding-24.15.tcl8 {Parse invalid utf-8, -profile tcl8} -body {
     encoding convertfrom -profile tcl8 utf-8 "Z\xE0\x80"
 } -result Z\xE0\u20AC
 test encoding-24.16 {Parse valid or invalid utf-8} -constraints testbytestring -body {
@@ -855,7 +872,7 @@ test encoding-24.31 {Parse invalid utf-8 with -profile tcl8} -body {
 test encoding-24.32 {Try to generate invalid utf-8} -body {
     encoding convertto utf-8 \uFFFF
 } -result \xEF\xBF\xBF
-test encoding-24.33 {Try to generate noncharacter with -profile strict} -body {
+test encoding-24.33 {Try to generate invalid utf-8} -body {
     encoding convertto -profile strict utf-8 \uFFFF
 } -result \xEF\xBF\xBF
 test encoding-24.34 {Try to generate invalid utf-8 with -profile tcl8} -body {