util/src/TclTk/tcl8.6.12/pkgs/thread2.8.7/tests/store-load.tcl

   1 #!/usr/bin/env tclsh
   2
   3 lappend auto_path .
   4 package require Thread
   5
   6 if {[llength $argv] != 3} {
   7     puts "Usage: $argv0 handle path times"
   8     puts {
   9     handle
  10         A persistent storage handle (see [tsv::array bind] manpage).
  11     path
  12         The path to file containing lines in the form of "key<tab>val", where
  13         key is a single-word and val is everyting else.
  14     times
  15         The number of times to reload the data from persistent storage.
  16
  17     This script reads lines of data from <path> and stores them into the
  18     persistent storage described by <handle>. Values for duplicate keys are
  19     handled as a lists. The persistent storage engine is then stress-tested by
  20     reloading the whole store <times> times.
  21     }
  22     exit 1
  23 }
  24
  25 lassign $argv handle path times
  26
  27 ### Cleanup
  28 set filename [string range $handle [string first : $handle]+1 end]
  29 file delete -force $filename
  30
  31 ### Load and store tab-separated values
  32 tsv::array bind a $handle
  33 set fd [open $path r]
  34 set start [clock milliseconds]
  35 set pairs 0
  36 while {[gets $fd line] >  0} {
  37     if {[string index $line 0] eq {#}} {
  38         continue
  39     }
  40     set tab [string first {     } $line]
  41     if {$tab == -1} {
  42         continue
  43     }
  44
  45     set k [string range $line 0 $tab-1]
  46     set v [string range $line $tab+1 end]
  47
  48     if {![tsv::exists a $k]} {
  49         incr pairs
  50     }
  51
  52     tsv::lappend a $k $v
  53 }
  54 puts "Stored $pairs pairs in [expr {[clock milliseconds]-$start}] milliseconds"
  55
  56 tsv::array unbind a
  57 tsv::unset a
  58
  59 ### Reload
  60 set pairs 0
  61 set iter [time {
  62     tsv::array bind a $handle
  63     set pairs [tsv::array size a]
  64     tsv::array unbind a
  65     tsv::unset a
  66 } $times]
  67 puts "Loaded $pairs pairs $times times at $iter"
  68
  69 ## Dump file stats
  70 puts "File $filename is [file size $filename] bytes long"