From a1782592f5f1269d86d8ad446fcbc0b40b7e5808 Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Mon, 19 Dec 2022 10:28:46 +1000
Subject: tests: add garbage collection tests

These tests provoke the issues raised in #245 plus
some additional issues.

Signed-off-by: Steve Bennett <steveb@workware.net.au>
---
 tests/ref.test | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)

(limited to 'tests')

diff --git a/tests/ref.test b/tests/ref.test
index acc2793..fab95c9 100644
--- a/tests/ref.test
+++ b/tests/ref.test
@@ -21,6 +21,86 @@ test collect-1.1 {ensure globally scoped references are deleted} {
 	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
-- 
cgit v1.1