home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / xuibuilder / TclXML-1.1.1 / tests / element.test < prev    next >
Text File  |  2000-11-02  |  3KB  |  94 lines
  1. # Features covered:  Elements
  2. #
  3. # This file contains a collection of tests for the TclXML parser.
  4. # This file tests the parser's performance on elements.
  5. # Sourcing this file into Tcl runs the tests and generates output
  6. # for errors.  No output means no errors were found.
  7. #
  8. # Copyright (c) 1999 Zveno Pty Ltd.
  9. #
  10. # $Id: element.test,v 1.1.1.1 1996/02/22 06:06:15 daniel Exp $
  11.  
  12. if {[string compare test [info procs test]] == 1} then {source defs}
  13.  
  14. if {[catch {package require xml 1.7}]} {
  15.     catch {puts stderr "Cannot load xml 1.7 package"}
  16.     return
  17. }
  18.  
  19. proc parray arrayName {
  20.     upvar #0 $arrayName arr
  21.     foreach key [lsort [array names $arrayName]] {
  22.     lappend result $key $arr($key)
  23.     }
  24.     return $result
  25. }
  26.  
  27. catch {unset started}
  28. proc Start {name atList args} {
  29.     array set opts $args
  30.     if {![info exists ::started($name)]} {
  31.     set ::started($name) 1
  32.     } else {
  33.     incr ::started($name)
  34.     }
  35. }
  36. catch {unset ended}
  37. proc End {name args} {
  38.     array set opts $args
  39.     if {![info exists ::ended($name)]} {
  40.     set ::ended($name) 1
  41.     } else {
  42.     incr ::ended($name)
  43.     }
  44. }
  45.  
  46. catch {unset elList}
  47. proc ElStart {name atList args} {
  48.     array set opts {-empty 0}
  49.     array set opts $args
  50.     lappend ::elList start $name $opts(-empty)
  51. }
  52. proc ElEnd {name args} {
  53.     array set opts {-empty 0}
  54.     array set opts $args
  55.     lappend ::elList end $name $opts(-empty)
  56. }
  57.  
  58. test element-1.1 {document element} {
  59.     catch {unset ::started}
  60.     catch {unset ::ended}
  61.  
  62.     catch {rename xml::element-1.1 {}}
  63.     set parser [xml::parser element-1.1 \
  64.     -elementstartcommand Start \
  65.     -elementendcommand End]
  66.     $parser parse {<Test></Test>}
  67.     list [array get ::started] [array get ::ended]
  68. } {{Test 1} {Test 1}}
  69.  
  70. test element-1.2 {distinct elements} {
  71.     catch {unset ::started}
  72.     catch {unset ::ended}
  73.  
  74.     catch {rename xml::element-1.2 {}}
  75.     set parser [xml::parser element-1.2 \
  76.     -elementstartcommand Start \
  77.     -elementendcommand End]
  78.     $parser parse {<Test><Child1></Child1><Child2></Child2></Test>}
  79.     list [parray ::started] [parray ::ended]
  80. } {{Child1 1 Child2 1 Test 1} {Child1 1 Child2 1 Test 1}}
  81.  
  82. test element-2.1 {empty element} {
  83.     catch {unset ::elList}
  84.  
  85.     catch {rename xml::element-2.1 {}}
  86.     set parser [xml::parser element-2.1 \
  87.     -reportempty 1 \
  88.     -elementstartcommand ElStart \
  89.     -elementendcommand ElEnd]
  90.     $parser parse {<Test><Child1/></Test>}
  91.     set ::elList
  92. } {start Test 0 start Child1 1 end Child1 1 end Test 0}
  93.  
  94.