start of tests refactoring; sqlite3 new wrapper fixes

tests/gc/gcbench.nim

@@ -0,0 +1,163 @@
+# This is adapted from a benchmark written by John Ellis and Pete Kovac
+# of Post Communications.
+# It was modified by Hans Boehm of Silicon Graphics.
+#
+# This is no substitute for real applications. No actual application
+# is likely to behave in exactly this way. However, this benchmark was
+# designed to be more representative of real applications than other
+# Java GC benchmarks of which we are aware.
+# It attempts to model those properties of allocation requests that
+# are important to current GC techniques.
+# It is designed to be used either to obtain a single overall performance
+# number, or to give a more detailed estimate of how collector
+# performance varies with object lifetimes. It prints the time
+# required to allocate and collect balanced binary trees of various
+# sizes. Smaller trees result in shorter object lifetimes. Each cycle
+# allocates roughly the same amount of memory.
+# Two data structures are kept around during the entire process, so
+# that the measured performance is representative of applications
+# that maintain some live in-memory data. One of these is a tree
+# containing many pointers. The other is a large array containing
+# double precision floating point numbers. Both should be of comparable
+# size.
+#
+# The results are only really meaningful together with a specification
+# of how much memory was used. It is possible to trade memory for
+# better time performance. This benchmark should be run in a 32 MB
+# heap, though we don't currently know how to enforce that uniformly.
+#
+# Unlike the original Ellis and Kovac benchmark, we do not attempt
+# measure pause times. This facility should eventually be added back
+# in. There are several reasons for omitting it for now.  The original
+# implementation depended on assumptions about the thread scheduler
+# that don't hold uniformly. The results really measure both the
+# scheduler and GC. Pause time measurements tend to not fit well with
+# current benchmark suites. As far as we know, none of the current
+# commercial Java implementations seriously attempt to minimize GC pause
+# times.
+#
+# Known deficiencies:
+# - No way to check on memory use
+# - No cyclic data structures
+# - No attempt to measure variation with object size
+# - Results are sensitive to locking cost, but we dont
+#   check for proper locking
+#
+
+import
+  strutils, times
+
+type
+  PNode = ref TNode
+  TNode {.final.} = object
+    left, right: PNode
+    i, j: int
+
+proc newNode(L, r: PNode): PNode =
+  new(result)
+  result.left = L
+  result.right = r
+
+const
+  kStretchTreeDepth = 18 # about 16Mb
+  kLongLivedTreeDepth = 16  # about 4Mb
+  kArraySize  = 500000  # about 4Mb
+  kMinTreeDepth = 4
+  kMaxTreeDepth = 16
+
+# Nodes used by a tree of a given size
+proc TreeSize(i: int): int = return ((1 shl (i + 1)) - 1)
+
+# Number of iterations to use for a given tree depth
+proc NumIters(i: int): int =
+  return 2 * TreeSize(kStretchTreeDepth) div TreeSize(i)
+
+# Build tree top down, assigning to older objects.
+proc Populate(iDepth: int, thisNode: PNode) =
+  if iDepth <= 0:
+    return
+  else:
+    new(thisNode.left)
+    new(thisNode.right)
+    Populate(iDepth-1, thisNode.left)
+    Populate(iDepth-1, thisNode.right)
+
+# Build tree bottom-up
+proc MakeTree(iDepth: int): PNode =
+  if iDepth <= 0:
+    new(result)
+  else:
+    return newNode(MakeTree(iDepth-1), MakeTree(iDepth-1))
+
+proc PrintDiagnostics() =
+  echo("Total memory available: " & $getTotalMem() & " bytes")
+  echo("Free memory: " & $getFreeMem() & " bytes")
+
+proc TimeConstruction(depth: int) =
+  var
+    root, tempTree: PNode
+    t: int
+    iNumIters: int
+
+  iNumIters = NumIters(depth)
+
+  echo("Creating " & $iNumIters & " trees of depth " & $depth)
+  t = getStartMilsecs()
+  for i in 0..iNumIters-1:
+    new(tempTree)
+    Populate(depth, tempTree)
+    tempTree = nil
+  echo("\tTop down construction took " & $(getStartMilsecs() - t) & "msecs")
+  t = getStartMilsecs()
+  for i in 0..iNumIters-1:
+    tempTree = MakeTree(depth)
+    tempTree = nil
+  echo("\tBottom up construction took " & $(getStartMilsecs() - t) & "msecs")
+
+type
+  tMyArray = seq[float]
+
+proc main() =
+  var
+    root, longLivedTree, tempTree: PNode
+    t: int
+    myarray: tMyArray
+
+  echo("Garbage Collector Test")
+  echo(" Stretching memory with a binary tree of depth " & $kStretchTreeDepth)
+  PrintDiagnostics()
+  t = getStartMilsecs()
+
+  # Stretch the memory space quickly
+  tempTree = MakeTree(kStretchTreeDepth)
+  tempTree = nil
+
+  # Create a long lived object
+  echo(" Creating a long-lived binary tree of depth " &
+        $kLongLivedTreeDepth)
+  new(longLivedTree)
+  Populate(kLongLivedTreeDepth, longLivedTree)
+
+  # Create long-lived array, filling half of it
+  echo(" Creating a long-lived array of " & $kArraySize & " doubles")
+  newSeq(myarray, kArraySize)
+  for i in 0..kArraySize div 2 -1:
+    myarray[i] = 1.0 / toFloat(i)
+
+  PrintDiagnostics()
+
+  var d = kMinTreeDepth
+  while d <= kMaxTreeDepth:
+    TimeConstruction(d)
+    inc(d, 2)
+
+  if longLivedTree == nil or myarray[1000] != 1.0/1000.0:
+    echo("Failed")
+    # fake reference to LongLivedTree
+    # and array to keep them from being optimized away
+
+  var elapsed = getStartMilsecs() - t
+  PrintDiagnostics()
+  echo("Completed in " & $elapsed & "ms.")
+
+main()

tests/gc/gctest.nim

@@ -0,0 +1,197 @@
+# Test the garbage collector:
+# This file is not in the test suite because it takes too much time.
+
+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 TObject
+    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 =
+  new(result)
+  if flip == 0:
+    result.kind = nkStr
+    result.data = data
+  else:
+    result.kind = nkWhole
+    result.unused = @["", "abc", "abdc"]
+  flip = 1 - flip
+  
+proc newCaseNode(a, b: PCaseNode): PCaseNode =
+  new(result)
+  result.kind = nkList
+  result.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 finalizeBNode(n: TBNode) = writeln(stdout, n.data)
+proc finalizeNode(n: PNode) =
+  assert(n != nil)
+  write(stdout, "finalizing: ")
+  if isNil(n.data): writeln(stdout, "nil!")
+  else: writeln(stdout, n.data)
+
+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 =
+  writeln(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:
+  writeln(stdout, "creating id (cyclic): " & $id)
+  var cycle: PNode
+  new(cycle, finalizeNode)
+  cycle.data = $id
+  cycle.le = cycle
+  cycle.ri = cycle
+  inc(id)
+  #writeln(stdout, "refcount: " & $refcount(cycle))
+  #writeln(stdout, "refcount le: " & $refcount(cycle.le))
+  #writeln(stdout, "refcount ri: " & $refcount(cycle.ri))
+
+proc printTree(t: PNode) =
+  if t == nil: return
+  writeln(stdout, "printing")
+  writeln(stdout, t.data)
+  printTree(t.le)
+  printTree(t.ri)
+
+proc unsureNew(result: var PNode) =
+  writeln(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
+  writeln(stdout, s[89])
+  write(stdout, "done!\n")
+
+var
+    father: TBNode
+    s: string
+s = ""
+s = ""
+writeln(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()
+write(stdout, "finished\n")
+GC_fullCollect()
+GC_fullCollect()
+writeln(stdout, GC_getStatistics())