Tcl Source Code

Check-in [9d2057859c]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:[82e7f67325] Fix an evil refcount problem in compiled [string replace].
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 9d2057859c777773e2b7fac391312a5731e642fa
User & Date: dkf 2014-04-30 21:24:39
Context
2014-05-01
01:15
missing constraint check-in: 36b1780d1a user: dgp tags: trunk
2014-04-30
21:24
[82e7f67325] Fix an evil refcount problem in compiled [string replace]. check-in: 9d2057859c user: dkf tags: trunk
2014-04-29
16:47
Fix bug exposed when buffer recycling is disabled. check-in: 84f992ce50 user: dgp tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclExecute.c.

5698
5699
5700
5701
5702
5703
5704






5705
5706
5707
5708
5709




5710
5711
5712
5713
5714
5715
5716
	} else if (Tcl_IsShared(value3Ptr)) {
	    objResultPtr = Tcl_DuplicateObj(value3Ptr);
	    if (toIdx < length) {
		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
			length - toIdx);
	    }
	} else {






	    objResultPtr = value3Ptr;
	    if (toIdx < length) {
		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
			length - toIdx);
	    }




	}
	TclDecrRefCount(value3Ptr);
	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_MAP:
	valuePtr = OBJ_AT_TOS;		/* "Main" string. */







>
>
>
>
>
>
|

|


>
>
>
>







5698
5699
5700
5701
5702
5703
5704
5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
	} else if (Tcl_IsShared(value3Ptr)) {
	    objResultPtr = Tcl_DuplicateObj(value3Ptr);
	    if (toIdx < length) {
		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
			length - toIdx);
	    }
	} else {
	    /*
	     * Be careful with splicing the stack in this case; we have a
	     * refCount:1 object in value3Ptr and we want to append to it and
	     * make it be the refCount:1 object at the top of the stack
	     * afterwards. [Bug 82e7f67325]
	     */

	    if (toIdx < length) {
		Tcl_AppendUnicodeToObj(value3Ptr, ustring1 + toIdx + 1,
			length - toIdx);
	    }
	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
	    TclDecrRefCount(valuePtr);
	    OBJ_AT_TOS = value3Ptr;	/* Tricky! */
	    NEXT_INST_F(1, 0, 0);
	}
	TclDecrRefCount(value3Ptr);
	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_MAP:
	valuePtr = OBJ_AT_TOS;		/* "Main" string. */

Changes to tests/stringComp.test.

22
23
24
25
26
27
28
















29
30
31
32
33
34
35

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] != {}}]

















test stringComp-1.1 {error conditions} {
    proc foo {} {string gorp a b}
    list [catch {foo} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test stringComp-1.2 {error conditions} {
    proc foo {} {string}







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] != {}}]
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }
    proc leaktest {script {iterations 3}} {
	set end [getbytes]
	for {set i 0} {$i < $iterations} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [getbytes]
	}
	return [expr {$end - $tmp}]
    }
}

test stringComp-1.1 {error conditions} {
    proc foo {} {string gorp a b}
    list [catch {foo} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test stringComp-1.2 {error conditions} {
    proc foo {} {string}
683
684
685
686
687
688
689









690







691
692
693
694
695
696
697
    }} 12345
} {}

## string repeat
## not yet bc

## string replace









## not yet bc








## string tolower
## not yet bc

## string toupper
## not yet bc








>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>







699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
    }} 12345
} {}

## string repeat
## not yet bc

## string replace
test stringComp-14.1 {Bug 82e7f67325} {
    apply {{} {
	set a [join {a b} {}]
	lappend b [string length [string replace ___! 0 2 $a]]
	lappend b [string length [string replace ___! 0 2 $a[unset a]]]
    }}
} {3 3}
test stringComp-14.2 {Bug 82e7f67325} {
    # As in stringComp-14.1, but make sure we don't retain too many refs
    leaktest {
	apply {{} {
	    set a [join {a b} {}]
	    lappend b [string length [string replace ___! 0 2 $a]]
	    lappend b [string length [string replace ___! 0 2 $a[unset a]]]
	}}
    }
} {0}

## string tolower
## not yet bc

## string toupper
## not yet bc