source [file dirname [info script]]/testing.tcl

needs constraint jim
needs cmd ref
needs cmd collect

test collect-1.1 {ensure globally scoped references are deleted} {
	collect
	set result {}

	# Create a globally scoped reference as a function name
	set a ::[ref testfunction -]
	proc $a {} { return 3 }
	lappend result [$a]
	# It shouldn't be collected
	lappend result [collect]
	lappend result [$a]
	unset a
	# Now it should be collected
	lappend result [collect]
	set result
} {3 0 3 1}

test collect-1.2 {gc reference from command table with no other ref} {
	# Create a lambda but don't call it
	lambda {} {}
	# And collect should remove it
	collect
} 1

test collect-1.3 {gc reference from command table with one other ref, then no ref} {
	# Create a lambda but don't call it
	set x [lambda {} {}]
	# And collect should not remove it (ref via $x)
	set result {}
	lappend result [collect]
	unset x
	# Now it should be collected
	lappend result [collect]
	set result
} {0 1}

test collect-1.4 {gc reference from command table with one other ref, then no ref} {
	# Create a lambda
	set x [lambda {} {}]
	# And call it
	$x
	# And collect should not remove it (ref via $x)
	set result {}
	lappend result [collect]
	unset x
	# Now it should be collected
	lappend result [collect]
	set result
} {0 1}

test collect-1.5 {gc with two single refs to the same object} {
	# Create a lambda
	set x [lambda {} {}]
	# And a second reference to it
	set y ${x}1
	set result {}
	unset x
	# now there is a singleton ref in the command table and y also refers to it
	lappend result [collect]
	unset y
	lappend result [collect]
	# And now only in the command table
	set result
} {0 1}

test collect-1.6 {unexpected collect} -body {
	package require oo

	class t { val 0 }
	t method setval {v} { set val $v }

	proc final {ref value} { list "Destroy $ref" }

	set l1 [list 99 96 98 97]
	set l2 [lmap i $l1 {
			set tt [t new]
			finalize $tt final
			list "Create $tt"
			$tt setval $i
			list $tt
		}]
	set getter [lambda {t} { list [$t get val] }]
	set entries [lsort -command \
		[lambda {a b} {upvar getter g; expr {[$g $a] - [$g $b]}}] $l2]

	foreach e $entries { list "$e [$e get val]" }
	# Should only collect the lsort lambda
	collect
} -result {1} -cleanup {
	unset l1
	unset l2
	unset getter
	unset entries
	unset e
	collect
}

test getref-1.1 {getref basic functionality} {
	set r [ref string tag]
	getref $r
} string

test getref-1.2 {getref fully qualified} {
	getref ::$r
} string

test setref-1.1 {setref basic functionality} {
	setref $r string2
	getref $r
} string2

test setref-1.2 {setref fully qualified} {
	setref ::$r string3
	getref ::$r
} string3

testreport