diff options
Diffstat (limited to 'tests/gc/gctest.nim')
-rw-r--r-- | tests/gc/gctest.nim | 210 |
1 files changed, 210 insertions, 0 deletions
diff --git a/tests/gc/gctest.nim b/tests/gc/gctest.nim new file mode 100644 index 000000000..78b78934c --- /dev/null +++ b/tests/gc/gctest.nim @@ -0,0 +1,210 @@ +discard """ + outputsub: "finished" +""" + +# Test the garbage collector. + +import + strutils + +type + PNode = ref TNode + TNode {.final.} = object + le, ri: PNode + data: string + + TTable {.final.} = object + counter, max: int + data: seq[string] + + TBNode {.final.} = object + other: PNode # a completely different tree + data: string + sons: seq[TBNode] # directly embedded! + t: TTable + + TCaseKind = enum nkStr, nkWhole, nkList + PCaseNode = ref TCaseNode + TCaseNode {.final.} = object + case kind: TCaseKind + of nkStr: data: string + of nkList: sons: seq[PCaseNode] + else: unused: seq[string] + + TIdObj* = object of RootObj + id*: int # unique id; use this for comparisons and not the pointers + + PIdObj* = ref TIdObj + PIdent* = ref TIdent + TIdent*{.acyclic.} = object of TIdObj + s*: string + next*: PIdent # for hash-table chaining + h*: int # hash value of s + +var + flip: int + +proc newCaseNode(data: string): PCaseNode = + if flip == 0: + result = PCaseNode(kind: nkStr, data: data) + else: + result = PCaseNode(kind: nkWhole, unused: @["", "abc", "abdc"]) + flip = 1 - flip + +proc newCaseNode(a, b: PCaseNode): PCaseNode = + result = PCaseNode(kind: nkList, sons: @[a, b]) + +proc caseTree(lvl: int = 0): PCaseNode = + if lvl == 3: result = newCaseNode("data item") + else: result = newCaseNode(caseTree(lvl+1), caseTree(lvl+1)) + +proc finalizeNode(n: PNode) = + assert(n != nil) + write(stdout, "finalizing: ") + writeLine(stdout, "not nil") + +var + id: int = 1 + +proc buildTree(depth = 1): PNode = + if depth == 7: return nil + new(result, finalizeNode) + result.le = buildTree(depth+1) + result.ri = buildTree(depth+1) + result.data = $id + inc(id) + +proc returnTree(): PNode = + writeLine(stdout, "creating id: " & $id) + new(result, finalizeNode) + result.data = $id + new(result.le, finalizeNode) + result.le.data = $id & ".1" + new(result.ri, finalizeNode) + result.ri.data = $id & ".2" + inc(id) + + # now create a cycle: + writeLine(stdout, "creating id (cyclic): " & $id) + var cycle: PNode + new(cycle, finalizeNode) + cycle.data = $id + cycle.le = cycle + cycle.ri = cycle + inc(id) + #writeLine(stdout, "refcount: " & $refcount(cycle)) + #writeLine(stdout, "refcount le: " & $refcount(cycle.le)) + #writeLine(stdout, "refcount ri: " & $refcount(cycle.ri)) + +proc printTree(t: PNode) = + if t == nil: return + writeLine(stdout, "printing") + writeLine(stdout, t.data) + printTree(t.le) + printTree(t.ri) + +proc unsureNew(result: var PNode) = + writeLine(stdout, "creating unsure id: " & $id) + new(result, finalizeNode) + result.data = $id + new(result.le, finalizeNode) + result.le.data = $id & ".a" + new(result.ri, finalizeNode) + result.ri.data = $id & ".b" + inc(id) + +proc setSons(n: var TBNode) = + n.sons = @[] # free memory of the sons + n.t.data = @[] + var + m: seq[string] + m = @[] + setLen(m, len(n.t.data) * 2) + for i in 0..high(m): + m[i] = "..." + n.t.data = m + +proc buildBTree(father: var TBNode) = + father.data = "father" + father.other = nil + father.sons = @[] + for i in 1..10: + write(stdout, "next iteration!\n") + var n: TBNode + n.other = returnTree() + n.data = "B node: " & $i + if i mod 2 == 0: n.sons = @[] # nil and [] need to be handled correctly! + add father.sons, n + father.t.counter = 0 + father.t.max = 3 + father.t.data = @["ha", "lets", "stress", "it"] + setSons(father) + +proc getIdent(identifier: cstring, length: int, h: int): PIdent = + new(result) + result.h = h + result.s = newString(length) + +proc main() = + discard getIdent("addr", 4, 0) + discard getIdent("hall", 4, 0) + discard getIdent("echo", 4, 0) + discard getIdent("huch", 4, 0) + + var + father: TBNode + for i in 1..1_00: + buildBTree(father) + + for i in 1..1_00: + var t = returnTree() + var t2: PNode + unsureNew(t2) + write(stdout, "now building bigger trees: ") + var t2: PNode + for i in 1..100: + t2 = buildTree() + printTree(t2) + write(stdout, "now test sequences of strings:") + var s: seq[string] = @[] + for i in 1..100: + add s, "hohoho" # test reallocation + writeLine(stdout, s[89]) + write(stdout, "done!\n") + +var + father {.threadvar.}: TBNode + s {.threadvar.}: string + + fatherAsGlobal: TBNode + +proc start = + s = "" + s = "" + writeLine(stdout, repr(caseTree())) + father.t.data = @["ha", "lets", "stress", "it"] + father.t.data = @["ha", "lets", "stress", "it"] + var t = buildTree() + write(stdout, repr(t[])) + buildBTree(father) + write(stdout, repr(father)) + + write(stdout, "starting main...\n") + main() + + GC_fullCollect() + # the M&S GC fails with this call and it's unclear why. Definitely something + # we need to fix! + #GC_fullCollect() + writeLine(stdout, GC_getStatistics()) + write(stdout, "finished\n") + +fatherAsGlobal.t.data = @["ha", "lets", "stress", "it"] +var tg = buildTree() +buildBTree(fatherAsGlobal) + +var thr: array[8, Thread[void]] +for i in low(thr)..high(thr): + createThread(thr[i], start) +joinThreads(thr) +start() |