Rebase to 9.0. See: [e38dce74e2]

generic/tclVar.c

@@ -2895,6 +2895,15 @@ Tcl_LappendObjCmd(
 	    if (result != TCL_OK) {
 		return result;
 	    }
+	    /* 
+	     * Avoid non canonical string representation of result ([e38dce74e2]).
+	     */
+	    if (!ListObjIsCanonical(newValuePtr)) {
+		if (Tcl_IsShared(newValuePtr)) {
+		    goto performLappend;
+		}
+		TclInvalidateStringRep(newValuePtr);
+	    }
 	}
     } else {
 	/*
@@ -2906,6 +2915,7 @@ Tcl_LappendObjCmd(
 	 * value is unshared we modify it directly, otherwise we create a new
 	 * copy to modify: this is "copy on write".
 	 */
+performLappend:
 
 	createdNewObj = 0;
 
@@ -2945,7 +2955,7 @@ Tcl_LappendObjCmd(
 	    TclNewObj(varValuePtr);
 	    createdNewObj = 1;
 	} else if (Tcl_IsShared(varValuePtr)) {
-	    varValuePtr = Tcl_DuplicateObj(varValuePtr);
+	    varValuePtr = TclListObjCopy(NULL, varValuePtr);
 	    createdNewObj = 1;
 	}
 

tests/append.test

@@ -326,18 +326,18 @@ test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env
     unset -nocomplain ::env(__DUMMY__)
 } -result {0 {new value}}
 
-test append-10.1 {Bug 214cc0eb22: lappend with no values} {
+test append-10.1 {Bug 214cc0eb22, e38dce74e2: lappend with no values} {
     set lst "# 1 2 3"
-    [subst lappend] lst
-} "# 1 2 3"
+    list [lappend lst] [[subst lappend] lst] $lst
+} [lrepeat 3 "{#} 1 2 3"]
 test append-10.2 {Bug 214cc0eb22: lappend with no values} -body {
     set lst "1 \{ 2"
     [subst lappend] lst
 } -returnCodes error -result {unmatched open brace in list}
-test append-10.3 {Bug 214cc0eb22: expanded lappend with no values} {
+test append-10.3 {Bug 214cc0eb22, e38dce74e2: expanded lappend with no values} {
     set lst "# 1 2 3"
-    [subst lappend] lst {*}[list]
-} "# 1 2 3"
+    list [lappend lst {*}[list]] [[subst lappend] lst {*}[list]] $lst
+} [lrepeat 3 "{#} 1 2 3"]
 test append-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body {
     set lst "1 \{ 2"
     [subst lappend] lst {*}[list]

tests/appendComp.test

@@ -443,7 +443,7 @@ test appendComp-10.1 {Bug 214cc0eb22: lappend with no values} {
     apply {lst {
 	lappend lst
     }} "# 1 2 3"
-} "# 1 2 3"
+} "{#} 1 2 3"
 test appendComp-10.2 {Bug 214cc0eb22: lappend with no values} -body {
     apply {lst {
 	lappend lst
@@ -453,7 +453,7 @@ test appendComp-10.3 {Bug 214cc0eb22: expanded lappend with no values} {
     apply {lst {
 	lappend lst {*}[list]
     }} "# 1 2 3"
-} "# 1 2 3"
+} "{#} 1 2 3"
 test appendComp-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body {
     apply {lst {
 	lappend lst {*}[list]

tests/list.test

@@ -66,9 +66,16 @@ test list-1.30 {basic null treatment} {
 } 1
 test list-1.31 {bug [e38dce74e2]} {
     set l #foo
+    set srep #foo; # same literal as above
     set e {}
-    list {*}$l {*}$e
-} {{#foo}}
+    list [list {*}$l] [list {*}$l {*}$e] \
+	 [linsert #foo end] [linsert #foo end {*}$e] \
+	 [lreplace #foo end+1 end+1] [lreplace #foo end+1 end+1 {*}$e] \
+	 [lreplace #foo end end-1] [lreplace #foo end end-1 {*}$e] \
+	 [lreplace #foo 0 -1] [lreplace #foo 0 -1 {*}$e] \
+	 [lappend l] [lappend l {*}$e] \
+	 [expr {" $srep " eq " #foo "}]; # this simply covers retaining of string rep of literal
+} [list {*}[lrepeat 12 [list #foo]] 1]
 test list-1.32 {bug [e38dce74e2]} {
     set l " #foo"
     set e {}