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
|
#!/usr/bin/perl -w
use strict;
use strict;
use Carp;
use File::Spec;
use lib File::Spec->catdir(File::Spec->curdir,"t");
use tools;
#$|=1;
my $DEBUG=0;
use XML::Twig;
my $TMAX=17;
print "1..$TMAX\n";
{ # test bug outputing end tag with pretty_print => nsgmls on
my $out= XML::Twig->new( pretty_print => 'nsgmls')->parse( "<doc><elt>text</elt></doc>")->sprint;
ok( XML::Twig->new( error_context => 1)->safe_parse( $out), "end tag with nsgmls option" . ($@ || '') );
}
{ # test bug RT #8830: simplify dies on mixed content
ok( XML::Twig->new->parse( "<doc>text1<elt/></doc>")->root->simplify, "simplify mixed content");
}
{ # testing to see if bug RT #7523 is still around
my $t= XML::Twig->new->parse( '<doc/>');
if( eval( '$t->iconv_convert( "utf8");'))
{ $t->set_output_encoding( 'utf8');
eval { $t->sprint;};
ok( !$@, 'checking bug RT 7523');
}
else
{ if( $@=~ m{^Can't locate Text/Iconv.pm} || $@=~ m{^Text::Iconv not available} )
{ skip( 1, "Text::Iconv not available"); }
elsif( $@=~ m{^Unsupported (encoding|conversion): utf8})
{ skip( 1, "your version of iconv does not support utf8"); }
else
{ skip( 1, "odd error creating filter with iconv: $@"); }
}
}
{ # bug on comments
my $doc= "<doc>\n <!-- comment -->\n <elt>foo</elt>\n</doc>\n";
my $t= XML::Twig->new( comments => 'keep', pretty_print => 'indented')
->parse( $doc);
is( $t->sprint => $doc, "comment with comments => 'keep'");
}
{ # bug with disapearing entities in attributes
my $text= '<doc att="München"><elt att="&ent2;"/><elt att="A&E">&ent3;</elt></doc>';
my $doc= qq{<!DOCTYPE doc SYSTEM "test_ent_in_att.dtd"[<!ENTITY foo "toto">]>$text};
XML::Twig::Elt::init_global_state();
my $regular=XML::Twig->new( pretty_print => 'none')->parse( $doc)->root->sprint;
(my $expected= $text)=~ s{&(uuml|ent2);}{}g; # yes, entities in attributes just vanish!
is( $regular => $expected, "entities in atts, no option");
XML::Twig::Elt::init_global_state();
my $with_keep=XML::Twig->new(keep_encoding => 1)->parse( $doc)->root->sprint;
is( $with_keep => $text, "entities in atts with keep_encoding");
XML::Twig::Elt::init_global_state();
my $with_dneaia=XML::Twig->new(do_not_escape_amp_in_atts => 1)->parse( $doc)->root->sprint;
if( $with_dneaia eq '<doc att="Mnchen"><elt att=""/><elt att="A&E">&ent3;</elt></doc>')
{ skip( 1, "option do_not_escape_amp_in_atts not available (it's only available in an old version of expat), no worries"); }
else
{ is( $with_dneaia => $text, "entities in atts with do_not_escape_amp_in_atts"); }
# checking that all goes back to normal
XML::Twig::Elt::init_global_state();
$regular=XML::Twig->new()->parse( $doc)->root->sprint;
is( $regular => $expected, "entities in atts, no option");
}
# bug on xmlns in path expression trigger
{ my $matched=0;
my $twig = XML::Twig->new( map_xmlns => { uri1 => 'aaa', },
twig_handlers => { '/aaa:doc/aaa:elt' => sub { $matched=1; } }
)
->parse( q{<xxx:doc xmlns:xxx="uri1"><xxx:elt/></xxx:doc>});
ok( $matched, "using name spaces in path expression trigger");
$matched=0;
$twig = XML::Twig->new( map_xmlns => { uri1 => 'aaa', },
twig_handlers => { 'aaa:doc/aaa:elt' => sub { $matched=1; } }
)
->parse( q{<xxx:doc xmlns:xxx="uri1"><xxx:elt/></xxx:doc>});
ok( $matched, "using name spaces in partial path expression trigger");
}
# bug where the leading spaces are discarded in an element like <p> <b>foo</b>bar</p>
{ # check that leading spaces after a \n are discarded
my $doc= "<p>\n <b>foo</b>\n</p>";
my $expected= "<p><b>foo</b></p>";
my $result= XML::Twig->new->parse( $doc)->sprint;
is( $result => $expected, 'leading spaces kept when not after a \n');
}
{
# check that leading spaces NOT after a \n are kept around
my $doc= "<p> <b>foo</b>bar</p>";
my $result= XML::Twig->new->parse( $doc)->sprint;
is( $result => $doc, 'leading spaces kept when not after a \n');
}
{
my $t= XML::Twig->new->parse( "<doc><elt> elt 1 </elt> <elt> elt 2 </elt></doc>");
is( scalar $t->descendants( '#PCDATA'), 3, 'properly parsed pcdata');
}
{
my $t= XML::Twig->new->parse( "<doc>\n <elt> elt 1 </elt>\n <elt> elt 2 </elt>\n</doc>");
is( scalar $t->descendants( '#PCDATA'), 2, 'properly parsed pcdata');
}
{ # bug RT 8137
my $doc= q{<doc att="val"/>};
(my $expected= $doc)=~ s{ }{ };
is( XML::Twig->new( keep_encoding => 1)->parse( $doc)->sprint, $expected,
'keep_encoding and 2 spaces between gi and attribute'
);
}
{ # copy of an element with extra_data_before_end_tag
my $doc= '<doc>data<?pi here?>more</doc>';
my $expected= '<doc>data<?pi here?>more</doc>'; # pi's are not being moved around anymore
my $elt= XML::Twig->new( pi => 'keep')->parse( $doc)->root->copy;
is( $elt->sprint, $expected, 'copy of an element with extra_data_before_end_tag');
}
{ # copy of an element with extra_data_before_end_tag
my $doc= '<doc><?pi here?></doc>';
my $elt= XML::Twig->new( pi => 'keep')->parse( $doc)->root->copy;
is( $elt->sprint, $doc, 'copy of an element with extra_data_before_end_tag');
}
|
