home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / tests / filescan.test < prev    next >
Encoding:
Text File  |  1994-01-23  |  8.0 KB  |  316 lines
  1. #
  2. # filescan.test
  3. #
  4. # Tests for the scancontext and scanfile commands.
  5. #---------------------------------------------------------------------------
  6. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: filescan.test,v 3.0 1993/11/19 06:57:33 markd Rel $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. if {[info procs test] != "test"} then {source testlib.tcl}
  20.  
  21. # Increment a name.  This takes a name and "adds one" to it, that is advancing
  22. # each digit lexically through "0"..."9" -> "A"-"Z" -> "a"..."z".  When one
  23. # digit wraps, the next one is advanced.  Optional arg forces upper case only
  24. # if true and start with all upper case or digits.
  25.  
  26. proc IncrName {Name args} {
  27.     set Upper [expr {([llength $args] == 1) && [lindex $args 0]}]
  28.     set Last  [expr [clength $Name]-1]
  29.     set Begin [csubstr $Name 0 $Last]
  30.     set Digit [cindex $Name $Last]
  31.     set Recurse 0
  32.     case $Digit in {
  33.         {9}     {set Digit A}
  34.         {Z}     {if {$Upper} {set Recurse 1} else {set Digit a}}
  35.         {z}     {set Recurse 1}
  36.         default {set Digit [ctype char [expr [ctype ord $Digit]+1]]}
  37.     }
  38.     if {$Recurse} {
  39.         if {$Last == 0} then {
  40.             return 0 ;# Wrap around
  41.         } else {
  42.             return "[IncrName $Begin]0"
  43.         }
  44.     }
  45.     return "$Begin$Digit"
  46. }
  47.  
  48. # Proc to generate record that can be validated.  The record has 
  49. # grows quite large to test the dynamic buffering in the file I/O.
  50.  
  51. proc GenScanRec {Key LineNum} {
  52.   set extra [replicate :@@@@@@@@: $LineNum]
  53.   return  "$Key This is a test record ($extra) index is $Key"
  54. }
  55.  
  56. # Proc to validate a matched record.
  57.  
  58. proc ValMatch {scanInfo id} {
  59.     global testFH matchInfo
  60.  
  61.     Test filescan-${id}.1 {filescan tests} {
  62.          set matchInfo(line)
  63.     } 0 [GenScanRec [lindex $scanInfo 0] [lindex $scanInfo 2]]
  64.  
  65.     Test filescan-${id}.2 {filescan tests} {
  66.          set matchInfo(offset)
  67.     } 0 [lindex $scanInfo 1]
  68.  
  69.     Test filescan-${id}.3 {filescan tests} {
  70.          set matchInfo(linenum)
  71.     } 0 [lindex $scanInfo 2]
  72.  
  73.     Test filescan-${id}.4 {filescan tests} {
  74.          set matchInfo(handle)
  75.     } 0 $testFH
  76.  
  77.     set matchType [lindex $scanInfo 3] 
  78.     global matchCnt
  79.     incr matchCnt($matchType)
  80. }
  81.  
  82. global matchInfo matchCnt chkMatchCnt testFH
  83.  
  84. foreach i {0 1 2 3 df} {
  85.     set chkMatchCnt($i)  0
  86. }
  87. set scanList       {}
  88. set maxRec        200
  89.  
  90. # Build a test file and a list of records to scan for.  Each element in the 
  91. # list will have the following info:
  92. #   {key fileOffset fileLineNumber matchType}
  93. # Also build a file to diff against for the -copyfile option.
  94.  
  95. unlink -nocomplain {TEST.TMP TEST2.TMP TESTCHK.TMP}
  96. set testFH [open TEST.TMP w]
  97. set testChkFH [open TESTCHK.TMP w]
  98.  
  99. set key FatHeadAAAA
  100. for {set cnt 0} {$cnt < $maxRec} {incr cnt} {
  101.     set rec [GenScanRec $key [expr $cnt+1]]
  102.     if {($cnt % 10) == 0} {
  103.         set matchType [random 4]
  104.         incr chkMatchCnt($matchType)
  105.         set scanInfo [list "$key [tell $testFH] [expr $cnt+1] $matchType"]
  106.         if {[random 2]} {
  107.             set scanList [concat $scanList $scanInfo]
  108.         } else {
  109.             set scanList [concat $scanInfo $scanList]
  110.         }
  111.     } else {
  112.         incr chkMatchCnt(df)
  113.         puts $testChkFH $rec
  114.     }
  115.     if {$cnt == [expr $maxRec/2]} {
  116.         set midKey $key
  117.     }
  118.     puts $testFH $rec
  119.     set key [IncrName $key 1]  ;# Upper case only
  120. }
  121.  
  122. close $testFH
  123. close $testChkFH
  124.  
  125. # Build up the scan context.
  126.  
  127. set testCH [scancontext create]
  128.  
  129. foreach scanInfo $scanList {
  130.     set key [lindex $scanInfo 0]
  131.     set matchType [lindex $scanInfo 3]
  132.     set cmd "global matchInfo; ValMatch \{$scanInfo\} 1.1" 
  133.     case $matchType in {
  134.       {0} {scanmatch -nocase $testCH [string toupper $key] $cmd}
  135.       {1} {scanmatch $testCH ^$key  $cmd}
  136.       {2} {scanmatch $testCH $key\$ $cmd}
  137.       {3} {scanmatch $testCH $key   $cmd}
  138.     }
  139. }
  140.  
  141. scanmatch $testCH {
  142.     global matchCnt testFH matchInfo
  143.  
  144.     incr matchCnt(df)
  145.  
  146.     Test filescan-1.2 {filescan tests} {
  147.         set matchInfo(handle)
  148.     } 0 $testFH
  149. }
  150.  
  151. proc ValScan id {
  152.     global matchInfo matchCnt chkMatchCnt testFH
  153.  
  154.     Test filescan-${id}.1 {filescan tests} {
  155.         set matchCnt(0)
  156.     } 0 [set chkMatchCnt(0)]
  157.  
  158.     Test filescan-${id}.2 {filescan tests} {
  159.         set matchCnt(1)
  160.     } 0 [set chkMatchCnt(1)]
  161.  
  162.     Test filescan-${id}.3 {filescan tests} {
  163.         set matchCnt(2)
  164.     } 0 [set chkMatchCnt(2)]
  165.  
  166.     Test filescan-${id}.4 {filescan tests} {
  167.         set matchCnt(3)
  168.     } 0 [set chkMatchCnt(3)]
  169.  
  170.     Test filescan-${id}.5 {filescan tests} {
  171.         set matchCnt(df)
  172.     } 0 [set chkMatchCnt(df)]
  173. }
  174.  
  175. foreach i {0 1 2 3 df} {
  176.     set matchCnt($i)  0
  177. }
  178. set testFH [open TEST.TMP r]
  179. scanfile $testCH $testFH
  180. close $testFH
  181. ValScan 1.3
  182.  
  183. foreach i {0 1 2 3 df} {
  184.     set matchCnt($i)  0
  185. }
  186. set testFH [open TEST.TMP r]
  187. set test2FH [open TEST2.TMP w]
  188. scanfile -copyfile $test2FH $testCH $testFH
  189. close $testFH
  190. close $test2FH
  191. ValScan 1.4
  192.  
  193. Test filescan-1.5 {filescan tests} {
  194.     system "diff TESTCHK.TMP TEST2.TMP"
  195. } 0 0
  196.  
  197. scancontext delete $testCH
  198.  
  199. # Test return and continue from within match commands
  200.  
  201. set testFH [open TEST.TMP r]
  202.  
  203. set testCH [scancontext create]
  204. seek $testFH 0
  205. global matchCnt
  206. set matchCnt(0) 0
  207.  
  208. scanmatch $testCH $midKey {
  209.     global matchCnt
  210.     incr matchCnt(0)
  211.     continue;
  212. }
  213.  
  214. scanmatch $testCH ^$midKey {
  215.     error "This should not ever get executed  2.1"
  216. }
  217.  
  218. scanmatch $testCH [IncrName $midKey] {
  219.     return "FudPucker"
  220. }
  221.  
  222. Test filescan-2.2 {filescan tests} {
  223.     scanfile $testCH $testFH
  224. } 0 "FudPucker"
  225.  
  226. scancontext delete $testCH
  227.  
  228. # Test argument checking and error handling.
  229.  
  230. Test filescan-3.1 {filescan tests} {
  231.     scancontext foomuch
  232. } 1 {invalid argument, expected one of: create or delete}
  233.  
  234. Test filescan-3.2 {filescan tests} {
  235.     scanmatch $testCH
  236. } 1 {wrong # args: scanmatch ?-nocase? contexthandle ?regexp? command}
  237.  
  238. Test filescan-3.3 {filescan tests} {
  239.     scanmatch
  240. } 1 {wrong # args: scanmatch ?-nocase? contexthandle ?regexp? command}
  241.  
  242. Test filescan-3.4 {filescan tests} {
  243.     scanfile
  244. } 1 {wrong # args: scanfile ?-copyfile filehandle? contexthandle filehandle}
  245.  
  246. Test filescan-3.5 {filescan tests} {
  247.     set testCH [scancontext create]
  248.     scanfile $testCH $testFH
  249. } 1 {no patterns in current scan context}
  250. catch {scancontext delete $testCH}
  251.  
  252. close $testFH
  253.  
  254. # 
  255. # Test subMatch handling.
  256. #
  257.  
  258. set testFH [open TEST.TMP w]
  259. loop idx 0 10 {
  260.     puts $testFH "AAx[replicate xx $idx]xBBc[replicate cc $idx]cDD"
  261. }
  262. close $testFH
  263.  
  264. # Procedure to verify submatches.  Works for upper or lower case.
  265.  
  266. proc ChkSubMatch {id matchInfoVar} {
  267.     upvar $matchInfoVar matchInfo
  268.  
  269.     set idx [expr $matchInfo(linenum) - 1]
  270.  
  271.     set end0 [expr 3+($idx * 2)]
  272.     Test filescan-$id.0.$idx {filescan tests} {
  273.         set matchInfo(submatch0)
  274.     } 0 "x[replicate xx $idx]x"
  275.     Test filescan-$id.1.$idx {filescan tests} {
  276.         set matchInfo(subindex0)
  277.     } 0 "2 $end0"
  278.  
  279.     set start1 [expr $end0+3]
  280.     set end1 [expr $start1+($idx*2)+1]
  281.     Test filescan-$id.2.$idx {filescan tests} {
  282.         set matchInfo(submatch1)
  283.     } 0 "c[replicate cc $idx]c"
  284.     Test filescan-$id.3.$idx {filescan tests} {
  285.         set matchInfo(subindex1)
  286.     } 0 "$start1 $end1"
  287.  
  288.     Test filescan-$id.4.$idx {filescan tests} {
  289.         list [info exists matchInfo(submatch2)] \
  290.              [info exists matchInfo(subindex2)]
  291.     } 0 {0 0}
  292. }
  293.  
  294. set testFH [open TEST.TMP r]
  295.  
  296. set testCH [scancontext create]
  297. scanmatch $testCH {\A*(x*)B*(c*)DD} {
  298.     ChkSubMatch 4 matchInfo
  299. }
  300.  
  301. scanmatch -nocase $testCH {\Aa(x*)B(C*)Dd} {
  302.     ChkSubMatch 5 matchInfo
  303. }
  304.  
  305. scanfile $testCH $testFH
  306.  
  307. close $testFH
  308. unlink {TEST.TMP TEST2.TMP TESTCHK.TMP}
  309.  
  310. rename GenScanRec {}
  311. rename ValMatch {}
  312. rename ValScan {}
  313. rename ChkSubMatch {}
  314.  
  315. unset matchCnt chkMatchCnt matchInfo testFH test2FH testChkFH
  316.