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
|
BEGIN {print "1..30\n";}
END {print "not ok 1\n" unless $loaded;}
use XML::Parser;
$loaded = 1;
print "ok 1\n";
my $bigval =<<'End_of_bigval;';
This is a large string value to test whether the declaration parser still
works when the entity or attribute default value may be broken into multiple
calls to the default handler.
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
01234567890123456789012345678901234567890123456789012345678901234567890123456789
End_of_bigval;
$bigval =~ s/\n/ /g;
my $docstr =<<"End_of_Doc;";
<?xml version="1.0" encoding="ISO-8859-1" ?>
<!DOCTYPE foo SYSTEM 't/foo.dtd'
[
<!ENTITY alpha 'a'>
<!ELEMENT junk ((bar|foo|xyz+), zebra*)>
<!ELEMENT xyz (#PCDATA)>
<!ELEMENT zebra (#PCDATA|em|strong)*>
<!ATTLIST junk
id ID #REQUIRED
version CDATA #FIXED '1.0'
color (red|green|blue) 'green'
foo NOTATION (x|y|z) #IMPLIED>
<!ENTITY skunk "stinky animal">
<!ENTITY big "$bigval">
<!-- a comment -->
<!NOTATION gif SYSTEM 'http://www.somebody.com/specs/GIF31.TXT'>
<!ENTITY logo PUBLIC '//Widgets Corp/Logo' 'logo.gif' NDATA gif>
<?DWIM a useless processing instruction ?>
<!ELEMENT bar ANY>
<!ATTLIST bar big CDATA '$bigval'>
]>
<foo/>
End_of_Doc;
my $entcnt = 0;
my %ents;
my @tests;
sub enth1 {
my ($p, $name, $val, $sys, $pub, $notation) = @_;
$tests[2]++ if ($name eq 'alpha' and $val eq 'a');
$tests[3]++ if ($name eq 'skunk' and $val eq 'stinky animal');
$tests[4]++ if ($name eq 'logo' and !defined($val) and
$sys eq 'logo.gif' and $pub eq '//Widgets Corp/Logo'
and $notation eq 'gif');
}
my $parser = new XML::Parser(ErrorContext => 2,
NoLWP => 1,
ParseParamEnt => 1,
Handlers => {Entity => \&enth1});
$parser->parse($docstr);
sub eleh {
my ($p, $name, $model) = @_;
if ($name eq 'junk') {
$tests[5]++ if $model eq '((bar|foo|xyz+),zebra*)';
$tests[6]++ if $model->isseq;
my @parts = $model->children;
$tests[7]++ if $parts[0]->ischoice;
my @cparts = $parts[0]->children;
$tests[8]++ if $cparts[0] eq 'bar';
$tests[9]++ if $cparts[1] eq 'foo';
$tests[10]++ if $cparts[2] eq 'xyz+';
$tests[11]++ if $cparts[2]->name eq 'xyz';
$tests[12]++ if $parts[1]->name eq 'zebra';
$tests[13]++ if $parts[1]->quant eq '*';
}
if ($name eq 'xyz') {
$tests[14]++ if ($model->ismixed and ! defined($model->children));
}
if ($name eq 'zebra') {
$tests[15]++ if ($model->ismixed and ($model->children)[1] eq 'strong');
}
if ($name eq 'bar') {
$tests[16]++ if $model->isany;
}
}
sub enth2 {
my ($p, $name, $val, $sys, $pub, $notation) = @_;
$tests[17]++ if ($name eq 'alpha' and $val eq 'a');
$tests[18]++ if ($name eq 'skunk' and $val eq 'stinky animal');
$tests[19]++ if ($name eq 'big' and $val eq $bigval);
$tests[20]++ if ($name eq 'logo' and !defined($val) and
$sys eq 'logo.gif' and $pub eq '//Widgets Corp/Logo'
and $notation eq 'gif');
}
sub doc {
my ($p, $name, $sys, $pub, $intdecl) = @_;
$tests[21]++ if $name eq 'foo';
$tests[22]++ if $sys eq 't/foo.dtd';
$tests[23]++ if $intdecl
}
sub att {
my ($p, $elname, $attname, $type, $default, $fixed) = @_;
$tests[24]++ if ($elname eq 'junk' and $attname eq 'id'
and $type eq 'ID' and $default eq '#REQUIRED'
and not $fixed);
$tests[25]++ if ($elname eq 'junk' and $attname eq 'version'
and $type eq 'CDATA' and $default eq "'1.0'" and $fixed);
$tests[26]++ if ($elname eq 'junk' and $attname eq 'color'
and $type eq '(red|green|blue)'
and $default eq "'green'");
$tests[27]++ if ($elname eq 'bar' and $attname eq 'big' and $default eq
"'$bigval'");
$tests[28]++ if ($elname eq 'junk' and $attname eq 'foo'
and $type eq 'NOTATION(x|y|z)' and $default eq '#IMPLIED');
}
sub xd {
my ($p, $version, $enc, $stand) = @_;
if (defined($version)) {
if ($version eq '1.0' and $enc eq 'ISO-8859-1' and not defined($stand)) {
$tests[29]++;
}
}
else {
$tests[30]++ if $enc eq 'x-sjis-unicode';
}
}
$parser->setHandlers(Entity => \&enth2,
Element => \&eleh,
Attlist => \&att,
Doctype => \&doc,
XMLDecl => \&xd);
$| = 1;
$parser->parse($docstr);
for (2 .. 30) {
print "not " unless $tests[$_];
print "ok $_\n";
}
|
