Import Tcl 8.6.12

pkgs/thread2.8.7/tests/all.tcl

@@ -0,0 +1,59 @@
+# all.tcl --
+#
+# This file contains a top-level script to run all of the Tcl
+# tests.  Execute it by invoking "source all.test" when running tcltest
+# in this directory.
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+
+package require tcltest
+::tcltest::loadTestedCommands
+package require Thread
+
+set ::tcltest::testSingleFile false
+set ::tcltest::testsDirectory [file dir [info script]]
+
+# We need to ensure that the testsDirectory is absolute
+::tcltest::normalizePath ::tcltest::testsDirectory
+
+puts stdout "Tcl $tcl_patchLevel tests running in interp:  [info nameofexecutable]"
+puts stdout "Tests running in working dir:  $::tcltest::testsDirectory"
+if {[llength $::tcltest::skip] > 0} {
+    puts stdout "Skipping tests that match:  $::tcltest::skip"
+}
+if {[llength $::tcltest::match] > 0} {
+    puts stdout "Only running tests that match:  $::tcltest::match"
+}
+
+if {[llength $::tcltest::skipFiles] > 0} {
+    puts stdout "Skipping test files that match:  $::tcltest::skipFiles"
+}
+if {[llength $::tcltest::matchFiles] > 0} {
+    puts stdout "Only sourcing test files that match:  $::tcltest::matchFiles"
+}
+
+set timeCmd {clock format [clock seconds]}
+puts stdout "Tests began at [eval $timeCmd]"
+
+# These tests need to know which is the main thread
+set ::tcltest::mainThread [thread::id]
+
+puts stdout "Thread [package provide Thread]"
+puts stdout "Mainthread id is $::tcltest::mainThread"
+
+# Source each of the specified tests
+foreach file [lsort [::tcltest::getMatchingFiles]] {
+    set tail [file tail $file]
+    puts stdout $tail
+    if {[catch {source $file} msg]} {
+        puts stdout $msg
+    }
+}
+
+# Cleanup
+puts stdout "\nTests ended at [eval $timeCmd]"
+::tcltest::cleanupTests 1
+
+return
+

pkgs/thread2.8.7/tests/store-load.tcl

@@ -0,0 +1,70 @@
+#!/usr/bin/env tclsh
+
+lappend auto_path .
+package require Thread
+
+if {[llength $argv] != 3} {
+    puts "Usage: $argv0 handle path times"
+    puts {
+    handle
+        A persistent storage handle (see [tsv::array bind] manpage).
+    path
+        The path to file containing lines in the form of "key<tab>val", where
+        key is a single-word and val is everyting else.
+    times
+        The number of times to reload the data from persistent storage.
+
+    This script reads lines of data from <path> and stores them into the
+    persistent storage described by <handle>. Values for duplicate keys are
+    handled as a lists. The persistent storage engine is then stress-tested by
+    reloading the whole store <times> times.
+    }
+    exit 1
+}
+
+lassign $argv handle path times
+
+### Cleanup
+set filename [string range $handle [string first : $handle]+1 end]
+file delete -force $filename
+
+### Load and store tab-separated values
+tsv::array bind a $handle
+set fd [open $path r]
+set start [clock milliseconds]
+set pairs 0
+while {[gets $fd line] >  0} {
+    if {[string index $line 0] eq {#}} {
+        continue
+    }
+    set tab [string first {	} $line]
+    if {$tab == -1} {
+        continue
+    }
+
+    set k [string range $line 0 $tab-1]
+    set v [string range $line $tab+1 end]
+
+    if {![tsv::exists a $k]} {
+        incr pairs
+    }
+
+    tsv::lappend a $k $v
+}
+puts "Stored $pairs pairs in [expr {[clock milliseconds]-$start}] milliseconds"
+
+tsv::array unbind a
+tsv::unset a
+
+### Reload
+set pairs 0
+set iter [time {
+    tsv::array bind a $handle
+    set pairs [tsv::array size a]
+    tsv::array unbind a
+    tsv::unset a
+} $times]
+puts "Loaded $pairs pairs $times times at $iter"
+
+## Dump file stats
+puts "File $filename is [file size $filename] bytes long"

pkgs/thread2.8.7/tests/tkt-84be1b5a73.test

@@ -0,0 +1,25 @@
+package require tcltest
+namespace import ::tcltest::*
+tcltest::loadTestedCommands
+package require Thread
+
+# This test used to segfault before commit f4c95731c0.
+test tkt-84be1b5a73 {Ticket 84be1b5a73} -body {
+    set t [thread::create]
+    set resultvar() {}
+
+    trace add variable resultvar() write {
+        unset -nocomplain resultvar()
+        list}
+
+    proc errorproc {tid einfo} {}
+    thread::errorproc errorproc
+    thread::send -async $t {
+        error ""
+    } resultvar()
+
+    after 1000 {
+        set forever 1
+    }
+    vwait forever
+} -returnCodes 0

pkgs/thread2.8.7/tests/tpool.test

@@ -0,0 +1 @@
+return

pkgs/thread2.8.7/tests/tsv.test

@@ -0,0 +1,107 @@
+package require tcltest
+namespace import ::tcltest::*
+tcltest::loadTestedCommands
+package require Thread
+
+set backends {gdbm lmdb}
+
+foreach b $backends {
+    testConstraint have_$b [expr {$b in [tsv::handlers]}]
+}
+
+foreach backend $backends {
+    set db "data"
+    file delete -force $db
+    set ::handle $backend:$db
+
+    proc setup {} {
+        tsv::array bind a $::handle
+    }
+    proc cleanup {} {
+        tsv::array unbind a
+    }
+
+    test tsv-$backend-1.0 {tsv::array isboud} \
+    -constraints have_$backend \
+    -setup {
+        setup
+    } -body {
+        tsv::array isbound a
+    } -cleanup {
+        cleanup
+    } -result {1}
+
+    test tsv-$backend-1.1 {tsv::array bind - empty} \
+    -constraints have_$backend \
+    -setup {
+        setup
+    } -body {
+        tsv::array names b
+    } -cleanup {
+       cleanup
+    } -result {}
+
+    test tsv-$backend-1.2 {tsv::set} \
+    -constraints have_$backend \
+    -setup {
+        setup
+    } -body {
+        tsv::set a Key Val
+    } -cleanup {
+        cleanup
+    } -result {Val}
+
+    test tsv-$backend-1.3 {tsv::get - previously set was persisted} \
+    -constraints have_$backend \
+    -setup {
+        setup
+    } -body {
+        tsv::get a Key
+    } -cleanup {
+        cleanup
+    } -result {Val}
+
+    test tsv-$backend-1.4 {tsv::array names - previously set was persisted} \
+    -constraints have_$backend \
+    -setup {
+        setup
+    } -body {
+        tsv::array names a
+    } -cleanup {
+        cleanup
+    } -result {Key}
+
+    test tsv-$backend-1.5 {tsv::exists - previously set exists} \
+    -constraints have_$backend \
+    -setup {
+        setup
+    } -body {
+        tsv::exists a Key
+    } -cleanup {
+        cleanup
+    } -result {1}
+
+    test tsv-$backend-1.6 {tsv::pop - get previously set} \
+    -constraints have_$backend \
+    -setup {
+        setup
+    } -body {
+        tsv::pop a Key
+    } -cleanup {
+        cleanup
+    } -result {Val}
+
+    test tsv-$backend-1.7 {tsv::exists - popped was removed} \
+    -constraints have_$backend \
+    -setup {
+        setup
+    } -body {
+        tsv::exists a Key
+    } -cleanup {
+        cleanup
+    } -result {0}
+
+    file delete -force $db
+}
+
+::tcltest::cleanupTests

pkgs/thread2.8.7/tests/ttrace.test

@@ -0,0 +1 @@
+return