tests/listTypes.test - main - niceSOFT/tcl

tests/listTypes.test
1 501 строка54 KB
jan.nijtmans
Consolidate use of ©. Indenting
10 авг 2026, 12:58
10 авг 2026, 12:5852d1487
# This file tests list command on each internal list representation.
#
# Copyright © 2025 Ashok P. Nadkarni
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# In Tcl 9, a list may have one of several list representations.
# - "list" - the basic list (similar to 8.6 implementation)
# - "list" with span - basic list with an attached span specifying a
#    contained range.
# - "arithseries" - an abstract list as produced by the lseq command
# - "repeatedList" - an abstract list holding repeated elements
# - "reversedList" - an abstract list that is the reverse of another list
#
# The first three of these are already tested in cmdIL.test, listObj.test,
# lseq.test, listrep.test etc. but are included here to improve coverage of all
# combinations of code paths listed below. The tests in these files do not test
# command options to the commands as those are already tested in the
# aforementioned files. All list operations, loops, {*} expansion need to be
# tested with each of the above types.
#
# Test list operations include combinations of
#  - Compiled / uncompiled operation
#  - Shared / unshared operands
#  - Literal versus variable arguments (only when generated byte instruction differs)
#  - List internal representation types.
# as these all vary in the executed code paths.
#
# Some tests assume correct operation on non-abstract lists as they are tested
# independently in other test files.
#
# For the abstract list types not tested elsewhere,
#   - verify constructor commands return the expected type
#   - generated string representations

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
source [file join [file dirname [info script]] tcltests.tcl]

testConstraint testobj [llength [info commands testobj]]
testConstraint testlistobj [llength [info commands testobj]]
testConstraint memory [llength [info commands memory]]

namespace eval listtype {
    variable listTypes {arithseries list rangeList repeatedList reversedList spanlist}
    variable nestableTypes {list rangeList repeatedList reversedList spanlist}

    # Loop vars etc.
    variable ltype
    variable ltype1
    variable ltype2
    variable ltype3
    variable first
    variable last
    variable indices
    variable result
    variable repeatCount

    # Compiled bytecode depends on whether arguments are literals or
    # variables. So test variations are needed for both.
    const zero 0
    const minusOne -1
    const ten 10

    # Internal representation produced by a list operation may depend on list
    # length. This is controlled by the *_LENGTH_THRESHOLD values in tclListTypes.c.
    # In cases where it matters, assumes a length of smallListLength will always
    # be less that these thresholds and largeListLength will be greater.
    variable smallListLength 10
    variable largeListLength 120; # Multiple of 4 because of assumptions in tests

    proc getListType {l} {
	set ltype [testobj objtype $l]
	if {$ltype eq "list"} {
	    if {[dict exists [testlistrep describe $l] span]} {
		return "spanlist"
	    }
	}
	return $ltype
    }

    # Raise error if list is not the expected type
    proc assertListType {l type} {
	set ltype [getListType $l]
	if {$ltype ne $type} {
	    error "Assertion failed: list type was \"$ltype\", expected \"$type\""
	}
    }

    proc isAbstractList {l} {
	return [expr {[getListType $l] ni {list spanlist}}]
    }

    # Convert the given list to non abstract
    proc makeNonAbstract {l} {
	set l [lmap v $l {set v}]
	assertListType $l list
	return $l
    }

    # Returns a list of length $largeListLength of the specified type
    proc makeList {type args} {
	variable largeListLength
	if {[llength $args]} {
	    set len [lindex $args 0]
	} else {
	    set len $largeListLength
	}
	set l [switch $type {
	    list {
		testlistrep new $len
	    }
	    spanlist {
		# Spanned list - force span by leaving 10 empty slots in front
		testlistrep new $len 10
	    }
	    arithseries {
		lseq $len
	    }
	    rangeList {
		# lists and arithseries have their own specialized range
		# implementations so have to use lreverse or lrepeat
		lrange [makeList reversedList [expr $len+1]] 1 end
	    }
	    repeatedList {
		lrepeat [expr {$len/4}] a b c d
	    }
	    reversedList {
		lreverse [makeList list $len]
	    }
	}]
	assertListType $l $type
	return $l
    }

    # Returns a non-abstract list with values from a given list type
    proc getNonAbstract {type args} {
	return [makeNonAbstract [makeList $type {*}$args]]
    }

    # Return first and last elements of a list created with makeList
    # assuming default lengths passed to makeList. Hardcoded to avoid use of
    # list operations as that is what is being tested.
    proc getFirstAndLast {ltype} {
	variable largeListLength
	switch $ltype {
	    repeatedList {
		set first a
		set last d
	    }
	    rangeList -
	    reversedList {
		set last 0
		set first [expr {$largeListLength-1}]
	    }
	    default {
		set first 0
		set last [expr {$largeListLength-1}]
	    }
	}
	return [list $first $last]
    }

    proc makeNestedList {args} {
	variable largeListLength
	set nestedTypes [lassign $args thisType]
	if {[llength $nestedTypes] == 0} {
	    return [makeList $thisType]
	}
	set nestedList [makeNestedList {*}$nestedTypes]
	return [switch $thisType {
	    list {
		for {set i 0} {$i < $largeListLength} {incr i} {
		    lappend outerList $nestedList
		}
		set outerList
	    }
	    spanlist {
		for {set i 0} {$i < (1+$largeListLength)} {incr i} {
		    lappend outerList $nestedList
		}
		# lrange on a list or spanlist will return a spanlist, not rangeList
		lrange $outerList 0 end-1
	    }
	    repeatedList {
		lrepeat $largeListLength $nestedList
	    }
	    reversedList {
		for {set i 0} {$i < $largeListLength} {incr i} {
		    lappend outerList $nestedList
		}
		lreverse $outerList
	    }
	    rangeList {
		for {set i 0} {$i < (1+$largeListLength)} {incr i} {
		    lappend outerList $nestedList
		}
		# lrange on a list or spanlist will return a spanlist, not rangeList
		# so reverse it first.
		lrange [lreverse $outerList] 0 end-1
	    }
	    default {
		error "List type $thisType cannot nest"
	    }
	}]
    }

    # Verify that list constructors return unshared Tcl_Obj's. Otherwise, unshared
    # list tests below are invalid. These don't actually test Tcl itself, but rather
    # the makeList constructors.
    foreach ltype $listTypes {
	test ltype-verify-unshared-makeList-$ltype "Verify makeList is unshared" -body {
	    regexp {refcount of 1,} [tcl::unsupported::representation [makeList $ltype]]
	} -result 1
    }
    foreach ltype1 $nestableTypes {
	foreach ltype2 $nestableTypes {
	    foreach ltype3 $listTypes {
		test ltype-verify-makeNestedList-$ltype1-$ltype2-$ltype3 "Verify makeNestedList" -body {
		    set l [makeNestedList $ltype1 $ltype2 $ltype3]
		    list [getListType $l] [getListType [lindex $l 0]] [getListType [lindex $l 0 0]]
		} -result [list $ltype1 $ltype2 $ltype3]
	    }
	}
    }

    # Wrapper to generate uncompiled, compiled script, and proc cases for a
    # test. If $args does not contain a -body key, $comment is treated as the
    # test body
    proc testdef {id comment args} {
	if {[dict exists $args -body]} {
	    set body [dict get $args -body]
	    dict unset args -body
	} else {
	    set body $comment
	}

	dict lappend args -constraints testobj
	dict append args -cleanup "\nunset -nocomplain l l1 l2 l3 a b c d e f g"

	uplevel 1 [list test $id.uncompiled "$comment (uncompiled)" \
		       -body [list testevalex $body] \
		       {*}$args]

	uplevel 1 [list test $id.compiled-script "$comment (compiled script)" \
		       -body [list try $body] \
		       {*}$args]

	# Need to make namespace variables accessible to test body within proc
	set procbody [string cat \
			  "variable largeListLength\n" \
			  "variable smallListLength\n" \
			  "variable ltype\n" \
			  "variable ltype1\n" \
			  "variable ltype2\n" \
			  "variable ltype3\n" \
			  "variable zero\n" \
			  "variable ten\n" \
			  "variable minusOne\n" \
			  $body]

	dict append args -setup \n[list proc testxproc {} $procbody]
	dict append args -cleanup "\nrename testxproc {}"
	uplevel 1 [list test $id.proc "$comment (compiled proc)" \
		       -body testxproc \
		       {*}$args]
    }

    # llength
    foreach ltype $listTypes {
	testdef llength-$ltype-shared-0 "llength of shared type $ltype" -body {
	    set l [makeList $ltype]
	    list [getListType $l] [llength $l]
	} -result [list $ltype $largeListLength]

	testdef llength-$ltype-unshared-0 "llength of unshared type $ltype" -body {
	    llength [makeList $ltype]
	} -result $largeListLength
    }

    ################################################################
    # lindex tests - single index
    foreach ltype $listTypes {
	lassign [getFirstAndLast $ltype] first last

	testdef lindex-$ltype-shared-litarg-0 "lindex 0 of shared type $ltype" -body {
	    set l [makeList $ltype]
	    list [getListType $l] [lindex $l 0]
	} -result [list $ltype $first]

	testdef lindex-$ltype-shared-vararg-0 "lindex $zero of shared type $ltype" -body {
	    set l [makeList $ltype]
	    list [getListType $l] [lindex $l $zero]
	} -result [list $ltype $first]

	testdef lindex-$ltype-unshared-litarg-0 "lindex 0 of unshared type $ltype" -body {
	    lindex [makeList $ltype] 0
	} -result $first

	testdef lindex-$ltype-unshared-vararg-0 "lindex $zero of unshared type $ltype" -body {
	    lindex [makeList $ltype] $zero
	} -result $first

	testdef lindex-$ltype-shared-1 "lindex end of shared type $ltype" -body {
	    set l [makeList $ltype]
	    list [getListType $l] [lindex $l end]
	} -result [list $ltype $last]

	testdef lindex-$ltype-unshared-1 "lindex end of unshared type $ltype" -body {
	    lindex [makeList $ltype] end
	} -result $last

	testdef lindex-$ltype-shared-2 "lindex -1 of shared type $ltype" -body {
	    set l [makeList $ltype]
	    list [getListType $l] [lindex $l -1]
	} -result [list $ltype {}]

	testdef lindex-$ltype-unshared-2 "lindex -1 of unshared type $ltype" -body {
	    lindex [makeList $ltype] -1
	} -result {}

	testdef lindex-$ltype-shared-3 "lindex last of shared type $ltype" -body {
	    set l [makeList $ltype]
	    list [getListType $l] [lindex $l [llength $l]]
	} -result [list $ltype {}]

	testdef lindex-$ltype-unshared-3 "lindex last of unshared type $ltype" -body {
	   lindex [makeList $ltype] $largeListLength
	} -result {}

	testdef lindex-$ltype-bad-index "lindex $ltype bad index" -body {
	    lindex [makeList $ltype] badindex
	} -result {bad index "badindex": must be integer?[+-]integer? or end?[+-]integer?} -returnCodes error
    }

    # lindex tests - nested indices, both single indices arg and multiple args forms
    foreach ltype1 $nestableTypes {
	foreach ltype2 $nestableTypes {
	    foreach ltype3 $listTypes {
		lassign [getFirstAndLast $ltype3] first last
		foreach {indices result} [list \
					      {0 0 0} $first \
					      {0 0 end} $last \
					      {0 0 -1} {} \
					      [list 0 0 $largeListLength] {} \
					      {0 -1 0} {} \
					      [list 0 $largeListLength 0] {} \
		] {
		    testdef lindex-nested-onearg-$ltype1-$ltype2-$ltype3-[join $indices ,] "lindex nested single indices argument $ltype1 $ltype2 $ltype3 $indices" \
			-body {
			    variable indices
			    lindex [makeNestedList $ltype1 $ltype2 $ltype3] $indices
			} -result $result

		    testdef lindex-nested-multiarg-$ltype1-$ltype2-$ltype3-[join $indices ,] "lindex nested multiple index arguments $ltype1 $ltype2 $ltype3 $indices" \
			-body {
			    variable indices
			    lindex [makeNestedList $ltype1 $ltype2 $ltype3] {*}$indices
			} -result $result
		}
	    }
	}
    }

    # Tests for Tcl_ListObjIndex as sematics are different from lindex for
    # out of bounds (oob) indices. Out of bounds should return a null pointer and
    # not empty string.
    foreach ltype $listTypes {
	test lindex-oob-$ltype "Tcl_ListObjIndex out of bounds index for $ltype lists" -setup {
	    set l [makeList $ltype]
	    testobj set 1 $l
	    set len [llength $l]
	} -body {
	    list [lindex $l -1] [lindex $l $len] \
		[testlistobj index 1 -1] [testlistobj index 1 $len]
	} -cleanup {
	    testobj freeallvars
	    unset -nocomplain l len
	} -result [list {} {} null null]
    }

    ################################################################
    # lappend tests
    # lappend result is always a non-abstract list. All the tests below do is
    # confirm abstract lists are converted to non-abstract and appended to
    # and further that in the case of shared objects, they are not changed
    # or shimmered.
    # Test variations of lappend (multiple args etc) are not tested here.
    # See listObj.test and listRep.test for those.
    foreach ltype $listTypes {
	testdef lappend-$ltype-unshared "lappend to unshared list of type $ltype " -body {
	    set result {}
	    set l [makeList $ltype]
	    lappend result [getListType $l]
	    lappend result [testobj objrefcount $l]; # 2 -> 1 for var l + 1 for arg
	    lappend l X
	    lappend result [getListType $l]
	    lappend result [testobj objrefcount $l]; # 2 -> 1 for var l + 1 for arg
	    lappend result [string equal $l [string cat [makeList $ltype] " X"]]
	} -result [list $ltype 2 [expr {$ltype eq "spanlist" ? "spanlist" : "list"}] 2 1]

	testdef lappend-$ltype-shared "lappend to shared list of type $ltype" -body {
	    set result {}
	    set l [makeList $ltype]
	    set l2 $l
	    lappend result [getListType $l]
	    lappend result [testobj objrefcount $l]; # 3: l, l2, arg
	    lappend result [testobj objrefcount $l2]; # ditto
	    lappend l X
	    lappend result [getListType $l]; # Will be list/spanlist
	    lappend result [getListType $l2]; # Should not have changed
	    lappend result [testobj objrefcount $l]; # Should drop by 1
	    lappend result [testobj objrefcount $l2]; # Should drop by 1
	    lappend result [string equal $l [string cat [makeList $ltype] " X"]]
	    lappend result [string equal $l2 [makeList $ltype]]
	} -result [list $ltype 3 3 [expr {$ltype eq "spanlist" ? "spanlist" : "list"}] $ltype 2 2 1 1]
    }

    ################################################################
    # lassign tests
    # The result of an lassign may be
    #  - a list (small operand lengths)
    #  - a spanlist (large operand lengths)
    #  - arithseries (for arithseries operand)
    #  - lrangeType (for operands other than lists, spanlists and arithseries)
    foreach ltype $listTypes {
	lassign [getFirstAndLast $ltype] first last
	switch $ltype {
	    list - spanlist {set ltype2 spanlist}
	    arithseries {set ltype2 arithseries}
	    default {set ltype2 rangeList}
	}

	testdef lassign-$ltype-unshared "lassign unshared list of type $ltype" -body {
	    set l [lassign [makeList $ltype] x]
	    list [getListType $l] $l $x
	} -result [list $ltype2 [lrange [makeList $ltype] 1 end] $first]

	testdef lassign-$ltype-shared "lassign shared list of type $ltype" -body {
	    set l0 [makeList $ltype]
	    set l [lassign $l0 x]
	    # The shared value should not shimmer
	    list [getListType $l0] $l0 [getListType $l] $l $x
	} -result [list $ltype [makeList $ltype] $ltype2 [lrange [makeList $ltype] 1 end] $first]

	# Except for arithseries, all small ranges are basic lists
	testdef lassign-$ltype-smalllist "lassign small list of type $ltype should always be non-abstract list" -body {
	    set l [lassign [makeList $ltype 100] x]
	    list [getListType $l] $l $x
	} -result [list [expr {$ltype eq "arithseries" ? "arithseries" : "list"}] [lrange [makeList $ltype 100] 1 end] [lindex [makeList $ltype 100] 0]]
    }

    ################################################################
    # ledit tests
    # Any modification operation will result in a shimmer to a list or spanlist.
    # General variations of ledit operations on lists and spanlists are tested
    # in lreplace.test.
    foreach ltype $listTypes {
	# prepend an element
	set expected [list X {*}[makeList $ltype]]
	testdef ledit-$ltype-prepend-unshared "ledit -1 -1 unshared $ltype shimmers to list" -body {
	    set l [makeList $ltype]
	    list [ledit l -1 -1 X] [isAbstractList $l] $l
	} -result [list $expected 0 $expected]
	testdef ledit-$ltype-prepend-shared "ledit -1 -1 shared $ltype shimmers to list" -body {
	    set l [makeList $ltype]
	    set l2 $l
	    list [ledit l -1 -1 X] [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list $expected 0 $expected $ltype [makeList $ltype]]

	# append an element
	set expected [list {*}[makeList $ltype] X]
	testdef ledit-$ltype-append-unshared "ledit end+1 end unshared $ltype shimmers to list" -body {
	    set l [makeList $ltype]
	    list [ledit l end+1 end X] [isAbstractList $l] $l
	} -result [list $expected 0 $expected]
	testdef ledit-$ltype-append-shared "ledit end+1 end+1 shared $ltype shimmers to list" -body {
	    set l [makeList $ltype]
	    set l2 $l
	    list [ledit l end+1 end+1 X] [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list $expected 0 $expected $ltype [makeList $ltype]]

	# replace an element
	set expected [list X {*}[lrange [makeList $ltype] 1 end]]
	testdef ledit-$ltype-replace-unshared "ledit 0 0 unshared $ltype shimmers to list" -body {
	    set l [makeList $ltype]
	    list [ledit l 0 0 X] [isAbstractList $l] $l
	} -result [list $expected 0 $expected]
	testdef ledit-$ltype-replace-shared "ledit 0 0 shared $ltype shimmers to list" -body {
	    set l [makeList $ltype]
	    set l2 $l
	    list [ledit l 0 0 X] [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list $expected 0 $expected $ltype [makeList $ltype]]

	# Remove an element
	set expected [list {*}[makeList $ltype]]
	set expected [list {*}[lrange $expected 0 9] {*}[lrange $expected 11 end]]
	testdef ledit-$ltype-remove-unshared "ledit 10 10 unshared $ltype shimmers to list" -body {
	    set l [makeList $ltype]
	    list [ledit l 10 10] [isAbstractList $l] $l
	} -result [list $expected 0 $expected]
	testdef ledit-$ltype-remove-shared "ledit 10 10 shared $ltype shimmers to list" -body {
	    set l [makeList $ltype]
	    set l2 $l
	    list [ledit l 10 10] [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list $expected 0 $expected $ltype [makeList $ltype]]

    }

    ################################################################
    # lreplace tests
    # Any modification operation will result in a shimmer to a list or spanlist.
    # General variations of lreplace operations on lists and spanlists are tested
    # in lreplace.test.
    foreach ltype $listTypes {
	# prepend an element
	set expected [list X {*}[makeList $ltype]]
	testdef lreplace-$ltype-prepend-unshared "lreplace -1 -1 unshared $ltype shimmers to list" -body {
	    set l [lreplace [makeList $ltype] -1 -1 X]
	    list [isAbstractList $l] $l
	} -result [list 0 $expected]
	testdef lreplace-$ltype-prepend-shared "lreplace -1 -1 shared $ltype shimmers to list" -body {
	    set l2 [makeList $ltype]
	    set l [lreplace $l2 -1 -1 X]
	    list [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list 0 $expected $ltype [makeList $ltype]]

	# append an element
	set expected [list {*}[makeList $ltype] X]
	testdef lreplace-$ltype-append-unshared "lreplace end+1 end unshared $ltype shimmers to list" -body {
	    set l [lreplace [makeList $ltype] end+1 end X]
	    list  [isAbstractList $l] $l
	} -result [list 0 $expected]
	testdef lreplace-$ltype-append-shared "lreplace end+1 end+1 shared $ltype shimmers to list" -body {
	    set l2 [makeList $ltype]
	    set l [lreplace $l2 end+1 end+1 X]
	    list [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list 0 $expected $ltype [makeList $ltype]]

	# replace an element
	set expected [list X {*}[lrange [makeList $ltype] 1 end]]
	testdef lreplace-$ltype-replace-unshared "lreplace 0 0 unshared $ltype shimmers to list" -body {
	    set l [lreplace [makeList $ltype] 0 0 X]
	    list  [isAbstractList $l] $l
	} -result [list 0 $expected]

	testdef lreplace-$ltype-replace-shared "lreplace 0 0 shared $ltype shimmers to list" -body {
	    set l2 [makeList $ltype]
	    set l [lreplace $l2 0 0 X]
	    list [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list 0 $expected $ltype [makeList $ltype]]

	# Remove an element
	set expected [list {*}[makeList $ltype]]
	set expected [list {*}[lrange $expected 0 9] {*}[lrange $expected 11 end]]
	testdef lreplace-$ltype-remove-unshared "lreplace 10 10 unshared $ltype shimmers to list" -body {
	    set l [lreplace [makeList $ltype] 10 10]
	    list [isAbstractList $l] $l
	} -result [list 0 $expected]
	testdef lreplace-$ltype-remove-shared "lreplace 10 10 shared $ltype shimmers to list" -body {
	    set l2 [makeList $ltype]
	    set l [lreplace $l2 10 10]
	    list [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list 0 $expected $ltype [makeList $ltype]]

    }

    ################################################################
    # linsert tests
    # Any modification operation will result in a shimmer to a list or spanlist.
    # These are then covered in linsert.test and listRep.test
    foreach ltype $listTypes {
	# linsert at 0
	set expected [list X {*}[makeList $ltype]]
	testdef linsert-$ltype-prepend-unshared "linsert 0 unshared $ltype shimmers to list" -body {
	    set l [linsert [makeList $ltype] 0 X]
	    list [isAbstractList $l] $l
	} -result [list 0 $expected]
	testdef linsert-$ltype-prepend-shared "linsert 0 shared $ltype shimmers to list" -body {
	    set l2 [makeList $ltype]
	    set l [linsert $l2 0 X]
	    list [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list 0 $expected $ltype [makeList $ltype]]

	# append an element
	set expected [list {*}[makeList $ltype] X]
	testdef linsert-$ltype-append-unshared "linsert end+1 unshared $ltype shimmers to list" -body {
	    set l [linsert [makeList $ltype] end+1 X]
	    list [isAbstractList $l] $l
	} -result [list 0 $expected]
	testdef linsert-$ltype-append-shared "linsert end+1 shared $ltype shimmers to list" -body {
	    set l2 [makeList $ltype]
	    set l [linsert $l2 end+1 X]
	    list [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list 0 $expected $ltype [makeList $ltype]]

	# insert multiple elements
	set expected [list {*}[makeList $ltype]]
	set expected [list {*}[lrange $expected 0 9] X Y {*}[lrange $expected 10 end]]
	testdef linsert-$ltype-multiple-unshared "linsert multiple unshared $ltype shimmers to list" -body {
	    set l [linsert [makeList $ltype] 10 X Y]
	    list [isAbstractList $l] $l
	} -result [list 0 $expected]
	testdef linsert-$ltype-multiple-shared "linsert multiple shared $ltype shimmers to list" -body {
	    set l2 [makeList $ltype]
	    set l [linsert $l2 10 X Y]
	    list [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list 0 $expected $ltype [makeList $ltype]]
    }

    ################################################################
    # lsearch tests
    # Will shimmer to a list or spanlist.
    foreach ltype $listTypes {
	testdef lsearch-$ltype "lsearch $ltype" -body {
	    set l [makeList $ltype]
	    set needle [lindex $l 10]
	    list [expr {
		  [lsearch $l $needle] == [lsearch [makeNonAbstract $l] $needle]
	      }] [isAbstractList $l]
	} -result [list 1 [expr {$ltype eq "arithseries" ? 1 : 0}]]
    }

    ################################################################
    # lset tests
    # Any modification operation will result in a shimmer to a list or spanlist.
    foreach ltype $listTypes {
	set expected [makeNonAbstract [makeList $ltype]]
	set expected [list {*}[lrange $expected 0 9] X {*}[lrange $expected 11 end]]
	testdef lset-$ltype-unshared "lset 0 unshared" -body {
	    set l [makeList $ltype]
	    list [lset l 10 X] [isAbstractList $l]
	} -result [list $expected 0]
	testdef lset-$ltype-shared "lset 0 shared" -body {
	    set l2 [makeList $ltype]
	    set l $l2
	    list [lset l 10 X] [isAbstractList $l] $l2 [getListType $l2]
	} -result [list $expected 0 [makeList $ltype] $ltype]

	# appending is a special case
	set expected [makeNonAbstract [makeList $ltype]]
	lappend expected X
	testdef lset-$ltype-unshared-append "lset end+1 unshared" -body {
	    set l [makeList $ltype]
	    list [lset l end+1 X] [isAbstractList $l]
	} -result [list $expected 0]
	testdef lset-$ltype-shared-first "lset end+1 shared" -body {
	    set l2 [makeList $ltype]
	    set l $l2
	    list [lset l end+1 X] [isAbstractList $l] $l2 [getListType $l2]
	} -result [list $expected 0 [makeList $ltype] $ltype]

    }
    # lset - nested indices
    foreach ltype1 $nestableTypes {
	foreach ltype2 $nestableTypes {
	    foreach ltype3 $listTypes {
		foreach {indices resultIndices} \
		    [list \
			 {0 0 0} {0 0 0} \
			 {10 10 10} {10 10 10} \
			 {end end end} {end end end} \
			 {end+1 end+1 end+1} {end end end} \
		] {
		    testdef lset-nested-onearg-$ltype1-$ltype2-$ltype3-[join $indices ,] \
			"lset nested single indices argument $ltype1 $ltype2 $ltype3 $indices" \
			-body {
			    variable indices
			    variable resultIndices
			    set l [makeNestedList $ltype1 $ltype2 $ltype3]
			    lset l $indices X
			    list [isAbstractList $l] [lindex $l $resultIndices]
			} -result {0 X}

		    testdef lset-nested-multiarg-$ltype1-$ltype2-$ltype3-[join $indices ,] "lset nested multiple index arguments $ltype1 $ltype2 $ltype3 $indices" \
			-body {
			    variable indices
			    variable resultIndices
			    set l [makeNestedList $ltype1 $ltype2 $ltype3]
			    lset l {*}$indices X
			    list [isAbstractList $l] [lindex $l $resultIndices]
			} -result {0 X}
		}
	    }
	}
    }

    ################################################################
    # lsort tests
    # Test not correctness but rather that sorts same as non-abstract sort
    # which is presumably correct.
    foreach ltype $listTypes {
	testdef lsort-$ltype-unshared "lsort unshared $ltype" -body {
	    set l [lsort [makeList $ltype]]
	    list [isAbstractList $l] $l
	} -result [list 0 [lsort [makeNonAbstract [makeList $ltype]]]]

	testdef lsort-$ltype-shared "lsort unshared $ltype" -body {
	    set l2 [makeList $ltype]
	    set l [lsort $l2]
	    # Note: $l2 is shimmered by lsort.
	    # TODO - consider changing lsort to not shimmer its argument.
	    list [isAbstractList $l] $l $l2
	} -result [list 0 [lsort [makeNonAbstract [makeList $ltype]]] [makeList $ltype]]
	testdef lsort-$ltype-unshared-decreasing "lsort -decreasing unshared $ltype" -body {
	    set l [lsort -decreasing [makeList $ltype]]
	    list [isAbstractList $l] $l
	} -result [list 0 [lsort -decreasing [makeNonAbstract [makeList $ltype]]]]

	testdef lsort-$ltype-shared-decreasing "lsort unshared $ltype" -body {
	    set l2 [makeList $ltype]
	    set l [lsort -decreasing $l2]
	    # Note: $l2 is shimmered by lsort.
	    # TODO - consider changing lsort to not shimmer its argument.
	    list [isAbstractList $l] $l $l2
	} -result [list 0 [lsort -decreasing [makeNonAbstract [makeList $ltype]]] [makeList $ltype]]
    }

    ################################################################
    # foreach tests
    foreach ltype $listTypes {
	testdef foreach-$ltype-unshared "foreach unshared $ltype" -body {
	    set l {}
	    foreach v [makeList $ltype] {
		lappend l $v
	    }
	    set l
	} -result [makeList $ltype]
	testdef foreach-$ltype-shared "foreach shared $ltype" -body {
	    set l [makeList $ltype]
	    set l2 {}
	    foreach v $l {
		lappend l2 $v
	    }
	    list [getListType $l] $l [getListType $l2] $l2
	} -result [list $ltype [makeList $ltype] list [makeList $ltype]]
	testdef foreach-$ltype-empty-elements "foreach $ltype empty elements" -body {
	    set l {}
	    foreach {a b c d e f g} [makeList $ltype] {
		lappend l $a $b $c $d $e $f $g
	    }
	    set l
	} -result [list {*}[makeList $ltype] {*}[lrepeat [expr (7-$largeListLength%7)] {}]]
    }

    ################################################################
    # lmap tests
    # Aside from correct results, should not shimmer original
    foreach ltype $listTypes {
	testdef lmap-$ltype-unshared "lmap unshared $ltype" -body {
	    lmap v [makeList $ltype] {
		set v
	    }
	} -result [makeList $ltype]
	testdef lmap-$ltype-shared "lmap shared $ltype" -body {
	    set l [makeList $ltype]
	    set l2 [lmap v $l {
		set v
	    }]
	    list [getListType $l] $l [getListType $l2] $l2
	} -result [list $ltype [makeList $ltype] list [makeList $ltype]]
	testdef lmap-$ltype-empty-elements "lmap $ltype empty elements" -body {
	    concat {*}[lmap {a b c d e f g} [makeList $ltype] {
		list $a $b $c $d $e $f $g
	    }]
	} -result [list {*}[makeList $ltype] {*}[lrepeat [expr (7-$largeListLength%7)] {}]]

    }

    ################################################################
    # concat tests
    # TODO - the concat command shimmers all args except first because it calls
    # Tcl_ListObjAppendList under the covers. Should fix to not shimmer and then
    # add a check in test below for that.
    foreach ltype1 $listTypes {
	foreach ltype2 $listTypes {
	    testdef concat-$ltype1-$ltype2 "concat $ltype1 $ltype2" -body {
		set l1 [makeList $ltype1]
		set l2 [makeList $ltype2]
		list \
		    [concat $l1 $l2] \
		    [getListType $l1]
	    } -result [list [concat [getNonAbstract $ltype1] [getNonAbstract $ltype2]] $ltype1]
	}
    }

    ################################################################
    # join tests
    foreach ltype $listTypes {
	    testdef join-$ltype "join $ltype" -body {
		set l [makeList $ltype]
		list [join $l ,] [getListType $l]
	    } -result [list [join [getNonAbstract $ltype] ,] $ltype]
    }

    ################################################################
    # lpop tests
    # Always shimmers to non-abstract list.
    foreach ltype $listTypes {
	lassign [getFirstAndLast $ltype] first last
	testdef lpop-$ltype-noargs "lpop $ltype" -body {
	    set l [makeList $ltype]
	    list [lpop l] [isAbstractList $l] $l
	} -result [list $last 0 [lrange [getNonAbstract $ltype] 0 end-1]]
	testdef lpop-$ltype-first "lpop $ltype 0" -body {
	    set l [makeList $ltype]
	    list [lpop l 0] [isAbstractList $l] $l
	} -result [list $first 0 [lrange [getNonAbstract $ltype] 1 end]]

	testdef lpop-$ltype-middle "lpop $ltype 10" -body {
	    set l [makeList $ltype]
	    list [lpop l 10] [isAbstractList $l] $l
	} -result [list [lindex [makeList $ltype] 10] \
		       0 \
		       [list \
			    {*}[lrange [getNonAbstract $ltype] 0 9] \
			    {*}[lrange [getNonAbstract $ltype] 11 end]]]
    }

    # lpop - nested indices
    # Only two levels. Three levels takes too long with memdbg or valgrind
    foreach ltype1 $nestableTypes {
	foreach ltype2 $listTypes {
	    lassign [getFirstAndLast $ltype2] first last
	    foreach indices [list {0 0} {3 3} {end end} ] {
		set index [lindex $indices 0]
		set expected [makeNestedList $ltype1 $ltype2]
		set elem [lindex $expected $indices]
		set inner [lindex $expected [lindex $indices 0]]
		set inner [lremove $inner $index]
		lset expected [lindex $indices 0] $inner
		testdef lpop-nested-$ltype1-$ltype2-[join $indices ,] \
		    "lpop nested multiple index arguments $ltype1 $ltype2 $indices" \
		    -body {
			variable indices
			set l [makeNestedList $ltype1 $ltype2]
			list [lpop l {*}$indices] $l
		    } -result [list $elem $expected]
	    }
	}
    }

    ################################################################
    # lremove tests
    # First, last and middle are tested separately as they have
    # different code paths.
    foreach ltype $listTypes {
	# Remove first
	set expected [makeNonAbstract [lrange [makeList $ltype] 1 end]]
	testdef lremove-$ltype-first-unshared "lremove 0 unshared $ltype shimmers to list" -body {
	    set l [lremove [makeList $ltype] 0]
	    list [isAbstractList $l] $l
	} -result [list 0 $expected]
	testdef lremove-$ltype-first-shared "lremove 0 shared $ltype shimmers to list" -body {
	    set l2 [makeList $ltype]
	    set l [lremove $l2 0]
	    list [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list 0 $expected $ltype [makeList $ltype]]

	# Remove last
	set expected [makeNonAbstract [lrange [makeList $ltype] 0 end-1]]
	testdef lremove-$ltype-last-unshared "lremove end unshared $ltype shimmers to list" -body {
	    set l [lremove [makeList $ltype] end]
	    list [isAbstractList $l] $l
	} -result [list 0 $expected]
	testdef lremove-$ltype-last-shared "lremove end shared $ltype shimmers to list" -body {
	    set l2 [makeList $ltype]
	    set l [lremove $l2 end]
	    list [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list 0 $expected $ltype [makeList $ltype]]

	# Remove middle
	set expected [makeNonAbstract [makeList $ltype]]
	set expected [list {*}[lrange $expected 0 9] {*}[lrange $expected 11 end]]
	testdef lremove-$ltype-middle-unshared "lremove 10 unshared $ltype shimmers to list" -body {
	    set l [lremove [makeList $ltype] 10]
	    list [isAbstractList $l] $l
	} -result [list 0 $expected]
	testdef lremove-$ltype-middle-shared "lremove 10 shared $ltype shimmers to list" -body {
	    set l2 [makeList $ltype]
	    set l [lremove $l2 10]
	    list [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list 0 $expected $ltype [makeList $ltype]]

	# Remove out of order with duplicates
	set expected [makeNonAbstract [makeList $ltype]]
	set expected [list {*}[lrange $expected 1 9] \
			  {*}[lrange $expected 11 end-12] \
			  {*}[lrange $expected end-10 end-1]]
	testdef lremove-$ltype-multiple-unshared "lremove multiple unshared $ltype shimmers to list" -body {
	    set l [lremove [makeList $ltype] end 10 0 end-11 10 end-11]
	    list [isAbstractList $l] $l
	} -result [list 0 $expected]
	testdef lremove-$ltype-multiple-shared "lremove multiple shared $ltype shimmers to list" -body {
	    set l2 [makeList $ltype]
	    set l [lremove $l2 end 10 0 end-11 10 end-11]
	    list [isAbstractList $l] $l [getListType $l2] $l2
	} -result [list 0 $expected $ltype [makeList $ltype]]
    }

    ################################################################
    # expr in/ni operators
    foreach ltype $listTypes {
	testdef expr-in-$ltype-first "expr first in/ni list of type $ltype" -body {
	    set l [makeList $ltype]
	    list [expr {[lindex $l 0] in $l}] \
		[expr {[lindex $l 0] ni $l}] \
		[getListType $l]
	} -result [list 1 0 $ltype]
	testdef expr-in-$ltype-last "expr end in/ni list of type $ltype" -body {
	    set l [makeList $ltype]
	    list [expr {[lindex $l end] in $l}] \
		[expr {[lindex $l end] ni $l}] \
		[getListType $l]
	} -result [list 1 0 $ltype]
	testdef expr-in-$ltype-fail "value not in/ni list of type $ltype" -body {
	    set l [makeList $ltype]
	    list [expr {"XX" in $l}] \
		[expr {"XX" ni $l}] \
		[getListType $l]
	} -result [list 0 1 $ltype]
    }

    ################################################################
    # lreverse tests
    #

    # Reverse a list to produce a non-abstract list. lreverse will produce
    # an abstract list.
    proc doReverse {l} {
	set r [list ]
	foreach v $l {
	    set r [linsert $r 0 $v]
	}
	return $r
    }
    foreach ltype $listTypes {
	lassign [getFirstAndLast $ltype] first last
	switch $ltype {
	    reversedList {
		# reversing reversedList will give back the original
		set expectedType list
	    }
	    arithseries {
		set expectedType arithseries
	    }
	    default {
		set expectedType reversedList
	    }
	}
	testdef lreverse-$ltype "lreverse $ltype" -body {
	    set l [lreverse [makeList $ltype]]
	    list [getListType $l] [lindex $l 0] [lindex $l end] $l
	} -result [list $expectedType $last $first [doReverse [makeList $ltype]]]
    }
    testdef lreverse-small-list "lreverse of small non-abstract list is a non-abstract list" -body {
	set l [lreverse [makeList list $smallListLength]]
	list [getListType $l] $l
    } -result [list list [doReverse [makeList list $smallListLength]]]

    testdef lreverse-small-spanlist "lreverse of small spanlist is a non-abstract list" -body {
	set l [lreverse [makeList spanlist $smallListLength]]
	list [getListType $l] $l
    } -result [list list [doReverse [makeList list $smallListLength]]]

    testdef lreverse-hashchar "Verify string representation of lreverse when first char is #" -body {
	set l [lreverse [lrepeat $largeListLength #]]
	list [getListType $l] $l
    } -result [list reversedList [string cat "{#}" [string repeat " #" [expr {$largeListLength-1}]]]]

    testdef lreverse-brace "Verify string representation of lreverse when first char is brace" -body {
	set l [lreverse [lrepeat $largeListLength \{]]
	list [getListType $l] $l
    } -result [list reversedList [lreverse [makeNonAbstract [lrepeat $largeListLength \{]]]]

    ################################################################
    # lrepeat tests

    testdef lrepeat-zero-count "Verify zero count lrepeat" -body {
	set l [lrepeat 0 x y]
	list [getListType $l] $l
    } -result {none {}}

    testdef lrepeat-zero-arg "Verify zero arg lrepeat" -body {
	set l [lrepeat 10]
	list [getListType $l] $l
    } -result {none {}}

    testdef lrepeat-large "Verify type and string representation of large lrepeat" -body {
	set l [lrepeat $largeListLength a "b c"]
	list [getListType $l] $l
    } -result [list repeatedList [string cat "a {b c}" [string repeat " a {b c}" [expr {$largeListLength-1}]]]]

    # Note code paths for single and multiple args is different so two tests
    testdef lrepeat-small-onearg "Verify type and string representation of small lrepeat of single arg" -body {
	set l [lrepeat $smallListLength "b c"]
	list [getListType $l] $l
    } -result [list list [string cat "{b c}" [string repeat " {b c}" [expr {$smallListLength-1}]]]]

    testdef lrepeat-small-multiarg "Verify type and string representation of small lrepeat multiarg" -body {
	set l [lrepeat $smallListLength a "b c"]
	list [getListType $l] $l
    } -result [list list [string cat "a {b c}" [string repeat " a {b c}" [expr {$smallListLength-1}]]]]

    testdef lrepeat-large-hashchar "Verify string representation of large lrepeat when first char is #" -body {
	set l [lrepeat $largeListLength # a]
	list [getListType $l] $l
    } -result [list repeatedList [string cat "{#} a" [string repeat " # a" [expr {$largeListLength-1}]]]]

    testdef lrepeat-small-hashchar "Verify string representation of small lrepeat when first char is #" -body {
	set l [lrepeat $smallListLength # a]
	list [getListType $l] $l
    } -result [list list [string cat "{#} a" [string repeat " # a" [expr {$smallListLength-1}]]]]

    testdef lrepeat-large-brace "Verify string representation of large lrepeat when first char is brace" -body {
	set l [lrepeat $largeListLength \{]
	list [getListType $l] [string equal $l [string cat "\\\{" [string repeat " \\\{" [expr {$largeListLength-1}]]]]
    } -result {repeatedList 1}

    testdef lrepeat-small-brace "Verify string representation of small lrepeat when first char is brace" -body {
	set l [lrepeat $smallListLength \{]
	list [getListType $l] [string equal $l [string cat "\\\{" [string repeat " \\\{" [expr {$smallListLength-1}]]]]
    } -result {list 1}

    ################################################################
    # lrange tests
    # The result of an lrange may be
    #  - a list (small operand lengths)
    #  - a spanlist (large operand lengths)
    #  - arithseries (for arithseries operand)
    #  - lrangeType (for operands other than lists, spanlists and arithseries)
    # These tests depend on correct operation of lrange on non-abstract lists
    # (tested elsewhere)

    foreach ltype $listTypes {
	switch $ltype {
	    list - spanlist {set ltype2 spanlist}
	    arithseries {set ltype2 arithseries}
	    default {set ltype2 rangeList}
	}

	testdef lrange-$ltype-unshared "lrange unshared list of type $ltype" -body {
	    set l [lrange [makeList $ltype] 1 end-1]
	    list [getListType $l] $l
	} -result [list $ltype2 [lrange [getNonAbstract $ltype] 1 end-1]]

	testdef lrange-$ltype-shared "lrange shared list of type $ltype" -body {
	    set l0 [makeList $ltype]
	    set l [lrange $l0 1 [expr {$largeListLength-2}]]
	    # The shared value should not shimmer
	    list [getListType $l0] $l0 [getListType $l] $l
	} -result [list \
		       $ltype \
		       [makeList $ltype] $ltype2 [lrange [makeList $ltype] 1 end-1]]

	# Except for arithseries, all small ranges are basic lists
	testdef lrange-$ltype-smalllist "lrange small list of type $ltype" -body {
	    set l [lrange [makeList $ltype] 1 10]
	    list [getListType $l] $l
	} -result [list \
		       [expr {$ltype eq "arithseries" ? "arithseries" : "list"}] \
		       [lrange [getNonAbstract $ltype] 1 10]]
    }

    ################################################################
    # Raw C API tests

    # Tcl_ListObjRepeat
    #
    # - refCount of result is checked for 0 but that is not by
    #   API contract but is expected for current implementation.
    # - on invalid counts, returned Tcl_Obj * is set to NULL but
    #   that is again not by contract, but current implementation
    #   so unchecked return status is caught early.

    test Tcl_ListObjRepeat-repeat0-noargs {
	Tcl_ListObjRepeat 0
    } -body {
	set apiresult [testlistapi Tcl_ListObjRepeat 0]
	dict with apiresult {}
	list $status $resultRefCount $resultType $result
    } -cleanup {
	unset -nocomplain {*}[dict keys $apiresult] apiresult
    } -result [list 0 0 "" {}]

    test Tcl_ListObjRepeat-repeat0-withargs {
	Tcl_ListObjRepeat 0 x y
    } -body {
	set apiresult [testlistapi Tcl_ListObjRepeat 0 x y]
	dict with apiresult {}
	list $status $resultRefCount $resultType $result
    } -cleanup {
	unset -nocomplain {*}[dict keys $apiresult] apiresult
    } -result [list 0 0 "" {}]

    test Tcl_ListObjRepeat-repeatN-noargs {
	Tcl_ListObjRepeat 10
    } -body {
	set apiresult [testlistapi Tcl_ListObjRepeat 10]
	dict with apiresult {}
	list $status $resultRefCount $resultType $result
    } -cleanup {
	unset -nocomplain {*}[dict keys $apiresult] apiresult
    } -result [list 0 0 "" {}]

    test Tcl_ListObjRepeat-repeat-large {
	Tcl_ListObjRepeat with total elements above threshold
    } -body {
	set apiresult [testlistapi Tcl_ListObjRepeat 20 a b c d e f g h i j]
	dict with apiresult {}
	list $status $resultRefCount $resultType [join $result ""]
    } -cleanup {
	unset -nocomplain {*}[dict keys $apiresult] apiresult
    } -result [list 0 0 repeatedList [string repeat abcdefghij 20]]

    test Tcl_ListObjRepeat-repeat-small {
	Tcl_ListObjRepeat with total elements below threshold
    } -body {
	set apiresult [testlistapi Tcl_ListObjRepeat 2 a b c d e f g h i j]
	dict with apiresult {}
	list $status $resultRefCount $resultType [join $result ""]
    } -cleanup {
	unset -nocomplain {*}[dict keys $apiresult] apiresult
    } -result [list 0 0 list [string repeat abcdefghij 2]]

    test Tcl_ListObjRepeat-invalid-repeatcount {
	Invalid count should return NULL in resultPtr
    } -body {
	set apiresult [testlistapi Tcl_ListObjRepeat -1 x]
	dict with apiresult {}
	list $status $result $resultPtr
    } -cleanup {
	unset -nocomplain {*}[dict keys $apiresult] apiresult
    } -result [list 1 {bad count "-1": must be integer >= 0} 0]

    test Tcl_ListObjRepeat-toolarge-repeatcount {
	Too large a count should return NULL in resultPtr
    } -body {
	set apiresult [testlistapi Tcl_ListObjRepeat \
			   [expr {$::tcltests::TCL_SIZE_MAX/2}] x y]
	dict with apiresult {}
	list $status $result $resultPtr
    } -cleanup {
	unset -nocomplain {*}[dict keys $apiresult] apiresult
    } -result [list 1 {max length * exceeded} 0] -match glob

    # Tcl_ListObjRange
    #
    # Aside from the correct range result,
    # - Source object type must not change (except spanlist->list
    #   since the type returned at C level is list for both
    #   list and spanlist)
    # - Source object reference counts may increase by at most 1
    # - Result object must not be same as source object even if unshared
    # - Small ranges are non-abstract lists
    #
    # In addition, in the *current* implementation, but not guaranteed
    # by the contract in the documented API,
    # - $resultRefCount is 0 (i.e. unshared object is returned)
    # - on errors, the result Tcl_Obj * is set to NULL
    # This may change in a future implementation, in which case the tests
    # will have to be modified.

    foreach ltype $listTypes {
	switch $ltype {
	    list - spanlist {
		set ltype2 list; # Because the C level does not distinguish
	    }
	    arithseries {set ltype2 arithseries}
	    default {set ltype2 rangeList}
	}
	# Check normal operation with unshared (0, 1) and shared objects
	foreach nrefs {0 1 2} {
	    test Tcl_ListObjRange-$ltype-nrefs$nrefs \
		"Tcl_ListObjRange for $ltype lists 1 end-1" -body {
		set apiresult \
		    [testlistapi Tcl_ListObjRange $nrefs \
			 [makeList $ltype] 1 [expr {$largeListLength-2}]]
		dict with apiresult {}
		set srcRefDiff [expr {$srcRefCount-$nrefs}]
		list $status [tcl::mathop::<= 0 $srcRefDiff 1] $srcType \
		    $resultRefCount $resultType $result \
		    [expr {$srcPtr != $resultPtr}]
	    } -cleanup {
		unset -nocomplain {*}[dict keys $apiresult] apiresult
	    } -result [list 0 1 \
			   [expr {$ltype eq "spanlist" ? "list" : $ltype}] \
			   0 $ltype2 \
			   [lrange [getNonAbstract $ltype] 1 end-1] \
			   1]

	    # Small ranges are always plain old lists
	    test Tcl_ListObjRange-$ltype-nrefs$nrefs-smalllist \
		"Tcl_ListObjRange for $ltype lists 1 10" -body {
		set apiresult [testlistapi Tcl_ListObjRange $nrefs \
				   [makeList $ltype] 1 10]
		dict with apiresult {}
		list $status $srcRefCount $srcType $resultRefCount \
		    $resultType $result [expr {$srcPtr != $resultPtr}]
	    } -cleanup {
		unset -nocomplain {*}[dict keys $apiresult] apiresult
	    } -result [list 0 $nrefs \
			   [expr {$ltype eq "spanlist" ? "list" : $ltype}] \
			   0 \
			   [expr {$ltype in "arithseries" ? "arithseries" : "list"}] \
			   [lrange [getNonAbstract $ltype] 1 10] \
			   1]
	}
    }
    foreach nrefs {0 1 2} {
	test Tcl_ListObjRange-invalid-list-$nrefs {
	    Invalid list should return NULL in resultPtr
	} -body {
	    set apiresult [testlistapi Tcl_ListObjRange $nrefs \{ 0 0]
	    dict with apiresult {}; # Explode apiresult into status, srcRefCount ...
	    list $status $srcRefCount $result $resultPtr
	} -cleanup {
	    unset -nocomplain {*}[dict keys $apiresult] apiresult
	} -result [list 1 $nrefs {unmatched open brace in list} 0]
    }

    #-----

    # Tcl_ListObjReverse
    #
    # Aside from the correct result,
    # - Source object type must not change (except spanlist->list
    #   since the type returned at C level is list for both
    #   list and spanlist)
    # - Source object reference counts may increase by at most 1
    # - Result object must not be same as source object even if unshared
    # - Reverses of small non-abstract lists are non-abstract
    #
    # In addition, in the *current* implementation, but not guaranteed
    # by the contract in the documented API,
    # - on errors, the result Tcl_Obj * is set to NULL
    # This may change in a future implementation, in which case the tests
    # will have to be modified.

    foreach ltype $listTypes {
	switch $ltype {
	    reversedList {
		# [makeList reversedList] is itself a reverse of a "list"
		set ltype2 list
	    }
	    arithseries {set ltype2 arithseries}
	    default {set ltype2 reversedList}
	}
	# Check normal operation with unshared (0, 1) and shared objects
	foreach nrefs {0 1 2} {
	    test Tcl_ListObjReverse-$ltype-nrefs$nrefs \
		"Tcl_ListObjReverse for $ltype list" -body {
		set apiresult \
		    [testlistapi Tcl_ListObjReverse $nrefs [makeList $ltype]]
		dict with apiresult {}
		set srcRefDiff [expr {$srcRefCount-$nrefs}]
		list $status [tcl::mathop::<= 0 $srcRefDiff 1] $srcType \
		    $resultType $result \
		    [expr {$srcPtr != $resultPtr}]
	    } -cleanup {
		unset -nocomplain {*}[dict keys $apiresult] apiresult
	    } -result [list 0 1 \
			   [expr {$ltype eq "spanlist" ? "list" : $ltype}] \
			   $ltype2 \
			   [doReverse [getNonAbstract $ltype]] \
			   1]

	    if {$ltype in {list spanlist}} {
		test Tcl_ListObjReverse-$ltype-nrefs$nrefs-smalllist \
		    "Tcl_ListObjReverse for $ltype (small)" -body {
			set apiresult [testlistapi Tcl_ListObjReverse $nrefs \
					   [makeList $ltype $smallListLength]]
			dict with apiresult {}
			list $status $srcRefCount $srcType $resultRefCount \
			    $resultType $result [expr {$srcPtr != $resultPtr}]
		    } -cleanup {
			unset -nocomplain {*}[dict keys $apiresult] apiresult
		    } -result [list 0 $nrefs \
				   list \
				   0 \
				   list \
				   [doReverse [getNonAbstract $ltype $smallListLength]] \
				   1]
	    }
	}
    }
    foreach nrefs {0 1 2} {
	test Tcl_ListObjReverse-invalid-list-$nrefs {
	    Invalid list should return NULL in resultPtr
	} -body {
	    set apiresult [testlistapi Tcl_ListObjReverse $nrefs \{]
	    dict with apiresult {}
	    list $status $srcRefCount $result $resultPtr
	} -cleanup {
	    unset -nocomplain {*}[dict keys $apiresult] apiresult
	} -result [list 1 $nrefs {unmatched open brace in list} 0]
    }

    #-----

    ################################################################
    # Checks for memory leaks in raw C API
    # If Tcl has been compiled with memory checking, use it, else will rely
    # on valgrind -DPURIFY builds.
    if {[namespace which ::memory] eq {}} {
	set memcheckcmd [list ::apply [list script {
	    uplevel 1 $script
	    return 0
	} [namespace current]]]
    } else {
	set memcheckcmd ::tcltests::scriptmemcheck
    }

    ## Test Tcl_ListObjIndex does not leak memory

    test memcheck-lindex-list {
	Tcl_ListObjIndex memory leaks for native lists
    } -constraints {testobj} -body {
	list [{*}$memcheckcmd {
	    testobj set 1 [testlistrep new 1000]
	    assertListType [testobj duplicate 1 2] list
	    set errorMessage [testlistobj indexmemcheck 1]
	    testobj freeallvars
	}] $errorMessage
    } -result {0 {}}

    test memcheck-lindex-spanlist {
	Tcl_ListObjIndex memory leaks for native lists
    } -constraints {testobj} -body {
	list [{*}$memcheckcmd {
	    testobj set 1 [testlistrep new 1000 10 10]
	    assertListType [testobj duplicate 1 2] spanlist
	    set errorMessage [testlistobj indexmemcheck 1]
	    testobj freeallvars
	}] $errorMessage
    } -result {0 {}}

    test memcheck-lindex-arithseries {
	Tcl_ListObjIndex memory leaks for lseq
    } -constraints {testobj} -body {
	list [{*}$memcheckcmd {
	    testobj set 1 [lseq 1000]
	    set errorMessage [testlistobj indexmemcheck 1]
	    testobj freeallvars
	}] $errorMessage
    } -result {0 {}}

    test memcheck-lindex-repeatedList {
	Tcl_ListObjIndex memory leaks for lists of type repeatedList
    } -constraints {testobj} -body {
	list [{*}$memcheckcmd {
	    testobj set 1 [lrepeat $largeListLength [testobj new 2]]
	    set errorMessage [testlistobj indexmemcheck 1]
	    testobj freeallvars
	}] $errorMessage
    } -result {0 {}}

    test memcheck-lindex-reversedList {
	Tcl_ListObjIndex memory leaks for reversedList lists
    } -constraints {testobj} -body {
	list [{*}$memcheckcmd {
	    testobj set 1 [lreverse [testlistrep new 1000]]
	    assertListType [testobj duplicate 1 2] reversedList
	    set errorMessage [testlistobj indexmemcheck 1]
	    testobj freeallvars
	}] $errorMessage
    } -result {0 {}}

    test memcheck-lindex-rangeList {
	Tcl_ListObjIndex memory leaks for rangeList lists
    } -constraints {testobj} -body {
	list [{*}$memcheckcmd {
	    testobj set 1 [lrange \
			       [lrepeat $largeListLength [testobj new 2]] \
			       1 end-1]
	    assertListType [testobj duplicate 1 2] rangeList
	    set errorMessage [testlistobj indexmemcheck 1]
	    testobj freeallvars
	}] $errorMessage
    } -result {0 {}}

    ## Test Tcl_ListObjGetElements does not leak memory

    test memcheck-getelements-list {
	Tcl_ListObjElements memory leaks for native lists
    } -constraints {testobj} -body {
	list [{*}$memcheckcmd {
	    testobj set 1 [testlistrep new 1000]
	    assertListType [testobj duplicate 1 2] list
	    set errorMessage [testlistobj getelementsmemcheck 1]
	    testobj freeallvars
	}] $errorMessage
    } -result {0 {}}

    test memcheck-getelements-spanlist {
	Tcl_ListObjElements memory leaks for native lists
    } -constraints {testobj} -body {
	list [{*}$memcheckcmd {
	    testobj set 1 [testlistrep new 1000 10 10]
	    assertListType [testobj duplicate 1 2] spanlist
	    set errorMessage [testlistobj getelementsmemcheck 1]
	    testobj freeallvars
	}] $errorMessage
    } -result {0 {}}

    test memcheck-getelements-arithseries {
	Tcl_ListObjElements memory leaks for lseq
    } -constraints {testobj} -body {
	list [{*}$memcheckcmd {
	    testobj set 1 [lseq 1000]
	    set errorMessage [testlistobj getelementsmemcheck 1]
	    testobj freeallvars
	}] $errorMessage
    } -result {0 {}}

    test memcheck-getelements-repeatedList {
	Tcl_ListObjElements memory leaks for lists of type repeatedList
    } -constraints {testobj} -body {
	list [{*}$memcheckcmd {
	    testobj set 1 [lrepeat $largeListLength [testobj new 2]]
	    set errorMessage [testlistobj getelementsmemcheck 1]
	    testobj freeallvars
	}] $errorMessage
    } -result {0 {}}

    test memcheck-getelements-reversedList {
	Tcl_ListObjElements memory leaks for reversedList lists
    } -constraints {testobj} -body {
	list [{*}$memcheckcmd {
	    testobj set 1 [lreverse [testlistrep new 1000]]
	    assertListType [testobj duplicate 1 2] reversedList
	    set errorMessage [testlistobj getelementsmemcheck 1]
	    testobj freeallvars
	}] $errorMessage
    } -result {0 {}}

    test memcheck-getelements-rangeList {
	Tcl_ListObjElements memory leaks for rangeList lists
    } -constraints {testobj} -body {
	list [{*}$memcheckcmd {
	    testobj set 1 [lrange \
			       [lrepeat $largeListLength [testobj new 2]] \
			       1 end-1]
	    assertListType [testobj duplicate 1 2] rangeList
	    set errorMessage [testlistobj getelementsmemcheck 1]
	    testobj freeallvars
	}] $errorMessage
    } -result {0 {}}

    ## Test Tcl_ListObjReverse does not leak memory
    foreach ltype $listTypes {
	foreach nrefs {0 1 2} {
	    test memcheck-reverse-$ltype-nrefs$nrefs \
		"Tcl_ListObjReverse memory leaks for $ltype lists" \
		-constraints {testobj} \
		-body {
		    {*}$memcheckcmd {
			testlistapi Tcl_ListObjReverse $nrefs [makeList $ltype]
		    }
		} -result 0
	}
    }

    ## Test Tcl_ListObjRange does not leak memory
    foreach ltype $listTypes {
	foreach nrefs {0 1 2} {
	    test memcheck-range-$ltype-nrefs$nrefs \
		"Tcl_ListObjRange memory leaks for $ltype lists" \
		-constraints {testobj} \
		-body {
		    {*}$memcheckcmd {
			testlistapi Tcl_ListObjRange $nrefs [makeList $ltype] \
			    1 [expr {$largeListLength-2}]
		    }
		} -result 0
	}
    }

    ## Test Tcl_ListObjRepeat does not leak memory
    foreach ltype $listTypes {
	foreach repeatCount [list 0 $largeListLength] {
	    test memcheck-repeat-$ltype-count$repeatCount \
		"Tcl_ListObjRepeat memory leaks for $ltype lists" \
		-constraints {testobj} \
		-body {
		    {*}$memcheckcmd {
			testlistapi Tcl_ListObjRepeat $repeatCount x y
		    }
		} -result 0
	}
    }
}

# All done
::tcltest::cleanupTests