use
5.012;
my
$XML_module
=
'XML::Parsepp'
;
use_ok(
$XML_module
);
my
@result
;
my
$err
=
''
;
my
$line_more
;
my
$line_done
;
my
$retval
;
my
$XmlParser1
=
$XML_module
->new or
die
"Error-0010: Can't create $XML_module -> new"
;
my
$XmlParser2
=
$XML_module
->new or
die
"Error-0015: Can't create $XML_module -> new"
;
my
$XmlParser3
=
$XML_module
->new(
dupatt
=>
'|'
) or
die
"Error-0018: Can't create $XML_module -> new"
;
my
$test_parser
=
eval
{
$XML_module
->new(
dupatt
=>
'é'
)};
my
$emsg
= $@ ? $@ :
''
;
like(
$emsg
,
qr{invalid \s dupatt}
xms,
'Test-900a: error'
);
my
@Handlers
= (
[ 1,
Init
=> \
&handle_Init
,
'INIT'
,
occurs
=> 108,
'Init (Expat)'
],
[ 2,
Final
=> \
&handle_Final
,
'FINL'
,
occurs
=> 54,
'Final (Expat)'
],
[ 3,
Start
=> \
&handle_Start
,
'STRT'
,
occurs
=> 115,
'Start (Expat, Element [, Attr, Val [,...]])'
],
[ 4,
End
=> \
&handle_End
,
'ENDL'
,
occurs
=> 80,
'End (Expat, Element)'
],
[ 5,
Char
=> \
&handle_Char
,
'CHAR'
,
occurs
=> 153,
'Char (Expat, String)'
],
[ 6,
Proc
=> \
&handle_Proc
,
'PROC'
,
occurs
=> 8,
'Proc (Expat, Target, Data)'
],
[ 7,
Comment
=> \
&handle_Comment
,
'COMT'
,
occurs
=> 7,
'Comment (Expat, Data)'
],
[ 8,
CdataStart
=> \
&handle_CdataStart
,
'CDST'
,
occurs
=> 2,
'CdataStart (Expat)'
],
[ 9,
CdataEnd
=> \
&handle_CdataEnd
,
'CDEN'
,
occurs
=> 2,
'CdataEnd (Expat)'
],
[ 10,
Default
=> \
&handle_Default
,
'DEFT'
,
occurs
=> 58,
'Default (Expat, String)'
],
[ 11,
Unparsed
=> \
&handle_Unparsed
,
'UNPS'
,
occurs
=> 11,
'Unparsed (Expat, Entity, Base, Sysid, Pubid, Notation)'
],
[ 12,
Notation
=> \
&handle_Notation
,
'NOTA'
,
occurs
=> 5,
'Notation (Expat, Notation, Base, Sysid, Pubid)'
],
[ 13,
ExternEnt
=> \
&handle_ExternEnt
,
'EXEN'
,
occurs
=> 3,
'ExternEnt (Expat, Base, Sysid, Pubid)'
],
[ 14,
ExternEntFin
=> \
&handle_ExternEntFin
,
'EXEF'
,
occurs
=> 3,
'ExternEntFin (Expat)'
],
[ 15,
Entity
=> \
&handle_Entity
,
'ENTT'
,
occurs
=> 67,
'Entity (Expat, Name, Val, Sysid, Pubid, Ndata, IsParam)'
],
[ 16,
Element
=> \
&handle_Element
,
'ELEM'
,
occurs
=> 5,
'Element (Expat, Name, Model)'
],
[ 17,
Attlist
=> \
&handle_Attlist
,
'ATTL'
,
occurs
=> 20,
'Attlist (Expat, Elname, Attname, Type, Default, Fixed)'
],
[ 18,
Doctype
=> \
&handle_Doctype
,
'DOCT'
,
occurs
=> 45,
'Doctype (Expat, Name, Sysid, Pubid, Internal)'
],
[ 19,
DoctypeFin
=> \
&handle_DoctypeFin
,
'DOCF'
,
occurs
=> 40,
'DoctypeFin (Expat)'
],
[ 20,
XMLDecl
=> \
&handle_XMLDecl
,
'DECL'
,
occurs
=> 66,
'XMLDecl (Expat, Version, Encoding, Standalone)'
],
);
my
@HParam1
;
my
@HParam2
;
my
@HParam3
;
for
my
$H
(
@Handlers
) {
push
@HParam1
,
$H
->[1],
$H
->[2];
push
@HParam2
,
$H
->[1],
$H
->[2]
unless
$H
->[1] eq
'ExternEnt'
or
$H
->[1] eq
'ExternEntFin'
;
push
@HParam3
,
$H
->[1],
$H
->[2];
}
my
%HInd
;
my
@HCount
;
for
my
$i
(0..
$#Handlers
) {
$HInd
{
$Handlers
[
$i
][3]} =
$i
;
$HCount
[
$i
] = 0;
}
$XmlParser1
->setHandlers(
@HParam1
);
$XmlParser2
->setHandlers(
@HParam2
);
$XmlParser3
->setHandlers(
@HParam3
);
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
qq{\n}
.
q{<root> <item ff='pt1' gg="pt2">yyy</item><dummy/>}
.
q{<data>a }
.
qq{\n}
.
q{ gggggg<!-- cmt1 > < & --> bc<![CDATA[ x <!-- cmt2 --> y z > < & ]]>d <!-- cmt3 <![CDATA[ zzz ]]> --> ef</data>}
.
q{tt <?ab cde?> uu}
.
qq{\n\t\t}
.
q{<sléép>abc>&<d [] ef</sléép>}
.
q{</root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DEFT str=[&<0a>]'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[ ]'
,
'STRT ele=[item], atr=[ff], [pt1], [gg], [pt2]'
,
'CHAR txt=[yyy]'
,
'ENDL ele=[item]'
,
'STRT ele=[dummy], atr=[]'
,
'ENDL ele=[dummy]'
,
'STRT ele=[data], atr=[]'
,
'CHAR txt=[a ]'
,
'CHAR txt=[&<0a>]'
,
'CHAR txt=[ gggggg]'
,
'COMT cmt=[ cmt1 > < & ]'
,
'CHAR txt=[ bc]'
,
'CDST'
,
'CHAR txt=[ x <!-- cmt2 --> y z > < & ]'
,
'CDEN'
,
'CHAR txt=[d ]'
,
'COMT cmt=[ cmt3 <!&<5b>CDATA&<5b> zzz &<5d>&<5d>> ]'
,
'CHAR txt=[ ef]'
,
'ENDL ele=[data]'
,
'CHAR txt=[tt ]'
,
'PROC tgt=[ab], dat=[cde]'
,
'CHAR txt=[ uu]'
,
'CHAR txt=[&<0a>]'
,
'CHAR txt=[&<09>&<09>]'
,
'STRT ele=[sléép], atr=[]'
,
'CHAR txt=[abc]'
,
'CHAR txt=[>]'
,
'CHAR txt=[&]'
,
'CHAR txt=[<]'
,
'CHAR txt=[d &<5b>&<5d> ef]'
,
'ENDL ele=[sléép]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-001a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-001b: Number of results'
);
verify(
'001'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<test><long d1="'" d2='"' d3}
,
q{=}
,
q{'}
,
q{&}
,
q{a}
,
q{m}
,
q{p}
,
q{;}
,
q{'}
,
q{>}
,
q{aa}
,
q{bbbb}
,
q{cc</long><!-- xx}
,
q{yyyy}
,
q{ }
,
q{&}
,
q{l}
,
q{t}
,
q{;}
,
q{z}
,
q{&}
,
q{z}
,
q{-}
,
q{-}
,
q{>}
,
q{&}
,
q{g}
,
q{t}
,
q{;}
,
q{<}
,
q{/}
,
q{t}
,
q{e}
,
q{st>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[test], atr=[]'
,
'STRT ele=[long], atr=[d1], [\'], [d2], ["], [d3], [&]'
,
'CHAR txt=[aa]'
,
'CHAR txt=[bbbb]'
,
'CHAR txt=[cc]'
,
'ENDL ele=[long]'
,
'COMT cmt=[ xxyyyy <z&z]'
,
'CHAR txt=[>]'
,
'ENDL ele=[test]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-002a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-002b: Number of results'
);
verify(
'002'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<aaaa><test><open>}
);
like(
$err
,
qr{no \s element \s found}
xms,
'Test-003a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[aaaa], atr=[]'
,
'STRT ele=[test], atr=[]'
,
'STRT ele=[open], atr=[]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-003b: Number of results'
);
verify(
'003'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<aaaa><test><open>z</open></test></aaaa>uuu}
);
like(
$err
,
qr{junk \s after \s document \s element}
xms,
'Test-005a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[aaaa], atr=[]'
,
'STRT ele=[test], atr=[]'
,
'STRT ele=[open], atr=[]'
,
'CHAR txt=[z]'
,
'ENDL ele=[open]'
,
'ENDL ele=[test]'
,
'ENDL ele=[aaaa]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-005b: Number of results'
);
verify(
'005'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<aaaa><test><open>z</open></test></aaaa> }
.
qq{\n\n}
);
my
@expected
= (
'INIT'
,
'STRT ele=[aaaa], atr=[]'
,
'STRT ele=[test], atr=[]'
,
'STRT ele=[open], atr=[]'
,
'CHAR txt=[z]'
,
'ENDL ele=[open]'
,
'ENDL ele=[test]'
,
'ENDL ele=[aaaa]'
,
'DEFT str=[ &<0a>&<0a>]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-006a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-006b: Number of results'
);
verify(
'006'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<aaaa><test><open>z</open></test2></aaaa>}
);
like(
$err
,
qr{mismatched \s tag}
xms,
'Test-007a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[aaaa], atr=[]'
,
'STRT ele=[test], atr=[]'
,
'STRT ele=[open], atr=[]'
,
'CHAR txt=[z]'
,
'ENDL ele=[open]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-007b: Number of results'
);
verify(
'007'
, \
@result
, \
@expected
);
}
{
my
$xmldoc
=
qq{<aaaa>\n <test>\n <open>z</open>\n </test2>\n</aaaa>}
;
my
(
$prefix
,
$found
,
$suffix
) =
$xmldoc
=~ m{\A (.*?) (</test2>) (.*) \z}xms ? ($1, $2, $3) : (
''
,
''
,
''
);
my
$pref_1
=
$prefix
=~ m{\n ([^\n]*) \z}xms ? $1 :
''
;
my
$exp_lineno
=
$prefix
=~
tr
/\n// + 1;
my
$exp_column
=
length
(
$pref_1
) + 2;
my
$exp_bytes
=
length
(
$prefix
) + 2;
my
$exp_program
= $0;
my
$exp_proglin
=
$line_more
;
get_result(
$XmlParser1
,
$xmldoc
);
like(
$err
,
qr{mismatched \s+ tag}
xms,
'Test-008a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[aaaa], atr=[]'
,
'CHAR txt=[&<0a>]'
,
'CHAR txt=[ ]'
,
'STRT ele=[test], atr=[]'
,
'CHAR txt=[&<0a>]'
,
'CHAR txt=[ ]'
,
'STRT ele=[open], atr=[]'
,
'CHAR txt=[z]'
,
'ENDL ele=[open]'
,
'CHAR txt=[&<0a>]'
,
'CHAR txt=[ ]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-008b: Number of results'
);
verify(
'008'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<test dat="abc>" dfp="def<"></test>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[test], atr=[dat], [abc>], [dfp], [def<]'
,
'ENDL ele=[test]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-009a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-009b: Number of results'
);
verify(
'009'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<test dfp="def<"></test>}
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-010a: error'
);
my
@expected
= (
'INIT'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-010b: Number of results'
);
verify(
'010'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<test dfp="def">abc &zzz; def</test>}
);
like(
$err
,
qr{undefined \s entity}
xms,
'Test-011a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[test], atr=[dfp], [def]'
,
'CHAR txt=[abc ]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-011b: Number of results'
);
verify(
'011'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<test dfp="def">abc & def</test>}
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-012a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[test], atr=[dfp], [def]'
,
'CHAR txt=[abc ]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-012b: Number of results'
);
verify(
'012'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<test dfp="def">abc &zzz def</test>}
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-013a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[test], atr=[dfp], [def]'
,
'CHAR txt=[abc ]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-013b: Number of results'
);
verify(
'013'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<test dfp="def">abc &</test>}
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-014a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[test], atr=[dfp], [def]'
,
'CHAR txt=[abc ]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-014b: Number of results'
);
verify(
'014'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<test dfp="def">abc &zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz; def</test>}
);
like(
$err
,
qr{undefined \s entity}
xms,
'Test-015a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[test], atr=[dfp], [def]'
,
'CHAR txt=[abc ]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-015b: Number of results'
);
verify(
'015'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<test dfp="def">ab}
,
q{c}
,
q{ }
,
q{&}
,
q{a}
,
q{m}
,
q{p}
,
q{z}
,
q{z}
,
q{zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz; def</test>}
);
like(
$err
,
qr{undefined \s entity}
xms,
'Test-016a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[test], atr=[dfp], [def]'
,
'CHAR txt=[ab]'
,
'CHAR txt=[c]'
,
'CHAR txt=[ ]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-016b: Number of results'
);
verify(
'016'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<zzz><test d1="aa" d2="bb"/></zzz>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[zzz], atr=[]'
,
'STRT ele=[test], atr=[d1], [aa], [d2], [bb]'
,
'ENDL ele=[test]'
,
'ENDL ele=[zzz]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-017a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-017b: Number of results'
);
verify(
'017'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<zzz><?abc def?></zzz>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[zzz], atr=[]'
,
'PROC tgt=[abc], dat=[def]'
,
'ENDL ele=[zzz]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-018a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-018b: Number of results'
);
verify(
'018'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<zzz><? abc def ghi ?></zzz>}
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-019a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[zzz], atr=[]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-019b: Number of results'
);
verify(
'019'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<zzz><?abc def ghi ?></zzz>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[zzz], atr=[]'
,
'PROC tgt=[abc], dat=[def ghi ]'
,
'ENDL ele=[zzz]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-020a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-020b: Number of results'
);
verify(
'020'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<zzz><?abc?></zzz>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[zzz], atr=[]'
,
'PROC tgt=[abc], dat=[]'
,
'ENDL ele=[zzz]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-021a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-021b: Number of results'
);
verify(
'021'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<zzz><test d1 = "aa" d2 = "bb" /></zzz>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[zzz], atr=[]'
,
'STRT ele=[test], atr=[d1], [aa], [d2], [bb]'
,
'ENDL ele=[test]'
,
'ENDL ele=[zzz]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-022a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-022b: Number of results'
);
verify(
'022'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<zzz>< test/></zzz>}
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-023a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[zzz], atr=[]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-023b: Number of results'
);
verify(
'023'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<zzz><test/ ></zzz>}
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-024a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[zzz], atr=[]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-024b: Number of results'
);
verify(
'024'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<zzz><test /></zzz>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[zzz], atr=[]'
,
'STRT ele=[test], atr=[]'
,
'ENDL ele=[test]'
,
'ENDL ele=[zzz]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-025a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-025b: Number of results'
);
verify(
'025'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<zzz><!-- a}
,
q{b}
,
q{c --></zzz>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[zzz], atr=[]'
,
'COMT cmt=[ abc ]'
,
'ENDL ele=[zzz]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-026a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-026b: Number of results'
);
verify(
'026'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<zzz>a}
,
q{b}
,
q{c</zzz>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[zzz], atr=[]'
,
'CHAR txt=[a]'
,
'CHAR txt=[b]'
,
'CHAR txt=[c]'
,
'ENDL ele=[zzz]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-027a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-027b: Number of results'
);
verify(
'027'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<zzz>a}
,
q{bx<![CDATA[}
,
q{y}
,
q{z123]]>45}
,
q{c</zzz>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[zzz], atr=[]'
,
'CHAR txt=[a]'
,
'CHAR txt=[bx]'
,
'CDST'
,
'CHAR txt=[y]'
,
'CHAR txt=[z123]'
,
'CDEN'
,
'CHAR txt=[45]'
,
'CHAR txt=[c]'
,
'ENDL ele=[zzz]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-028a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-028b: Number of results'
);
verify(
'028'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1" standalone='yes'?><data/>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[1]'
,
'STRT ele=[data], atr=[]'
,
'ENDL ele=[data]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-029a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-029b: Number of results'
);
verify(
'029'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1" standalone='maybe'?><data/>}
);
like(
$err
,
qr{XML \s declaration \s not \s well-formed}
xms,
'Test-030a: error'
);
my
@expected
= (
'INIT'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-030b: Number of results'
);
verify(
'030'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1" standalone='Yes'?><data/>}
);
like(
$err
,
qr{XML \s declaration \s not \s well-formed}
xms,
'Test-031a: error'
);
my
@expected
= (
'INIT'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-031b: Number of results'
);
verify(
'031'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1" Standalone='yes'?><data/>}
);
like(
$err
,
qr{XML \s declaration \s not \s well-formed}
xms,
'Test-032a: error'
);
my
@expected
= (
'INIT'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-032b: Number of results'
);
verify(
'032'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.1" encoding="ISO-8859-1" standalone='yes'?><data/>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.1], enc=[ISO-8859-1], stand=[1]'
,
'STRT ele=[data], atr=[]'
,
'ENDL ele=[data]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-033a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-033b: Number of results'
);
verify(
'033'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1" standalone='no'?><data/>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[]'
,
'STRT ele=[data], atr=[]'
,
'ENDL ele=[data]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-034a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-034b: Number of results'
);
verify(
'034'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="3.9" encoding="ISO-8859-1" standalone='yes'?><data/>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[3.9], enc=[ISO-8859-1], stand=[1]'
,
'STRT ele=[data], atr=[]'
,
'ENDL ele=[data]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-035a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-035b: Number of results'
);
verify(
'035'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="aaa" encoding="ISO-8859-1" standalone='yes'?><data/>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[aaa], enc=[ISO-8859-1], stand=[1]'
,
'STRT ele=[data], atr=[]'
,
'ENDL ele=[data]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-036a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-036b: Number of results'
);
verify(
'036'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" dummy encoding="ISO-8859-1" standalone='yes'?><data/>}
);
like(
$err
,
qr{XML \s declaration \s not \s well-formed}
xms,
'Test-037a: error'
);
my
@expected
= (
'INIT'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-037b: Number of results'
);
verify(
'037'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>tttt<data/>}
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-040a: error'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-040b: Number of results'
);
verify(
'040'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{uuuu<?xml version="1.0" encoding="ISO-8859-1"?><data/>}
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-041a: error'
);
my
@expected
= (
'INIT'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-041b: Number of results'
);
verify(
'041'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
qq{\n\n}
.
q{<?xml version="1.0" encoding="ISO-8859-1"?><data/>}
);
like(
$err
,
qr{XML \s or \s text \s declaration \s not \s at \s start \s of \s entity}
xms,
'Test-042a: error'
);
my
@expected
= (
'INIT'
,
'DEFT str=[&<0a>&<0a>]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-042b: Number of results'
);
verify(
'042'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
qq{\n\n}
.
q{<data/>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DEFT str=[&<0a>&<0a>]'
,
'STRT ele=[data], atr=[]'
,
'ENDL ele=[data]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-043a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-043b: Number of results'
);
verify(
'043'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<data/>}
.
qq{\n\n}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'STRT ele=[data], atr=[]'
,
'ENDL ele=[data]'
,
'DEFT str=[&<0a>&<0a>]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-044a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-044b: Number of results'
);
verify(
'044'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<data/>}
.
q{abcdefg}
);
like(
$err
,
qr{junk \s after \s document \s element}
xms,
'Test-045a: error'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'STRT ele=[data], atr=[]'
,
'ENDL ele=[data]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-045b: Number of results'
);
verify(
'045'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?><data>abc></data>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'STRT ele=[data], atr=[]'
,
'CHAR txt=[abc>]'
,
'ENDL ele=[data]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-046a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-046b: Number of results'
);
verify(
'046'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?><data name="xyz>"></data>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'STRT ele=[data], atr=[name], [xyz>]'
,
'ENDL ele=[data]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-047a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-047b: Number of results'
);
verify(
'047'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?><data name="x&yz>"></data>}
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-048a: error'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-048b: Number of results'
);
verify(
'048'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?><data name="<&>"></data>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'STRT ele=[data], atr=[name], [<&>]'
,
'ENDL ele=[data]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-049a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-049b: Number of results'
);
verify(
'049'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
qq{\n}
.
q{<!DOCTYPE racine SYSTEM "URI-de-la-dtd">}
.
qq{\n}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DEFT str=[&<0a>]'
,
'DOCT nam=[racine], sys=[URI-de-la-dtd], pub=[*undef*], int=[]'
,
'DOCF'
,
'DEFT str=[&<0a>]'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-050a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-050b: Number of results'
);
verify(
'050'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
qq{\n}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DEFT str=[&<0a>]'
,
'DOCF'
,
'DEFT str=[&<0a>]'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-051a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-051b: Number of results'
);
verify(
'051'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
qq{\n}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DEFT str=[&<0a>]'
,
'DOCF'
,
'DEFT str=[&<0a>]'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-052a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-052b: Number of results'
);
verify(
'052'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
qq{\n}
.
q{<!DOCTYPE racine SYSTEM "URI-de-la-dtd">}
.
qq{\n}
.
q{<root></root>}
);
like(
$err
,
qr{syntax \s error}
xms,
'Test-053a: error'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DEFT str=[&<0a>]'
,
'DOCT nam=[racine], sys=[URI-de-la-dtd], pub=[*undef*], int=[]'
,
'DOCF'
,
'DEFT str=[&<0a>]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-053b: Number of results'
);
verify(
'053'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
qq{\n}
.
q{<!-- fichier dialogue4.xml -->}
.
qq{\n}
.
q{<!DOCTYPE dialogue}
.
qq{\n}
.
q{[}
.
qq{\n}
.
q{ <!ELEMENT dialogue (situation?, replique+)>}
.
qq{\n}
.
q{ <!ELEMENT situation (#PCDATA) >}
.
qq{\n}
.
q{ <!ELEMENT replique ( personnage , texte ) >}
.
qq{\n}
.
q{ <!ELEMENT personnage ( #PCDATA ) >}
.
qq{\n}
.
q{ <!ATTLIST personnage attitude CDATA #REQUIRED geste CDATA #IMPLIED >}
.
qq{\n}
.
q{ <!NOTATION flash SYSTEM "/usr/bin/flash.exe">}
.
qq{\n}
.
q{ <!ENTITY animation SYSTEM "../anim.fla" NDATA flash>}
.
qq{\n}
.
q{ <!ELEMENT texte (#PCDATA) >}
.
qq{\n}
.
q{ <!ATTLIST texte ton (normal | fort | faible) "normal">}
.
qq{\n}
.
q{]>}
.
qq{\n}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DEFT str=[&<0a>]'
,
'COMT cmt=[ fichier dialogue4.xml ]'
,
'DEFT str=[&<0a>]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'DEFT str=[&<0a> ]'
,
'ELEM nam=[dialogue], mod=[(situation?,replique+)]'
,
'DEFT str=[&<0a> ]'
,
'ELEM nam=[situation], mod=[(#PCDATA)]'
,
'DEFT str=[&<0a> ]'
,
'ELEM nam=[replique], mod=[(personnage,texte)]'
,
'DEFT str=[&<0a> ]'
,
'ELEM nam=[personnage], mod=[(#PCDATA)]'
,
'DEFT str=[&<0a> ]'
,
'ATTL eln=[personnage], atn=[attitude], typ=[CDATA], def=[#REQUIRED], fix=[*undef*]'
,
'ATTL eln=[personnage], atn=[geste], typ=[CDATA], def=[#IMPLIED], fix=[*undef*]'
,
'DEFT str=[&<0a> ]'
,
'NOTA not=[flash], base=[*undef*], sys=[/usr/bin/flash.exe], pub=[*undef*]'
,
'DEFT str=[&<0a> ]'
,
'UNPS ent=[animation], base=[*undef*], sys=[../anim.fla], pub=[*undef*], not=[flash]'
,
'DEFT str=[&<0a> ]'
,
'ELEM nam=[texte], mod=[(#PCDATA)]'
,
'DEFT str=[&<0a> ]'
,
'ATTL eln=[texte], atn=[ton], typ=[(normal|fort|faible)], def=[\'normal\'], fix=[*undef*]'
,
'DEFT str=[&<0a>]'
,
'DOCF'
,
'DEFT str=[&<0a>]'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-054a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-054b: Number of results'
);
verify(
'054'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
qq{\n}
.
q{<!-- fichier dialogue5.xml -->}
.
qq{\n}
.
q{<!DOCTYPE dialogue SYSTEM "di a2.dtd" [}
.
qq{\n}
.
q{ <!ENTITY prl "madame pernelle">}
.
qq{\n}
.
q{ <!ENTITY elm "elmire">}
.
qq{\n}
.
q{ <!ENTITY dialogue_a SYSTEM "dialogue5a.xml">}
.
qq{\n}
.
q{ <!ENTITY dialogue_b SYSTEM "dialogue5b.xml">}
.
qq{\n}
.
q{]>}
.
qq{\n}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DEFT str=[&<0a>]'
,
'COMT cmt=[ fichier dialogue5.xml ]'
,
'DEFT str=[&<0a>]'
,
'DOCT nam=[dialogue], sys=[di a2.dtd], pub=[*undef*], int=[1]'
,
'DEFT str=[&<0a> ]'
,
'ENTT nam=[prl], val=[madame pernelle], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DEFT str=[&<0a> ]'
,
'ENTT nam=[elm], val=[elmire], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DEFT str=[&<0a> ]'
,
'ENTT nam=[dialogue_a], val=[*undef*], sys=[dialogue5a.xml], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DEFT str=[&<0a> ]'
,
'ENTT nam=[dialogue_b], val=[*undef*], sys=[dialogue5b.xml], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DEFT str=[&<0a>]'
,
'DOCF'
,
'DEFT str=[&<0a>]'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-055a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-055b: Number of results'
);
verify(
'055'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1" standalone='yes'?>}
.
qq{\n}
.
q{<!DOCTYPE racine SYSTEM "URI-de-la-dtd">}
.
qq{\n}
.
q{<root>}
.
q{ Text}
.
qq{\n}
.
q{ <item at1='jk' at2="uu" />}
.
qq{\n}
.
q{ <break test='j}
.
qq{\n\n\n}
.
q{k' />}
.
qq{\n}
.
q{ <?abc def ghi jkl ?>}
.
qq{\n}
.
q{</root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[1]'
,
'DEFT str=[&<0a>]'
,
'DOCT nam=[racine], sys=[URI-de-la-dtd], pub=[*undef*], int=[]'
,
'DOCF'
,
'DEFT str=[&<0a>]'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[ Text]'
,
'CHAR txt=[&<0a>]'
,
'CHAR txt=[ ]'
,
'STRT ele=[item], atr=[at1], [jk], [at2], [uu]'
,
'ENDL ele=[item]'
,
'CHAR txt=[&<0a>]'
,
'CHAR txt=[ ]'
,
'STRT ele=[break], atr=[test], [j k]'
,
'ENDL ele=[break]'
,
'CHAR txt=[&<0a>]'
,
'CHAR txt=[ ]'
,
'PROC tgt=[abc], dat=[def ghi jkl ]'
,
'CHAR txt=[&<0a>]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-056a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-056b: Number of results'
);
verify(
'056'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<root>}
.
q{ <? abc def?>}
.
qq{\n}
.
q{</root>}
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-057a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[ ]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-057b: Number of results'
);
verify(
'057'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<root>}
.
q{ <?abc?>}
.
qq{\n}
.
q{ <?def ?>}
.
qq{\n}
.
q{</root>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[ ]'
,
'PROC tgt=[abc], dat=[]'
,
'CHAR txt=[&<0a>]'
,
'CHAR txt=[ ]'
,
'PROC tgt=[def], dat=[]'
,
'CHAR txt=[&<0a>]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-058a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-058b: Number of results'
);
verify(
'058'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY animation1 SYSTEM "../an im.fla" NDATA flash>}
.
q{<!ENTITY animation2 SYSTEM "../an im.fla">}
.
q{<!ENTITY animation2 SYSTEM "dummy">}
.
q{]>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'UNPS ent=[animation1], base=[*undef*], sys=[../an im.fla], pub=[*undef*], not=[flash]'
,
'ENTT nam=[animation2], val=[*undef*], sys=[../an im.fla], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DEFT str=[animation2]'
,
'DEFT str=["dummy"]'
,
'DEFT str=[>]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-059a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-059b: Number of results'
);
verify(
'059'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!DOCTYPE test SYSTEM "URI-de-la-dtd">}
.
q{]>}
.
q{<root></root>}
);
like(
$err
,
qr{syntax \s error}
xms,
'Test-060a: error'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-060b: Number of results'
);
verify(
'060'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!doctype test SYSTEM "URI-de-la-dtd">}
.
q{<root></root>}
);
like(
$err
,
qr{syntax \s error}
xms,
'Test-061a: error'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-061b: Number of results'
);
verify(
'061'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE test system "URI-de-la-dtd">}
.
q{<root></root>}
);
like(
$err
,
qr{syntax \s error}
xms,
'Test-062a: error'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-062b: Number of results'
);
verify(
'062'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE test SYSTEM "URI-de-la-dtd">}
.
q{zzz}
.
q{<root></root>}
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-063a: error'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[test], sys=[URI-de-la-dtd], pub=[*undef*], int=[]'
,
'DOCF'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-063b: Number of results'
);
verify(
'063'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY animation2 SYSTEM "dummy">}
.
q{aaa}
.
q{]>}
.
q{<root></root>}
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-064a: error'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[animation2], val=[*undef*], sys=[dummy], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-064b: Number of results'
);
verify(
'064'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY nom1 "chaine1">}
.
q{<!ENTITY nom2 SYSTEM "uri1">}
.
q{<!ENTITY % nom3 "chaine3">}
.
q{<!ENTITY % nom4 SYSTEM "uri3">}
.
q{]>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[nom1], val=[chaine1], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom2], val=[*undef*], sys=[uri1], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom3], val=[chaine3], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[1]'
,
'ENTT nam=[nom4], val=[*undef*], sys=[uri3], pub=[*undef*], nda=[*undef*], isp=[1]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-065a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-065b: Number of results'
);
verify(
'065'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!ENTITY nom1 "chaine1">}
.
q{<root></root>}
);
like(
$err
,
qr{syntax \s error}
xms,
'Test-066a: error'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-066b: Number of results'
);
verify(
'066'
, \
@result
, \
@expected
);
}
{
$retval
=
'abc'
;
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE root}
.
q{[}
.
q{<!ENTITY nom SYSTEM "uri.txt">}
.
q{]>}
.
q{<root>hij&nom;klm</root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[root], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[nom], val=[*undef*], sys=[uri.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[hij]'
,
'EXEN base=[*undef*], sys=[uri.txt], pub=[*undef*]'
,
'CHAR txt=[abc]'
,
'EXEF'
,
'CHAR txt=[klm]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-067a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-067b: Number of results'
);
verify(
'067'
, \
@result
, \
@expected
);
}
{
crfile(
'fi le1.txt'
,
'opera456'
);
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE root}
.
q{[}
.
q{<!ENTITY ent1 SYSTEM "fi le1.txt">}
.
q{]>}
.
q{<root>z&ent1;y</root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[root], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[ent1], val=[*undef*], sys=[fi le1.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[z]'
,
'CHAR txt=[opera456]'
,
'CHAR txt=[y]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-068a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-068b: Number of results'
);
verify(
'068'
, \
@result
, \
@expected
);
}
{
dlfile(
'file2.txt'
);
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE root}
.
q{[}
.
q{<!ENTITY ent2 SYSTEM "file2.txt">}
.
q{]>}
.
q{<root>z&ent2;y</root>}
);
like(
$err
,
qr{Handler \s couldn't \s resolve \s external \s entity}
xms, 'Test-069a: error1');
like(
$err
,
qr{404 \s File \s `[^']+file2.txt' \s does \s not \s exist}
xms,
'Test-069a: error2'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[root], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[ent2], val=[*undef*], sys=[file2.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[z]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-069b: Number of results'
);
verify(
'069'
, \
@result
, \
@expected
);
}
{
crfile(
'file1.txt'
,
'test & hello ! bonjour'
);
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE root}
.
q{[}
.
q{<!ENTITY dat7 SYSTEM "file1.txt">}
.
q{]>}
.
q{<root>z&dat7;y</root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[root], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[dat7], val=[*undef*], sys=[file1.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[z]'
,
'CHAR txt=[test ]'
,
'CHAR txt=[&]'
,
'CHAR txt=[ hello ]'
,
'CHAR txt=[!]'
,
'CHAR txt=[ bonjour]'
,
'CHAR txt=[y]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-070a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-070b: Number of results'
);
verify(
'070'
, \
@result
, \
@expected
);
}
{
crfile(
'file1.txt'
,
'zz &fil2; yy'
);
crfile(
'file2.txt'
,
'aa & hello ! bb'
);
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE root}
.
q{[}
.
q{<!ENTITY fil1 SYSTEM "file1.txt">}
.
q{<!ENTITY fil2 SYSTEM "file2.txt">}
.
q{]>}
.
q{<root>qq &fil1; rr</root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[root], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[fil1], val=[*undef*], sys=[file1.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[fil2], val=[*undef*], sys=[file2.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[qq ]'
,
'CHAR txt=[zz ]'
,
'CHAR txt=[aa ]'
,
'CHAR txt=[&]'
,
'CHAR txt=[ hello ]'
,
'CHAR txt=[!]'
,
'CHAR txt=[ bb]'
,
'CHAR txt=[ yy]'
,
'CHAR txt=[ rr]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-071a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-071b: Number of results'
);
verify(
'071'
, \
@result
, \
@expected
);
}
{
crfile(
'file1.txt'
,
'zz &fil2; yy'
);
crfile(
'file2.txt'
,
'aa &fil1; bb'
);
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE root}
.
q{[}
.
q{<!ENTITY fil1 SYSTEM "file1.txt">}
.
q{<!ENTITY fil2 SYSTEM "file2.txt">}
.
q{]>}
.
q{<root>qq &fil1; rr</root>}
);
like(
$err
,
qr{error \s in \s processing \s external \s entity \s reference}
xms,
'Test-072a: error1'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[root], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[fil1], val=[*undef*], sys=[file1.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[fil2], val=[*undef*], sys=[file2.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[qq ]'
,
'CHAR txt=[zz ]'
,
'CHAR txt=[aa ]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-072b: Number of results'
);
verify(
'072'
, \
@result
, \
@expected
);
}
{
crfile(
'file1.txt'
,
'c <xx>abba</xx> c tx &nom3; dd'
);
crfile(
'file2.txt'
,
'gg'
);
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY nom1 "aa &nom2; tt &nom4; bb">}
.
q{<!ENTITY nom2 SYSTEM "file1.txt">}
.
q{<!ENTITY nom3 "dd <yy>&nom4;</yy> ee">}
.
q{<!ENTITY nom4 SYSTEM "file2.txt">}
.
q{]>}
.
q{<root>hh &nom1; ii</root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[nom1], val=[aa &nom2; tt &nom4; bb], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom2], val=[*undef*], sys=[file1.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom3], val=[dd <yy>&nom4;</yy> ee], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom4], val=[*undef*], sys=[file2.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[hh ]'
,
'CHAR txt=[aa ]'
,
'CHAR txt=[c ]'
,
'STRT ele=[xx], atr=[]'
,
'CHAR txt=[abba]'
,
'ENDL ele=[xx]'
,
'CHAR txt=[ c tx ]'
,
'CHAR txt=[dd ]'
,
'STRT ele=[yy], atr=[]'
,
'CHAR txt=[gg]'
,
'ENDL ele=[yy]'
,
'CHAR txt=[ ee]'
,
'CHAR txt=[ dd]'
,
'CHAR txt=[ tt ]'
,
'CHAR txt=[gg]'
,
'CHAR txt=[ bb]'
,
'CHAR txt=[ ii]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-073a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-073b: Number of results'
);
verify(
'073'
, \
@result
, \
@expected
);
}
{
crfile(
'file1.txt'
,
'c <xx>abba</xx> c tx <ab> &nom3; dd'
);
crfile(
'file2.txt'
,
'gg'
);
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY nom1 "aa &nom2; tt &nom4; bb">}
.
q{<!ENTITY nom2 SYSTEM "file1.txt">}
.
q{<!ENTITY nom3 "dd </ab> <yy>&nom4;</yy> ee">}
.
q{<!ENTITY nom4 SYSTEM "file2.txt">}
.
q{]>}
.
q{<root>hh &nom1; ii</root>}
);
like(
$err
,
qr{error \s in \s processing \s external \s entity \s reference}
xms,
'Test-074a: error1'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[nom1], val=[aa &nom2; tt &nom4; bb], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom2], val=[*undef*], sys=[file1.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom3], val=[dd </ab> <yy>&nom4;</yy> ee], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom4], val=[*undef*], sys=[file2.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[hh ]'
,
'CHAR txt=[aa ]'
,
'CHAR txt=[c ]'
,
'STRT ele=[xx], atr=[]'
,
'CHAR txt=[abba]'
,
'ENDL ele=[xx]'
,
'CHAR txt=[ c tx ]'
,
'STRT ele=[ab], atr=[]'
,
'CHAR txt=[ ]'
,
'CHAR txt=[dd ]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-074b: Number of results'
);
verify(
'074'
, \
@result
, \
@expected
);
}
{
crfile(
'file1.txt'
,
'c <xx>abba</xx> c tx <ab&nom3;</ab> dd'
);
crfile(
'file2.txt'
,
'gg'
);
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY nom1 "aa &nom2; tt &nom4; bb">}
.
q{<!ENTITY nom2 SYSTEM "file1.txt">}
.
q{<!ENTITY nom3 ">dd <yy>&nom4;</yy> ee">}
.
q{<!ENTITY nom4 SYSTEM "file2.txt">}
.
q{]>}
.
q{<root>hh &nom1; ii</root>}
);
like(
$err
,
qr{error \s in \s processing \s external \s entity \s reference}
xms,
'Test-075a: error1'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[nom1], val=[aa &nom2; tt &nom4; bb], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom2], val=[*undef*], sys=[file1.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom3], val=[>dd <yy>&nom4;</yy> ee], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom4], val=[*undef*], sys=[file2.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[hh ]'
,
'CHAR txt=[aa ]'
,
'CHAR txt=[c ]'
,
'STRT ele=[xx], atr=[]'
,
'CHAR txt=[abba]'
,
'ENDL ele=[xx]'
,
'CHAR txt=[ c tx ]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-075b: Number of results'
);
verify(
'075'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
qq{\n}
.
q{<!DOCTYPE racine "ZZZ-de-la-dtd">}
.
qq{\n}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DEFT str=[&<0a>]'
,
);
like(
$err
,
qr{syntax \s error}
xms,
'Test-076a: error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-076b: Number of results'
);
verify(
'076'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
qq{\n}
.
q{<!DOCTYPE racine>}
.
qq{\n}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DEFT str=[&<0a>]'
,
'DOCT nam=[racine], sys=[*undef*], pub=[*undef*], int=[]'
,
'DOCF'
,
'DEFT str=[&<0a>]'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-077a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-077b: Number of results'
);
verify(
'077'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!ENTITY abc1 "aa bb">}
.
q{]>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'ENTT nam=[abc1], val=[aa bb], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-078a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-078b: Number of results'
);
verify(
'078'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
qq{\n}
.
q{<!DOCTYPE racine "tttt">}
.
qq{\n}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DEFT str=[&<0a>]'
,
);
like(
$err
,
qr{syntax \s error}
xms,
'Test-079a: error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-079b: Number of results'
);
verify(
'079'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!NOTATION flash1 SYSTEM "/usr/bin/flash.exe">}
.
q{<!ENTITY animation1 SYSTEM "../anim1.fla" NDATA flash1>}
.
q{<!ENTITY animation2 SYSTEM "../anim2.fla" NDATA flash2>}
.
q{]>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'NOTA not=[flash1], base=[*undef*], sys=[/usr/bin/flash.exe], pub=[*undef*]'
,
'UNPS ent=[animation1], base=[*undef*], sys=[../anim1.fla], pub=[*undef*], not=[flash1]'
,
'UNPS ent=[animation2], base=[*undef*], sys=[../anim2.fla], pub=[*undef*], not=[flash2]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-080a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-080b: Number of results'
);
verify(
'080'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY % coreattrs }
.
q{"id ID #IMPLIED -- document-wide unique id -- }
.
q{class CDATA #IMPLIED -- space-separated list of classes -- }
.
q{style StyleSheet; #IMPLIED -- associated style info -- }
.
q{title Text; #IMPLIED -- advisory title --">}
.
q{]>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[coreattrs], val=['
.
'id ID #IMPLIED'
.
' -- document-wide unique id -- '
.
'class CDATA #IMPLIED'
.
' -- space-separated list of classes -- '
.
'style StyleSheet; #IMPLIED'
.
' -- associated style info -- '
.
'title Text; #IMPLIED'
.
' -- advisory title --'
.
'], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[1]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-081a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-081b: Number of results'
);
verify(
'081'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY attr1 "id ID #IMPLIED -- id -- ">}
.
q{<!ENTITY % attr2 "id ID #IMPLIED -- id -- ">}
.
q{]>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[attr1], val=[id ID #IMPLIED -- id -- ], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[attr2], val=[id ID #IMPLIED -- id -- ], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[1]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-082a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-082b: Number of results'
);
verify(
'082'
, \
@result
, \
@expected
);
}
{
crfile(
'file 3.txt'
,
'drop <ze>abba</ze> dump &nom3; uu'
);
crfile(
'file 4.txt'
,
'dummy <>'
);
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY nom1 "test &nom2; data &nom4; end">}
.
q{<!ENTITY nom2 SYSTEM "file 3.txt">}
.
q{<!ENTITY nom3 "give <more>&nom4;</more> text">}
.
q{<!ENTITY nom4 SYSTEM "file 4.txt">}
.
q{<!ENTITY % nom5 "test5">}
.
q{<!ENTITY % nom6 SYSTEM "file 6.txt">}
.
q{]>}
.
q{<root>hh &nom1; ii</root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[nom1], val=[test &nom2; data &nom4; end], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom2], val=[*undef*], sys=[file 3.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom3], val=[give <more>&nom4;</more> text], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom4], val=[*undef*], sys=[file 4.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom5], val=[test5], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[1]'
,
'ENTT nam=[nom6], val=[*undef*], sys=[file 6.txt], pub=[*undef*], nda=[*undef*], isp=[1]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[hh ]'
,
'CHAR txt=[test ]'
,
'CHAR txt=[drop ]'
,
'STRT ele=[ze], atr=[]'
,
'CHAR txt=[abba]'
,
'ENDL ele=[ze]'
,
'CHAR txt=[ dump ]'
,
'CHAR txt=[give ]'
,
'STRT ele=[more], atr=[]'
,
'CHAR txt=[dummy ]'
,
'CHAR txt=[<]'
,
'CHAR txt=[>]'
,
'ENDL ele=[more]'
,
'CHAR txt=[ text]'
,
'CHAR txt=[ uu]'
,
'CHAR txt=[ data ]'
,
'CHAR txt=[dummy ]'
,
'CHAR txt=[<]'
,
'CHAR txt=[>]'
,
'CHAR txt=[ end]'
,
'CHAR txt=[ ii]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-083a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-083b: Number of results'
);
verify(
'083'
, \
@result
, \
@expected
);
}
{
crfile(
'file 3.txt'
,
'drop <ze>abba</ze> dump &nom3; uu'
);
crfile(
'file 4.txt'
,
'dummy <&nom5;>'
);
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY nom1 "test &nom2; data &nom4; end">}
.
q{<!ENTITY nom2 SYSTEM "file 3.txt">}
.
q{<!ENTITY nom3 "give <more>&nom4;</more> text">}
.
q{<!ENTITY nom4 SYSTEM "file 4.txt">}
.
q{<!ENTITY % nom5 "test5">}
.
q{<!ENTITY % nom6 SYSTEM "file 6.txt">}
.
q{]>}
.
q{<root>hh &nom1; ii</root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[nom1], val=[test &nom2; data &nom4; end], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom2], val=[*undef*], sys=[file 3.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom3], val=[give <more>&nom4;</more> text], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom4], val=[*undef*], sys=[file 4.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom5], val=[test5], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[1]'
,
'ENTT nam=[nom6], val=[*undef*], sys=[file 6.txt], pub=[*undef*], nda=[*undef*], isp=[1]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[hh ]'
,
'CHAR txt=[test ]'
,
'CHAR txt=[drop ]'
,
'STRT ele=[ze], atr=[]'
,
'CHAR txt=[abba]'
,
'ENDL ele=[ze]'
,
'CHAR txt=[ dump ]'
,
'CHAR txt=[give ]'
,
'STRT ele=[more], atr=[]'
,
'CHAR txt=[dummy ]'
,
'CHAR txt=[<]'
,
);
like(
$err
,
qr{error \s in \s processing \s external \s entity \s reference}
xms,
'Test-084a: error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-084b: Number of results'
);
verify(
'084'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY tst1 "test data 1">}
.
q{<!ENTITY tst2 SYSTEM "dat2.txt">}
.
q{<!ENTITY % nom3 "test data 3">}
.
q{<!ENTITY % nom4 SYSTEM "dat4.txt">}
.
q{<!ENTITY * nom5 "test data 5">}
.
q{<!ENTITY * nom6 SYSTEM "dat6.txt">}
.
q{]>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[tst1], val=[test data 1], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[tst2], val=[*undef*], sys=[dat2.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom3], val=[test data 3], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[1]'
,
'ENTT nam=[nom4], val=[*undef*], sys=[dat4.txt], pub=[*undef*], nda=[*undef*], isp=[1]'
,
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-085a: error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-085b: Number of results'
);
verify(
'085'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY nom1 "test <&>">}
.
q{]>}
.
q{<root parm1="'" parm2='"' parm3 = " ' data &"></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[nom1], val=[test <&>], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[parm1], [\'], [parm2], ["], [parm3], [ \' data &]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-086a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-086b: Number of results'
);
verify(
'086'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY nom1 "test <&>">}
.
q{]>}
.
q{<root parm1="'" parm2='"' parm3 = " <>' data &"></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[nom1], val=[test <&>], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-087a: error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-087b: Number of results'
);
verify(
'087'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE svg PUBLIC "[" "[">}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
);
like(
$err
,
qr{illegal \s character\(s\) \s in \s public \s id}
xms,
'Test-088a: error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-088b: Number of results'
);
verify(
'088'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
);
like(
$err
,
qr{syntax \s error}
xms,
'Test-089a: error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-089b: Number of results'
);
verify(
'089'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY t1 "test1">}
.
q{<!ENTITY t2 SYSTEM "test2">}
.
q{<!ENTITY t3 PUBLIC "test3">}
.
q{<!ENTITY t4 DUMMY "test4">}
.
q{]>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[t1], val=[test1], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[t2], val=[*undef*], sys=[test2], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
);
like(
$err
,
qr{syntax \s error}
xms,
'Test-090a: error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-090b: Number of results'
);
verify(
'090'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY animation1 SYSTEM "../an im.fla" NDATA flash>}
.
q{<!ENTITY t7 SYSTEM "test7" NDATA nd7>}
.
q{<!ENTITY t8 PUBLIC "test8" NDATA nd8>}
.
q{]>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'UNPS ent=[animation1], base=[*undef*], sys=[../an im.fla], pub=[*undef*], not=[flash]'
,
'UNPS ent=[t7], base=[*undef*], sys=[test7], pub=[*undef*], not=[nd7]'
,
);
like(
$err
,
qr{syntax \s error}
xms,
'Test-091a: error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-091b: Number of results'
);
verify(
'091'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY animation1 SYSTEM "../an im.fla" NDATA flash1>}
.
q{<!ENTITY animation2 SYSTEM "../an im.fla" NDATA flash2>}
.
q{<!ENTITY t6 SYSTEM "test6" NDATA nd6>}
.
q{]>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'UNPS ent=[animation1], base=[*undef*], sys=[../an im.fla], pub=[*undef*], not=[flash1]'
,
'UNPS ent=[animation2], base=[*undef*], sys=[../an im.fla], pub=[*undef*], not=[flash2]'
,
'UNPS ent=[t6], base=[*undef*], sys=[test6], pub=[*undef*], not=[nd6]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-092a: no error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-092b: Number of results'
);
verify(
'092'
, \
@result
, \
@expected
);
}
{
crfile(
'file1.txt'
,
'c <xx>abba</xx> c tx &nom3; dd'
);
crfile(
'file2.txt'
,
'gg'
);
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY nom1 "aa &nom2; tt &nom4; bb">}
.
q{<!ENTITY nom2 SYSTEM "file1.txt">}
.
q{<!ENTITY nom3 "dd <yy>&nom4;</yy> ee">}
.
q{<!ENTITY nom4 SYSTEM "file2.txt">}
.
q{]>}
.
q{<root parm='gg &nom1; tt'>uuuu</root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[nom1], val=[aa &nom2; tt &nom4; bb], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom2], val=[*undef*], sys=[file1.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom3], val=[dd <yy>&nom4;</yy> ee], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[nom4], val=[*undef*], sys=[file2.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
);
like(
$err
,
qr{reference \s to \s external \s entity \s in \s attribute}
xms,
'Test-093a: Error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-093b: Number of results'
);
verify(
'093'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ATTLIST image height CDATA #REQUIRED>}
.
q{<!ATTLIST image width CDATA #REQUIRED>}
.
q{<!ATTLIST student_name student_no ID #REQUIRED>}
.
q{<!ATTLIST student_name tutor_1 IDREF #IMPLIED>}
.
q{<!ATTLIST student_name tutor_2 IDREF #IMPLIED>}
.
q{<!ATTLIST results image ENTITY #REQUIRED>}
.
q{<!ATTLIST results images ENTITIES #REQUIRED>}
.
q{<!ATTLIST student_name student_no NMTOKEN #REQUIRED>}
.
q{<!ATTLIST code lang NOTATION (vrml) #REQUIRED>}
.
q{<!ATTLIST task status ( important | normal ) #REQUIRED>}
.
q{<!ATTLIST task status (important|normal) "normal">}
.
q{<!ATTLIST task status NMTOKEN #FIXED "monthly">}
.
q{<!ATTLIST description xml:lang NMTOKEN #FIXED "en">}
.
q{<!ATTLIST code xml:space (default|preserve) "preserve">}
.
q{<!ATTLIST personnage attitude CDATA #REQUIRED }
.
q{geste CDATA #IMPLIED >}
.
q{<!ATTLIST texte ton (normal | fort | faible) "normal">}
.
q{]>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ATTL eln=[image], '
.
'atn=[height], '
.
'typ=[CDATA], '
.
'def=[#REQUIRED], '
.
'fix=[*undef*]'
,
'ATTL eln=[image], '
.
'atn=[width], '
.
'typ=[CDATA], '
.
'def=[#REQUIRED], '
.
'fix=[*undef*]'
,
'ATTL eln=[student_name], '
.
'atn=[student_no], '
.
'typ=[ID], '
.
'def=[#REQUIRED], '
.
'fix=[*undef*]'
,
'ATTL eln=[student_name], '
.
'atn=[tutor_1], '
.
'typ=[IDREF], '
.
'def=[#IMPLIED], '
.
'fix=[*undef*]'
,
'ATTL eln=[student_name], '
.
'atn=[tutor_2], '
.
'typ=[IDREF], '
.
'def=[#IMPLIED], '
.
'fix=[*undef*]'
,
'ATTL eln=[results], '
.
'atn=[image], '
.
'typ=[ENTITY], '
.
'def=[#REQUIRED], '
.
'fix=[*undef*]'
,
'ATTL eln=[results], '
.
'atn=[images], '
.
'typ=[ENTITIES], '
.
'def=[#REQUIRED], '
.
'fix=[*undef*]'
,
'ATTL eln=[student_name], '
.
'atn=[student_no], '
.
'typ=[NMTOKEN], '
.
'def=[#REQUIRED], '
.
'fix=[*undef*]'
,
'ATTL eln=[code], '
.
'atn=[lang], '
.
'typ=[NOTATION(vrml)], '
.
'def=[#REQUIRED], '
.
'fix=[*undef*]'
,
'ATTL eln=[task], '
.
'atn=[status], '
.
'typ=[(important|normal)], '
.
'def=[#REQUIRED], '
.
'fix=[*undef*]'
,
'ATTL eln=[task], '
.
'atn=[status], '
.
'typ=[(important|normal)], '
.
'def=[\'normal\'], '
.
'fix=[*undef*]'
,
'ATTL eln=[task], '
.
'atn=[status], '
.
'typ=[NMTOKEN], '
.
'def=[\'monthly\'], '
.
'fix=[1]'
,
'ATTL eln=[description], '
.
'atn=[xml:lang], '
.
'typ=[NMTOKEN], '
.
'def=[\'en\'], '
.
'fix=[1]'
,
'ATTL eln=[code], '
.
'atn=[xml:space], '
.
'typ=[(default|preserve)], '
.
'def=[\'preserve\'], '
.
'fix=[*undef*]'
,
'ATTL eln=[personnage], '
.
'atn=[attitude], '
.
'typ=[CDATA], '
.
'def=[#REQUIRED], '
.
'fix=[*undef*]'
,
'ATTL eln=[personnage], '
.
'atn=[geste], '
.
'typ=[CDATA], '
.
'def=[#IMPLIED], '
.
'fix=[*undef*]'
,
'ATTL eln=[texte], '
.
'atn=[ton], '
.
'typ=[(normal|fort|faible)], '
.
'def=[\'normal\'], '
.
'fix=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-094a: no error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-094b: Number of results'
);
verify(
'094'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!NOTATION name1 SYSTEM "URI1">}
.
q{<!NOTATION name2 PUBLIC "public_ID2">}
.
q{<!NOTATION name3 PUBLIC "public_ID3" "URI3">}
.
q{]>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'NOTA not=[name1], base=[*undef*], sys=[URI1], pub=[*undef*]'
,
'NOTA not=[name2], base=[*undef*], sys=[*undef*], pub=[public_ID2]'
,
'NOTA not=[name3], base=[*undef*], sys=[URI3], pub=[public_ID3]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-095a: no error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-095b: Number of results'
);
verify(
'095'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{<root param='>'></root>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[root], atr=[param], [>]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-096a: no error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-096b: Number of results'
);
verify(
'096'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{<root><?abc def?></root>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[root], atr=[]'
,
'PROC tgt=[abc], dat=[def]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-097a: no error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-097b: Number of results'
);
verify(
'097'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{<root><? abc def ?></root>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[root], atr=[]'
,
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-098a: Error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-098b: Number of results'
);
verify(
'098'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<zzz>a}
,
q{bx<!-- b}
,
q{c}
,
q{d --> ef}
,
q{g</zzz>}
);
my
@expected
= (
'INIT'
,
'STRT ele=[zzz], atr=[]'
,
'CHAR txt=[a]'
,
'CHAR txt=[bx]'
,
'COMT cmt=[ bcd ]'
,
'CHAR txt=[ ef]'
,
'CHAR txt=[g]'
,
'ENDL ele=[zzz]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-099a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-099b: Number of results'
);
verify(
'099'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY animation1 SYSTEM "../an im.fla" NDATA flash>}
.
q{<!ENTITY animation2 SYSTEM "../an im.fla">}
.
q{<!ENTITY animation2 SYSTEM 'dummy'>}
.
q{]>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'UNPS ent=[animation1], base=[*undef*], sys=[../an im.fla], pub=[*undef*], not=[flash]'
,
'ENTT nam=[animation2], val=[*undef*], sys=[../an im.fla], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DEFT str=[animation2]'
,
q{DEFT str=['dummy']}
,
'DEFT str=[>]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-100a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-100b: Number of results'
);
verify(
'100'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY animation1 SYSTEM "../an im.fla" NDATA flash>}
.
q{<!ENTITY animation2 SYSTEM "../an im.fla">}
.
q{<!ENTITY animation2 'uuuu'>}
.
q{]>}
.
q{<root></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'UNPS ent=[animation1], base=[*undef*], sys=[../an im.fla], pub=[*undef*], not=[flash]'
,
'ENTT nam=[animation2], val=[*undef*], sys=[../an im.fla], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DEFT str=[animation2]'
,
q{DEFT str=['uuuu']}
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-101a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-101b: Number of results'
);
verify(
'101'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE dialogue}
.
q{[}
.
q{<!ENTITY nom1 "test <&>">}
.
q{]>}
.
q{<root parm1="'" parm2='"' parm3 = " ()' data &"></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[nom1], val=[test <&>], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[parm1], [\'], [parm2], ["], [parm3], [ ()\' data &]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
$err
,
''
,
'Test-102a: No error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-102b: Number of results'
);
verify(
'102'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{ "abc}
,
q{<root}
,
q{ parm1="'" parm2='"' parm3 = " ()' data &"></root>}
);
my
@expected
= (
'INIT'
,
'DEFT str=[ ]'
,
);
like(
$err
,
qr{not \s well-formed \s \(invalid \s token\)}
xms,
'Test-103a: error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-103b: Number of results'
);
verify(
'103'
, \
@result
, \
@expected
);
}
{
crfile(
'file1.txt'
,
'<abc>def</ab'
);
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
qq{\n}
,
q{<!DOCTYPE dialogue [}
.
qq{\n}
,
q{ <!ENTITY nom1 SYSTEM "file1.txt">}
.
q{]>}
.
qq{\n}
,
q{<root>&nom1;</root>}
.
qq{\n}
,
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DEFT str=[&<0a>]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'DEFT str=[&<0a>]'
,
'DEFT str=[ ]'
,
'ENTT nam=[nom1], val=[*undef*], sys=[file1.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'DEFT str=[&<0a>]'
,
'STRT ele=[root], atr=[]'
,
'STRT ele=[abc], atr=[]'
,
'CHAR txt=[def]'
,
);
like(
$err
,
qr{error \s in \s processing \s external \s entity \s reference}
xms,
'Test-104a: error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-104b: Number of results'
);
verify(
'104'
, \
@result
, \
@expected
);
}
{
$retval
=
'<abc>def</ab'
;
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE root}
.
q{[}
.
q{<!ENTITY nom SYSTEM "uri.txt">}
.
q{]>}
.
q{<root>hij&nom;klm</root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[root], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[nom], val=[*undef*], sys=[uri.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[hij]'
,
'EXEN base=[*undef*], sys=[uri.txt], pub=[*undef*]'
,
'STRT ele=[abc], atr=[]'
,
'CHAR txt=[def]'
,
'EXEF'
,
);
like(
$err
,
qr{error \s in \s processing \s external \s entity \s reference}
xms,
'Test-105a: error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-105b: Number of results'
);
verify(
'105'
, \
@result
, \
@expected
);
}
{
$retval
=
'<abc>def'
;
get_result(
$XmlParser1
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE root}
.
q{[}
.
q{<!ENTITY nom SYSTEM "uri.txt">}
.
q{]>}
.
q{<root>hij&nom;klm</abc></root>}
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[root], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[nom], val=[*undef*], sys=[uri.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[hij]'
,
'EXEN base=[*undef*], sys=[uri.txt], pub=[*undef*]'
,
'STRT ele=[abc], atr=[]'
,
'CHAR txt=[def]'
,
'EXEF'
,
);
like(
$err
,
qr{error \s in \s processing \s external \s entity \s reference}
xms,
'Test-106a: error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-106b: Number of results'
);
verify(
'106'
, \
@result
, \
@expected
);
}
{
crfile(
'file1.txt'
,
'<abc>def'
);
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
qq{\n}
,
q{<!DOCTYPE dialogue [}
.
qq{\n}
,
q{ <!ENTITY nom1 SYSTEM "file1.txt">}
.
q{]>}
.
qq{\n}
,
q{<root>&nom1;</abc></root>}
.
qq{\n}
,
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DEFT str=[&<0a>]'
,
'DOCT nam=[dialogue], sys=[*undef*], pub=[*undef*], int=[1]'
,
'DEFT str=[&<0a>]'
,
'DEFT str=[ ]'
,
'ENTT nam=[nom1], val=[*undef*], sys=[file1.txt], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'DEFT str=[&<0a>]'
,
'STRT ele=[root], atr=[]'
,
'STRT ele=[abc], atr=[]'
,
'CHAR txt=[def]'
,
);
like(
$err
,
qr{error \s in \s processing \s external \s entity \s reference}
xms,
'Test-107a: error'
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-107b: Number of results'
);
verify(
'107'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{<?xml version="1.0" encoding="ISO-8859-1"?>}
.
q{<!DOCTYPE root}
.
q{[}
.
q{<!ENTITY fil1 "zz &fil2; yy">}
.
q{<!ENTITY fil2 "aa &fil1; bb">}
.
q{]>}
.
q{<root>qq &fil1; rr</root>}
);
like(
$err
,
qr{recursive \s entity \s reference}
xms,
'Test-108a: error1'
);
my
@expected
= (
'INIT'
,
'DECL ver=[1.0], enc=[ISO-8859-1], stand=[*undef*]'
,
'DOCT nam=[root], sys=[*undef*], pub=[*undef*], int=[1]'
,
'ENTT nam=[fil1], val=[zz &fil2; yy], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'ENTT nam=[fil2], val=[aa &fil1; bb], sys=[*undef*], pub=[*undef*], nda=[*undef*], isp=[*undef*]'
,
'DOCF'
,
'STRT ele=[root], atr=[]'
,
'CHAR txt=[qq ]'
,
'CHAR txt=[zz ]'
,
'CHAR txt=[aa ]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-108b: Number of results'
);
verify(
'108'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{ aaaaaaaaaaaa}
);
like(
$err
,
qr{syntax \s error}
xms,
'Test-109a: error1'
);
my
@expected
= (
'INIT'
,
'DEFT str=[ ]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-109b: Number of results'
);
verify(
'109'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser2
,
q{<root><data a2="zzz" a1="yyy" a2="xxx">ttt</data></root>}
);
like(
$err
,
qr{duplicate \s attribute}
xms,
'Test-110a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[root], atr=[]'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-110b: Number of results'
);
verify(
'110'
, \
@result
, \
@expected
);
}
{
get_result(
$XmlParser3
,
q{<root><data a2="zzz" a1="yyy" a2="xxx">ttt</data></root>}
);
is(
$err
,
''
,
'Test-111a: error'
);
my
@expected
= (
'INIT'
,
'STRT ele=[root], atr=[]'
,
'STRT ele=[data], atr=[a1], [yyy], [a2], [zzz|xxx]'
,
'CHAR txt=[ttt]'
,
'ENDL ele=[data]'
,
'ENDL ele=[root]'
,
'FINL'
,
);
is(
scalar
(
@result
),
scalar
(
@expected
),
'Test-111b: Number of results'
);
verify(
'111'
, \
@result
, \
@expected
);
}
{
for
my
$i
(0..
$#Handlers
) {
is(
$HCount
[
$i
],
$Handlers
[
$i
][5],
'Test-890c-'
.
sprintf
(
'%03d'
,
$i
).
': correct counts for <'
.
$Handlers
[
$i
][3].
'>'
);
}
}
sub
verify {
my
(
$num
,
$res
,
$exp
) =
@_
;
for
my
$i
(0..
$#$exp
) {
is(
$res
->[
$i
],
$exp
->[
$i
],
'Test-'
.
$num
.
'c-'
.
sprintf
(
'%03d'
,
$i
).
': correct result'
);
my
$word
= !
defined
(
$res
->[
$i
]) ?
'!!!!'
:
$res
->[
$i
] =~ m{\A (\w{4}) }xms ? $1 :
'????'
;
my
$ind
=
$HInd
{
$word
};
if
(
defined
$ind
) {
$HCount
[
$ind
]++;
}
}
}
sub
get_result {
my
$Parser
=
shift
;
@result
= ();
$err
=
''
;
my
$ExpatNB
=
$Parser
->parse_start or
die
"Error-0020: Can't create XML::Parser->parse_start"
;
eval
{
for
my
$buf
(
@_
) {
$ExpatNB
->parse_more(
$buf
); BEGIN {
$line_more
= __LINE__; }
}
};
if
($@) {
$err
= $@;
$ExpatNB
->release;
}
else
{
eval
{
$ExpatNB
->parse_done; BEGIN {
$line_done
= __LINE__; }
};
if
($@) {
$err
= $@;
}
}
}
sub
handle_Init {
my
(
$ExpatNB
) =
@_
;
push
@result
, quote(
"INIT"
);
}
sub
handle_Final {
my
(
$ExpatNB
) =
@_
;
push
@result
, quote(
"FINL"
);
}
sub
handle_Start {
my
(
$ExpatNB
,
$element
,
@attr
) =
@_
;
$element
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
for
my
$at
(
@attr
) {
$at
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
}
local
$
" = "
], [";
push
@result
, quote(
"STRT ele=[$element], atr=[@attr]"
);
}
sub
handle_End {
my
(
$ExpatNB
,
$element
) =
@_
;
$element
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
push
@result
, quote(
"ENDL ele=[$element]"
);
}
sub
handle_Char {
my
(
$ExpatNB
,
$text
) =
@_
;
$text
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
push
@result
, quote(
"CHAR txt=[$text]"
);
}
sub
handle_Proc {
my
(
$ExpatNB
,
$target
,
$data
) =
@_
;
$target
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$data
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
push
@result
, quote(
"PROC tgt=[$target], dat=[$data]"
);
}
sub
handle_Comment {
my
(
$ExpatNB
,
$comment
) =
@_
;
$comment
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
push
@result
, quote(
"COMT cmt=[$comment]"
);
}
sub
handle_CdataStart {
my
(
$ExpatNB
) =
@_
;
push
@result
, quote(
"CDST"
);
}
sub
handle_CdataEnd {
my
(
$ExpatNB
) =
@_
;
push
@result
, quote(
"CDEN"
);
}
sub
handle_Default {
my
(
$ExpatNB
,
$string
) =
@_
;
$string
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
push
@result
, quote(
"DEFT str=[$string]"
);
}
sub
handle_Unparsed {
my
(
$ExpatNB
,
$entity
,
$base
,
$sysid
,
$pubid
,
$notation
) =
@_
;
$entity
//=
'*undef*'
;
$entity
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$base
//=
'*undef*'
;
$base
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$sysid
//=
'*undef*'
;
$sysid
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$pubid
//=
'*undef*'
;
$pubid
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$notation
//=
'*undef*'
;
$notation
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
push
@result
, quote(
"UNPS ent=[$entity], base=[$base], sys=[$sysid], pub=[$pubid], not=[$notation]"
);
}
sub
handle_Notation {
my
(
$ExpatNB
,
$notation
,
$base
,
$sysid
,
$pubid
) =
@_
;
$notation
//=
'*undef*'
;
$notation
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$base
//=
'*undef*'
;
$base
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$sysid
//=
'*undef*'
;
$sysid
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$pubid
//=
'*undef*'
;
$pubid
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
push
@result
, quote(
"NOTA not=[$notation], base=[$base], sys=[$sysid], pub=[$pubid]"
);
}
sub
handle_ExternEnt {
my
(
$ExpatNB
,
$base
,
$sysid
,
$pubid
) =
@_
;
$base
//=
'*undef*'
;
$base
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$sysid
//=
'*undef*'
;
$sysid
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$pubid
//=
'*undef*'
;
$pubid
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
push
@result
, quote(
"EXEN base=[$base], sys=[$sysid], pub=[$pubid]"
);
return
$retval
;
}
sub
handle_ExternEntFin {
my
(
$ExpatNB
) =
@_
;
push
@result
, quote(
"EXEF"
);
}
sub
handle_Entity {
my
(
$ExpatNB
,
$name
,
$val
,
$sysid
,
$pubid
,
$ndata
,
$isparam
) =
@_
;
$name
//=
'*undef*'
;
$name
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$val
//=
'*undef*'
;
$val
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$sysid
//=
'*undef*'
;
$sysid
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$pubid
//=
'*undef*'
;
$pubid
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$ndata
//=
'*undef*'
;
$ndata
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$isparam
//=
'*undef*'
;
$isparam
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
push
@result
, quote(
"ENTT nam=[$name], val=[$val], sys=[$sysid], pub=[$pubid], nda=[$ndata], isp=[$isparam]"
);
}
sub
handle_Element {
my
(
$ExpatNB
,
$name
,
$model
) =
@_
;
$name
//=
'*undef*'
;
$name
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$model
//=
'*undef*'
;
$model
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
push
@result
, quote(
"ELEM nam=[$name], mod=[$model]"
);
}
sub
handle_Attlist {
my
(
$ExpatNB
,
$elname
,
$attname
,
$type
,
$default
,
$fixed
) =
@_
;
$elname
//=
'*undef*'
;
$elname
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$attname
//=
'*undef*'
;
$attname
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$type
//=
'*undef*'
;
$type
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$default
//=
'*undef*'
;
$default
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$fixed
//=
'*undef*'
;
$fixed
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
push
@result
, quote(
"ATTL eln=[$elname], atn=[$attname], typ=[$type], def=[$default], fix=[$fixed]"
);
}
sub
handle_Doctype {
my
(
$ExpatNB
,
$name
,
$sysid
,
$pubid
,
$internal
) =
@_
;
$sysid
//=
'*undef*'
;
$sysid
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$pubid
//=
'*undef*'
;
$pubid
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$internal
//=
'*undef*'
;
$internal
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
push
@result
, quote(
"DOCT nam=[$name], sys=[$sysid], pub=[$pubid], int=[$internal]"
);
}
sub
handle_DoctypeFin {
my
(
$ExpatNB
) =
@_
;
push
@result
, quote(
"DOCF"
);
}
sub
handle_XMLDecl {
my
(
$ExpatNB
,
$version
,
$encoding
,
$standalone
) =
@_
;
$version
//=
'*undef*'
;
$version
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$encoding
//=
'*undef*'
;
$encoding
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
$standalone
//=
'*undef*'
;
$standalone
=~ s{([\[\]])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
push
@result
, quote(
"DECL ver=[$version], enc=[$encoding], stand=[$standalone]"
);
}
sub
quote {
my
(
$txt
) =
@_
;
$txt
=~ s{([\x00-\x1f])}{
sprintf
(
'&<%02x>'
,
ord
($1))}xmsge;
return
$txt
;
}
sub
crfile {
my
$fname
=
shift
;
open
my
$fh1
,
'>'
,
$fname
or
die
"Error-0005: Can't open > '$fname' because $!"
;
for
my
$item
(
@_
) {
print
{
$fh1
}
$item
;
}
close
$fh1
;
}
sub
dlfile {
my
$fname
=
shift
;
if
(-e
$fname
) {
unlink
$fname
or
die
"Error-0007: Can't unlink '$fname' because $!"
;
}
}