1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
# Features covered: tdom cmd
#
# This file contains a collection of tests for the tdom cmd.
#
# Copyright (c) 2003 Rolf Ade.
#
# RCS: @(#) $Id$
source [file join [file dir [info script]] loadtdom.tcl]
# To test, that DOM trees generated with a tdom enabled parser behaves
# the same way, as the one generated with the [dom parse] cmd, we
# rename the dom cmd and use instead a dom proc, which partly rebuilds
# the [dom parse] interface with a tdom enabled parser. Then we just
# [source] some of the test files, which heavily use [dom parse].
rename dom _dom
set _main_parser [expat]
tdom $_main_parser enable
set parse_in_chunks 0
proc dom {args} {
switch [lindex $args 0] {
"parse" {
set parseMethod "parse"
set haveData 0
set uplevelVar ""
tdom $::_main_parser keepEmpties 0
for {set x 1} {$x < [llength $args]} {incr x} {
switch -- [lindex $args $x] {
"-channel" {
set parseMethod "parsechannel"
incr x
set data [lindex $args $x]
set haveData 1
}
"-keepEmpties" {
tdom $::_main_parser keepEmpties 1
}
"-keepCDATA" {
tdom $::_main_parser keepCDATA 1
}
"-baseurl" {
incr x
$::_main_parser configure -baseurl [lindex $args $x]
}
"-externalentitycommand" {
incr x
$::_main_parser configure -externalentitycommand \
[lindex $args $x]
tdom $::_main_parser setExternalEntityResolver \
[lindex $args $x]
}
default {
if {$haveData} {
set uplevelVar [lindex $args $x]
} else {
set data [lindex $args $x]
set haveData 1
}
}
}
}
if {$::parse_in_chunks && ($parseMethod == "parse")} {
$::_main_parser configure -final 0
for {set x 0} {$x < [string length $data]} {incr x} {
$::_main_parser parse [string index $data $x]
}
$::_main_parser configure -final 1
$::_main_parser parse ""
} else {
$::_main_parser $parseMethod $data
}
if {$uplevelVar != ""} {
uplevel 1 set $uplevelVar [tdom $::_main_parser getdoc]
} else {
return [tdom $::_main_parser getdoc]
}
}
"setStoreLineColumn" {
tdom $::_main_parser setStoreLineColumn [lindex $args 1]
}
default {
# Because the original command may be executed within a
# namespace eval, we do an uplevel, to get the same context
return [uplevel 1 [linsert $args 0 _dom]]
}
}
}
source [file join [file dir [info script]] i18n.test]
source [file join [file dir [info script]] domNode.test]
source [file join [file dir [info script]] xslt.test]
# Un-comment this, to test tdom cmd together with expat parsing in chunks
# set parse_in_chunks 1
# source [file join [file dir [info script]] i18n.test]
# source [file join [file dir [info script]] domNode.test]
# source [file join [file dir [info script]] xslt.test]
rename dom {}
rename _dom dom
$_main_parser free
test tdomcmd-1.1 {no doc available} {
set parser [expat]
tdom $parser enable
set result [catch {tdom $parser getdoc} errMsg]
$parser free
lappend result $errMsg
} {1 {No DOM tree available.}}
test tdomcmd-1.2 {request dom tree in the middle of parsing} {
set parser [expat -final 0]
tdom $parser enable
$parser parse {<root>}
set result [catch {tdom $parser getdoc} errMsg]
lappend result $errMsg
$parser parse {foo</root>}
lappend result [catch {tdom $parser getdoc} errMsg]
lappend result $errMsg
$parser configure -final 1
$parser parse {}
lappend result [catch {set doc [tdom $parser getdoc]} errMsg]
$doc delete
$parser free
set result
} {1 {No DOM tree available.} 1 {No DOM tree available.} 0}
proc es-tdomcmd-1.3 {parser name attlist} {
tdom $parser enable
}
test tdomcmd-1.3 {Try to tdom enable a parser from its parsing callback} {
set p [expat]
$p configure -elementstartcommand [list es-tdomcmd-1.3 $p]
set result [catch {$p parse {<x><y/></x>}}]
$p free
set result
} {1}
test tdomcmd-1.4 {keepCDATA} {
set parser [expat]
set result [catch {tdom $parser keepCDATA 1}]
$parser free
set result
} 1
# cleanup
::tcltest::cleanupTests
return
|
