# ---------------------------------------------------------------- # this test script is written in utf8 but does not "use utf8" for 5.005-compatibility # ---------------------------------------------------------------- use strict; use Test::More; # ---------------------------------------------------------------- { plan tests => 33; use_ok('XML::TreePP'); &test_main(); } # ---------------------------------------------------------------- sub test_main { my $src = {}; $src->{Plain} = <<"EOT"; AA zz ©© ëë んん 漢漢 EOT $src->{XMLref} = <<"EOT"; AA zz ©© ëë んん 漢漢 EOT $src->{Mixed} = <<"EOT"; AA zz ©© ëë んん 漢漢 EOT foreach my $key ( keys %$src ) { phase2( "$key octets", $src->{$key} ); } } # ---------------------------------------------------------------- sub phase2 { my $subject = shift; my $srcxml = shift; my $srcref = ( $srcxml =~ /&#\w+;/ ); foreach my $xml_deref ( 0, 1 ) { my $subj3 = $subject .( $xml_deref ? ' xml_deref' : '' ); my $opt = { xml_deref => $xml_deref, }; my $tpp = XML::TreePP->new( %$opt ); my $tree = $tpp->parse( $srcxml ); if ( $xml_deref ) { check_octets( $subj3, $tree ); } else { if ( $srcref ) { check_has_ref( $subj3, $tree ); } else { check_no_ref( $subj3, $tree ); } } } } # ---------------------------------------------------------------- sub check_has_ref { my $subject = shift; my $tree = shift; my $root = $tree->{root}; my $HAS_REF = qr/&#\w+;/; # \x00-\x7F is always dereferenced. # like( $root->{a}, $HAS_REF, "$subject has_ref: a" ); # like( $root->{z}, $HAS_REF, "$subject has_ref: z" ); like( $root->{c}, $HAS_REF, "$subject has_ref: c" ); like( $root->{e}, $HAS_REF, "$subject has_ref: e" ); like( $root->{n}, $HAS_REF, "$subject has_ref: n" ); like( $root->{k}, $HAS_REF, "$subject has_ref: k" ); } # ---------------------------------------------------------------- sub check_no_ref { my $subject = shift; my $tree = shift; my $root = $tree->{root}; my $HAS_REF = qr/&#\w+;/; unlike( $root->{a}, $HAS_REF, "$subject no_ref: a" ); unlike( $root->{z}, $HAS_REF, "$subject no_ref: z" ); unlike( $root->{c}, $HAS_REF, "$subject no_ref: c" ); unlike( $root->{e}, $HAS_REF, "$subject no_ref: e" ); unlike( $root->{n}, $HAS_REF, "$subject no_ref: n" ); unlike( $root->{k}, $HAS_REF, "$subject no_ref: k" ); } # ---------------------------------------------------------------- sub check_octets { my $subject = shift; my $tree = shift; my $root = $tree->{root}; is( $root->{a}, 'AA', "$subject ok: a" ); is( $root->{z}, 'zz', "$subject ok: z" ); is( $root->{c}, '©©', "$subject ok: c" ); is( $root->{e}, 'ëë', "$subject ok: e" ); is( $root->{n}, 'んん', "$subject ok: n" ); is( $root->{k}, '漢漢', "$subject ok: k" ); } # ---------------------------------------------------------------- ;1; # ----------------------------------------------------------------