Tcl Source Code

Check-in [f9979ea137]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:merge 8.6 (regression bug-[cc1e91552c], etc)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256: f9979ea1375f940ecb457b2c987ff9e68572c2ae45370b49bdd550a6db311d9c
User & Date: sebres 2019-01-09 10:10:12
Context
2019-01-13
15:43
Merge 8.6 check-in: 372ad13f77 user: jan.nijtmans tags: core-8-branch
2019-01-09
10:11
merge 8.7 (regression bug-[cc1e91552c], etc) check-in: 0908eff9e9 user: sebres tags: trunk
10:10
merge 8.6 (regression bug-[cc1e91552c], etc) check-in: f9979ea137 user: sebres tags: core-8-branch
10:01
closes [cc1e91552c]: fixes lrange instruction on empty not canonical list (and acc. within expansion... check-in: 9d24a1b9db user: sebres tags: core-8-6-branch
2019-01-04
22:37
Merge 8.6 check-in: f66fc1c40d user: jan.nijtmans tags: core-8-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclExecute.c.

4959
4960
4961
4962
4963
4964
4965


4966
4967


4968
4969
4970
4971
4972
4973
4974
	if (*(pc+9) == INST_POP) {
	    NEXT_INST_F(10, 1, 0);
	}
#endif

	/* Every range of an empty list is an empty list */
	if (objc == 0) {


	    TRACE_APPEND(("\n"));
	    NEXT_INST_F(9, 0, 0);


	}

	/* Decode index value operands. */

	/*
	assert ( toIdx != TCL_INDEX_AFTER);
	 *






>
>
|
|
>
>







4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
	if (*(pc+9) == INST_POP) {
	    NEXT_INST_F(10, 1, 0);
	}
#endif

	/* Every range of an empty list is an empty list */
	if (objc == 0) {
	    /* avoid return of not canonical list (e. g. spaces in string repr.) */
	    if (ListObjIsCanonical(valuePtr)) {
		TRACE_APPEND(("\n"));
		NEXT_INST_F(9, 0, 0);
	    }
	    goto emptyList;
	}

	/* Decode index value operands. */

	/*
	assert ( toIdx != TCL_INDEX_AFTER);
	 *

Changes to tests/basic.test.

953
954
955
956
957
958
959






960
961
962
963
964
965
966
        lappend res $t

        lappend res [catch { run { {*}{error Hejsan} } } err]
        lappend res $err
    } -cleanup {
	unset res t
} -result {0 10 1 Hejsan}







} ;# End of noComp loop

test basic-49.1 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex {
    set ::x global
    namespace eval ns {
	variable x namespace






>
>
>
>
>
>







953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
        lappend res $t

        lappend res [catch { run { {*}{error Hejsan} } } err]
        lappend res $err
    } -cleanup {
	unset res t
} -result {0 10 1 Hejsan}

test basic-48.24.$noComp {expansion: empty not canonical list, regression test, bug [cc1e91552c]} -constraints $constraints -setup {
    unset -nocomplain a
} -body {
    run {list [list {*}{ }] [list {*}[format %c 32]] [list {*}[set a { }]]}
} -result [lrepeat 3 {}] -cleanup {unset -nocomplain a}

} ;# End of noComp loop

test basic-49.1 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex {
    set ::x global
    namespace eval ns {
	variable x namespace

Changes to tests/chanio.test.

26
27
28
29
30
31
32

33
34


35
36
37
38
39
40
41
....
7442
7443
7444
7445
7446
7447
7448

7449
7450
7451
7452
7453
7454
7455
    variable f
    variable i
    variable n
    variable v
    variable msg
    variable expected


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


    package require tcltests

    testConstraint testbytestring   [llength [info commands testbytestring]]
    testConstraint testchannel      [llength [info commands testchannel]]
    testConstraint openpipe         1
    testConstraint testfevent       [llength [info commands testfevent]]
    testConstraint testchannelevent [llength [info commands testchannelevent]]
................................................................................
    chan close $f
    string equal $result [testmainthread]
} {1}

test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} {
    # This test will hang in older revisions of the core.
    set out [open $path(script) w]

    chan puts $out {
	chan puts [testbytestring \xe2]
	exit 1
    }
    proc readit {pipe} {
	variable x
	variable result






>
|
|
>
>







 







>







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
....
7445
7446
7447
7448
7449
7450
7451
7452
7453
7454
7455
7456
7457
7458
7459
    variable f
    variable i
    variable n
    variable v
    variable msg
    variable expected

    catch {
	::tcltest::loadTestedCommands
	package require -exact Tcltest [info patchlevel]
	set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
    }
    package require tcltests

    testConstraint testbytestring   [llength [info commands testbytestring]]
    testConstraint testchannel      [llength [info commands testchannel]]
    testConstraint openpipe         1
    testConstraint testfevent       [llength [info commands testfevent]]
    testConstraint testchannelevent [llength [info commands testchannelevent]]
................................................................................
    chan close $f
    string equal $result [testmainthread]
} {1}

test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} {
    # This test will hang in older revisions of the core.
    set out [open $path(script) w]
    chan puts $out "catch {load $::tcltestlib Tcltest}"
    chan puts $out {
	chan puts [testbytestring \xe2]
	exit 1
    }
    proc readit {pipe} {
	variable x
	variable result

Changes to tests/io.test.

25
26
27
28
29
30
31

32
33


34
35
36
37
38
39
40
....
8266
8267
8268
8269
8270
8271
8272

8273
8274
8275
8276
8277
8278
8279
    variable f
    variable i
    variable n
    variable v
    variable msg
    variable expected


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


    package require tcltests

testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel      [llength [info commands testchannel]]
testConstraint openpipe         1
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
................................................................................
    string equal $result [testmainthread]
} {1}

test io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} {
    # This test will hang in older revisions of the core.

    set out [open $path(script) w]

    puts $out {
	puts [testbytestring \xe2]
	exit 1
    }
    proc readit {pipe} {
	variable x
	variable result






>
|
|
>
>







 







>







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
....
8269
8270
8271
8272
8273
8274
8275
8276
8277
8278
8279
8280
8281
8282
8283
    variable f
    variable i
    variable n
    variable v
    variable msg
    variable expected

    catch {
	::tcltest::loadTestedCommands
	package require -exact Tcltest [info patchlevel]
	set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
    }
    package require tcltests

testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel      [llength [info commands testchannel]]
testConstraint openpipe         1
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
................................................................................
    string equal $result [testmainthread]
} {1}

test io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} {
    # This test will hang in older revisions of the core.

    set out [open $path(script) w]
    puts $out "catch {load $::tcltestlib Tcltest}"
    puts $out {
	puts [testbytestring \xe2]
	exit 1
    }
    proc readit {pipe} {
	variable x
	variable result

Changes to tests/lrange.test.

102
103
104
105
106
107
108










109
110
111
112
113
114
115
test lrange-3.5 {compiled with calculated indices, start out of range (negative)} {
    list [lrange {a b c} -1 1] [lrange {a b c} -1+0 end-1] [lrange {a b c} -2 1] [lrange {a b c} -2+0 0+1]
} [lrepeat 4 {a b}]
test lrange-3.6 {compiled with calculated indices, end out of range (after end)} {
    list [lrange {a b c} 1 end+1] [lrange {a b c} 1+0 2+1] [lrange {a b c} 1 end+1] [lrange {a b c} end-1 3+1]
} [lrepeat 4 {b c}]











test lrange-4.1 {lrange pure promise} -body {
    set ll1 [list $tcl_version 2 3 4]
    # Shared
    set ll2 $ll1
    # With string rep
    string length $ll1






>
>
>
>
>
>
>
>
>
>







102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
test lrange-3.5 {compiled with calculated indices, start out of range (negative)} {
    list [lrange {a b c} -1 1] [lrange {a b c} -1+0 end-1] [lrange {a b c} -2 1] [lrange {a b c} -2+0 0+1]
} [lrepeat 4 {a b}]
test lrange-3.6 {compiled with calculated indices, end out of range (after end)} {
    list [lrange {a b c} 1 end+1] [lrange {a b c} 1+0 2+1] [lrange {a b c} 1 end+1] [lrange {a b c} end-1 3+1]
} [lrepeat 4 {b c}]

test lrange-3.7a {compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} {
    list [lrange { } 0 1] [lrange [format %c 32] 0 1] [lrange [set a { }] 0 1] \
	 [lrange { } 0-1 end+1] [lrange [format %c 32] 0-1 end+1] [lrange $a 0-1 end+1]
} [lrepeat 6 {}]
test lrange-3.7b {not compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} {
    set cmd lrange
    list [$cmd { } 0 1] [$cmd [format %c 32] 0 1] [$cmd [set a { }] 0 1] \
	 [$cmd { } 0-1 end+1] [$cmd [format %c 32] 0-1 end+1] [$cmd $a 0-1 end+1]
} [lrepeat 6 {}]

test lrange-4.1 {lrange pure promise} -body {
    set ll1 [list $tcl_version 2 3 4]
    # Shared
    set ll2 $ll1
    # With string rep
    string length $ll1