/[suikacvs]/markup/html/whatpm/t/XML-Parser.t
Suika

Diff of /markup/html/whatpm/t/XML-Parser.t

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by wakaba, Tue Oct 14 09:00:57 2008 UTC revision 1.13 by wakaba, Sun Oct 19 06:14:57 2008 UTC
# Line 74  sub test ($) { Line 74  sub test ($) {
74      #return Whatpm::Charset::UnicodeChecker->new_handle ($_[0], 'html5');      #return Whatpm::Charset::UnicodeChecker->new_handle ($_[0], 'html5');
75    }; # $chk    }; # $chk
76    
77      my $p = Whatpm::XML::Parser->new;
78    my $result;    my $result;
79    unless (defined $test->{element}) {    unless (defined $test->{element}) {
80      Whatpm::XML::Parser->parse_char_string      $p->parse_char_string ($test->{data}->[0] => $doc, $onerror, $chk);
         ($test->{data}->[0] => $doc, $onerror, $chk);  
81      $result = dumptree ($doc);      $result = dumptree ($doc);
82    } else {    } else {
83      ## TODO: ...      ## TODO: ...
# Line 88  sub test ($) { Line 88  sub test ($) {
88    }    }
89        
90    warn "No #errors section ($test->{data}->[0])" unless $test->{errors};    warn "No #errors section ($test->{data}->[0])" unless $test->{errors};
91    
92      @errors = sort {$a cmp $b} @errors;
93      @{$test->{errors}->[0]} = sort {$a cmp $b} @{$test->{errors}->[0] ||= []};
94        
95    ok join ("\n", @errors), join ("\n", @{$test->{errors}->[0] or []}),    ok join ("\n", @errors), join ("\n", @{$test->{errors}->[0] or []}),
96      'Parse error: ' . Data::Dumper::qquote ($test->{data}->[0]) . '; ' .      'Parse error: ' . Data::Dumper::qquote ($test->{data}->[0]);
97      join (', ', @errors) . ';' . join (', ', @{$test->{errors}->[0] or []});  
98      if ($test->{'xml-version'}) {
99        ok $doc->xml_version, $test->{'xml-version'}->[0],
100            'XML version: ' . Data::Dumper::qquote ($test->{data}->[0]);
101      }
102    
103      if ($test->{'xml-encoding'}) {
104        if ($test->{'xml-encoding'}->[1]->[0] eq 'null') {
105          ok $doc->xml_encoding, undef,
106            'XML encoding: ' . Data::Dumper::qquote ($test->{data}->[0]);
107        } else {
108          ok $doc->xml_encoding, $test->{'xml-encoding'}->[0],
109              'XML encoding: ' . Data::Dumper::qquote ($test->{data}->[0]);
110        }
111      }
112    
113      if ($test->{'xml-standalone'}) {
114        ok $doc->xml_standalone ? 1 : 0,
115            $test->{'xml-standalone'}->[1]->[0] eq 'true' ? 1 : 0,
116            'XML standalone: ' . Data::Dumper::qquote ($test->{data}->[0]);
117      }
118    
119      if ($test->{entities}) {
120        my @e;
121        for (keys %{$p->{ge}}) {
122          my $ent = $p->{ge}->{$_};
123          my $v = '<!ENTITY ' . $ent->{name} . ' "';
124          $v .= $ent->{text} if defined $ent->{text};
125          $v .= '" "';
126          $v .= $ent->{pubid} if defined $ent->{pubid};
127          $v .= '" "';
128          $v .= $ent->{sysid} if defined $ent->{sysid};
129          $v .= '" ';
130          $v .= $ent->{notation} if defined $ent->{notation};
131          $v .= '>';
132          push @e, $v;
133        }
134        for (keys %{$p->{pe}}) {
135          my $ent = $p->{pe}->{$_};
136          my $v = '<!ENTITY % ' . $ent->{name} . ' "';
137          $v .= $ent->{text} if defined $ent->{text};
138          $v .= '" "';
139          $v .= $ent->{pubid} if defined $ent->{pubid};
140          $v .= '" "';
141          $v .= $ent->{sysid} if defined $ent->{sysid};
142          $v .= '" ';
143          $v .= $ent->{notation} if defined $ent->{notation};
144          $v .= '>';
145          push @e, $v;
146        }
147        ok join ("\x0A", @e), $test->{entities}->[0],
148            'Entities: ' . Data::Dumper::qquote ($test->{data}->[0]);
149      }
150        
151    $test->{document}->[0] .= "\x0A" if length $test->{document}->[0];    $test->{document}->[0] .= "\x0A" if length $test->{document}->[0];
152    ok $result, $test->{document}->[0],    ok $result, $test->{document}->[0],
# Line 99  sub test ($) { Line 154  sub test ($) {
154  } # test  } # test
155    
156  my @FILES = grep {$_} split /\s+/, qq[  my @FILES = grep {$_} split /\s+/, qq[
157                        ${test_dir_name}tree-1.dat    ${test_dir_name}elements-1.dat
158                       ];    ${test_dir_name}attrs-1.dat
159      ${test_dir_name}texts-1.dat
160      ${test_dir_name}cdata-1.dat
161      ${test_dir_name}charref-1.dat
162      ${test_dir_name}comments-2.dat
163      ${test_dir_name}pis-1.dat
164      ${test_dir_name}pis-2.dat
165      ${test_dir_name}xmldecls-1.dat
166      ${test_dir_name}tree-1.dat
167      ${test_dir_name}ns-elements-1.dat
168      ${test_dir_name}ns-attrs-1.dat
169      ${test_dir_name}doctypes-1.dat
170      ${test_dir_name}doctypes-2.dat
171      ${test_dir_name}attlists-1.dat
172      ${test_dir_name}notations-1.dat
173      ${test_dir_name}entities-1.dat
174      ${test_dir_name}entities-2.dat
175    ];
176    
177  require 't/testfiles.pl';  require 't/testfiles.pl';
178  execute_test ($_, {  execute_test ($_, {
179    errors => {is_list => 1},    errors => {is_list => 1},
180    document => {is_prefixed => 1},    document => {is_prefixed => 1},
181    'document-fragment' => {is_prefixed => 1},    'document-fragment' => {is_prefixed => 1},
182      entities => {is_prefixed => 1},
183  }, \&test) for @FILES;  }, \&test) for @FILES;
184    
185  ## License: Public Domain.  ## License: Public Domain.
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.13
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24