1# Features covered: Elements 2# 3# This file tests the parser's performance on elements. 4# Sourcing this file into Tcl runs the tests and generates output 5# for errors. No output means no errors were found. 6# 7# Copyright (c) 1999-2000 Zveno Pty Ltd. 8# Copyright (c) 2002-2005 Rolf Ade 9# 10# $Id$ 11 12source [file join [file dir [info script]] loadtdom.tcl] 13 14proc parray arrayName { 15 upvar #0 $arrayName arr 16 foreach key [lsort [array names $arrayName]] { 17 lappend result $key $arr($key) 18 } 19 return $result 20} 21 22catch {unset started} 23proc Start {name atList args} { 24 array set opts $args 25 if {![info exists ::started($name)]} { 26 set ::started($name) 1 27 } else { 28 incr ::started($name) 29 } 30} 31catch {unset ended} 32proc End {name args} { 33 array set opts $args 34 if {![info exists ::ended($name)]} { 35 set ::ended($name) 1 36 } else { 37 incr ::ended($name) 38 } 39} 40 41catch {unset elList} 42proc ElStart {name atList args} { 43 array set opts {-empty 0} 44 array set opts $args 45 lappend ::elList start $name $opts(-empty) 46} 47proc ElEnd {name args} { 48 array set opts {-empty 0} 49 array set opts $args 50 lappend ::elList end $name $opts(-empty) 51} 52 53test element-1.1 {document element} { 54 catch {unset ::started} 55 catch {unset ::ended} 56 57 catch {rename xml::element-1.1 {}} 58 set parser [xml::parser element-1.1 \ 59 -elementstartcommand Start \ 60 -elementendcommand End] 61 $parser parse {<Test></Test>} 62 list [array get ::started] [array get ::ended] 63} {{Test 1} {Test 1}} 64 65test element-1.2 {distinct elements} { 66 catch {unset ::started} 67 catch {unset ::ended} 68 69 catch {rename xml::element-1.2 {}} 70 set parser [xml::parser element-1.2 \ 71 -elementstartcommand Start \ 72 -elementendcommand End] 73 $parser parse {<Test><Child1></Child1><Child2></Child2></Test>} 74 list [parray ::started] [parray ::ended] 75} {{Child1 1 Child2 1 Test 1} {Child1 1 Child2 1 Test 1}} 76 77proc esh-2.1 {parsername name attlist} { 78 if {$parsername == "element-2.1"} { 79 set ::result 1 80 } else { 81 set ::result 0 82 } 83} 84 85test element-2.1 {handler script} { 86 set ::result 0 87 set p [expat element-2.1 -elementstartcommand [list esh-2.1 element-2.1]] 88 $p parse <root/> 89 $p free 90 set ::result 91} {1} 92 93proc eeh-2.2 {parsername name} { 94 if {$parsername == "element-2.2"} { 95 set ::result 1 96 } else { 97 set ::result 0 98 } 99} 100 101test element-2.2 {handler script} { 102 set ::result 0 103 set p [expat element-2.2] 104 $p configure -elementendcommand [list eeh-2.2 element-2.2] 105 $p parse <root/> 106 $p free 107 set ::result 108} {1} 109 110test element-2.3 {declare handler proc later} { 111 set ::eshcounter 0 112 set ::eehcounter 0 113 catch {rename esh-2.3 {}} 114 catch {rename eeh-2.3 {}} 115 set p [expat -elementstartcommand esh-2.3 -elementendcommand eeh-2.3] 116 proc esh-2.3 {args} { 117 incr ::eshcounter 118 } 119 proc eeh-2.3 {args} { 120 incr ::eehcounter 121 } 122 $p parse {<root><a/><b/></root>} 123 $p free 124 list $::eshcounter $::eehcounter 125} {3 3} 126 127proc esh-3.1-1 {args} { 128 $::p configure -elementstartcommand esh-3.1-2 129 incr ::esh-3.1-1 130 incr ::eshcounter 131} 132 133proc esh-3.1-2 {args} { 134 $::p configure -elementstartcommand esh-3.1-1 135 incr ::esh-3.1-2 136 incr ::eshcounter 137} 138 139test element-3.1 {change handler from handler callback} { 140 set ::esh-3.1-1 0 141 set ::esh-3.1-2 0 142 set ::eshcounter 0 143 set p [expat -elementstartcommand esh-3.1-1] 144 $p parse {<root><a/><b><c/><c/></b><d/>foo bar</root>} 145 $p free 146 list ${::esh-3.1-1} ${::esh-3.1-2} $::eshcounter 147} {3 3 6} 148 149proc esh-3.2-1 {p args} { 150 $p configure -elementstartcommand [list esh-3.2-2 $p] 151 incr ::esh-3.2-1 152 incr ::eshcounter 153} 154 155proc esh-3.2-2 {p args} { 156 $p configure -elementstartcommand [list esh-3.2-1 $p] 157 incr ::esh-3.2-2 158 incr ::eshcounter 159} 160 161test element-3.2 {change handler from handler callback} { 162 set ::esh-3.2-1 0 163 set ::esh-3.2-2 0 164 set ::eshcounter 0 165 set p [expat] 166 $p configure -elementstartcommand [list esh-3.2-1 $p] 167 $p parse {<root><a/><b><c/><c/><c/></b><d/>foo bar</root>} 168 $p free 169 list ${::esh-3.2-1} ${::esh-3.2-2} $::eshcounter 170} {4 3 7} 171 172foreach parser [info commands element-*] { 173 $parser free 174} 175 176# cleanup 177::tcltest::cleanupTests 178return 179