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
156
157
158
159
160
161
162
163
164
165
166
167
|
# Features covered: Entities
#
# This file contains a collection of tests for the different kinds of
# entities.
#
# entity-1.*: parameter entities, character entities
# entity-2.*: predefined entities
# entity-3.*: -useForeignDTD
# entity-4.*: external parsed entities
#
# Copyright (c) 1999-2000 Zveno Pty Ltd.
# Copyright (c) 2000-2004 Rolf Ade
#
# $Id$
source [file join [file dir [info script]] loadtdom.tcl]
proc Start {name attrList args} {
incr ::elements
}
proc pcdata text {
append ::result $text
}
proc EntityRef name {
lappend ::references $name
append ::result ##entityreference##
return {}
}
test entity-1.1 {parameter entity in document entity} {
set ::result {}
catch {rename xml::entity-1.1 {}}
set parser [xml::parser entity-1.1 \
-characterdatacommand pcdata]
$parser parse {<!DOCTYPE Test [
<!ENTITY % Wrong "This is wrong">
]>
<Test>%wrong;</Test>}
set ::result
} {%wrong;}
test entity-1.2 {character entities in hex} {
set ::result {}
catch {rename xml::entity-1.2 {}}
set parser [xml::parser entity-1.2 \
-characterdatacommand pcdata]
$parser parse {<Test>A<>$[]</Test>}
set ::result
} {A<>$[]}
test entity-1.3 {character entities in decimal} {
set ::result {}
catch {rename xml::entity-1.3 {}}
set parser [xml::parser entity-1.3 \
-characterdatacommand pcdata]
$parser parse {<Test>A<>$[]</Test>}
set ::result
} {A<>$[]}
test entity-1.4 {illegal character entity} {
set ::result {}
catch {rename xml::entity-1.4 {}}
set parser [xml::parser entity-1.4 \
-characterdatacommand pcdata]
set err [catch {$parser parse {<Test>&#blah;</Test>}}]
list $err $::result
} {1 {}}
test entity-2.1 {predefined general entities} {
set ::result {}
catch {rename xml::entity-2.1 {}}
set parser [xml::parser entity-2.1 \
-characterdatacommand pcdata]
$parser parse {<Test><>&"'</Test>}
set ::result
} {<>&"'}
# emacs: "
proc extrefhandler-3 {base args} {
global extrefhandlerCalled
set extrefhandlerCalled 1
return [list string $base ""]
}
test entity-3.1 {-useForeignDTD} {
set ::extrefhandlerCalled 0
set parser [expat -useForeignDTD 0 \
-externalentitycommand extrefhandler-3 \
-paramentityparsing notstandalone]
$parser parse <root/>
$parser free
set ::extrefhandlerCalled
} {0}
test entity-3.2 {-useForeignDTD} {
set ::extrefhandlerCalled 0
set parser [expat -useForeignDTD 1 \
-externalentitycommand extrefhandler-3 \
-paramentityparsing notstandalone]
$parser parse <root/>
$parser free
set ::extrefhandlerCalled
} {1}
test entity-3.3 {-useForeignDTD} {
set ::extrefhandlerCalled 0
set parser [expat -useForeignDTD 1 \
-externalentitycommand extrefhandler-3 \
-paramentityparsing notstandalone]
$parser parse {
<!DOCTYPE root [
<!ATTLIST root fixed CDATA #FIXED "toThis">
]>
<root/>}
$parser free
set ::extrefhandlerCalled
} {1}
test entity-3.4 {cget -useForeignDTD} {
set parser [expat entity-4.4 -useForeignDTD 1]
$parser cget -useForeignDTD
} 1
proc extrefhandler-4 {args} {
global notexistendpath
# Search for a not existing file path
set base /ae124
set filename 0
set path [file join $base $filename]
while {[file exists $path]} {
incr filename
set path [file join $base $filename]
}
set notexistendpath $path
return [list filename $path $path]
}
test entity-4.1 {external entity: returned filename dose not exist} -body {
set parser [expat -useForeignDTD 1 \
-externalentitycommand extrefhandler-4 \
-paramentityparsing always]
set result [catch {$parser parse <root/>} errMsg]
append result " $errMsg"
$parser free
set result
} -match glob -result {1 error opening file "/ae124/*"}
foreach parser [info commands entity-*] {
$parser free
}
# cleanup
::tcltest::cleanupTests
return
|
