/[suikacvs]/markup/html/whatpm/t/HTML-tree.t
Suika

Diff of /markup/html/whatpm/t/HTML-tree.t

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

revision 1.41 by wakaba, Tue Oct 14 06:48:05 2008 UTC revision 1.44 by wakaba, Tue Oct 14 09:00:57 2008 UTC
# Line 32  if ($DEBUG) { Line 32  if ($DEBUG) {
32    }    }
33  }  }
34    
 my @FILES = grep {$_} split /\s+/, qq[  
                       ${test_dir_name}tokenizer-test-2.dat  
                       ${test_dir_name}tokenizer-test-3.dat  
                       ${dir_name}tests1.dat  
                       ${dir_name}tests2.dat  
                       ${dir_name}tests3.dat  
                       ${dir_name}tests4.dat  
                       ${dir_name}tests5.dat  
                       ${dir_name}tests6.dat  
                       ${dir_name}tests7.dat  
                       ${dir_name}tests8.dat  
                       ${dir_name}tests9.dat  
                       ${dir_name}tests10.dat  
                       ${dir_name}tests11.dat  
                       ${dir_name}tests12.dat  
                       ${test_dir_name}tree-test-1.dat  
                       ${test_dir_name}tree-test-2.dat  
                       ${test_dir_name}tree-test-3.dat  
                       ${test_dir_name}tree-test-void.dat  
                       ${test_dir_name}tree-test-flow.dat  
                       ${test_dir_name}tree-test-phrasing.dat  
                       ${test_dir_name}tree-test-form.dat  
                       ${test_dir_name}tree-test-foreign.dat  
                      ];  
   
 require 't/testfiles.pl';  
 execute_test ($_, {  
   errors => {is_list => 1},  
   shoulds => {is_list => 1},  
   document => {is_prefixed => 1},  
   'document-fragment' => {is_prefixed => 1},  
 }, \&test) for @FILES;  
   
35  use Whatpm::HTML;  use Whatpm::HTML;
36  use Whatpm::NanoDOM;  use Whatpm::NanoDOM;
37  use Whatpm::Charset::UnicodeChecker;  use Whatpm::Charset::UnicodeChecker;
38    use Whatpm::HTML::Dumper qw/dumptree/;
39    
40  sub test ($) {  sub test ($) {
41    my $test = shift;    my $test = shift;
# Line 88  sub test ($) { Line 56  sub test ($) {
56    my @shoulds;    my @shoulds;
57        
58    $SIG{INT} = sub {    $SIG{INT} = sub {
59      print scalar serialize ($doc);      print scalar dumptree ($doc);
60      exit;      exit;
61    };    };
62    
# Line 109  sub test ($) { Line 77  sub test ($) {
77    unless (defined $test->{element}) {    unless (defined $test->{element}) {
78      Whatpm::HTML->parse_char_string      Whatpm::HTML->parse_char_string
79          ($test->{data}->[0] => $doc, $onerror, $chk);          ($test->{data}->[0] => $doc, $onerror, $chk);
80      $result = serialize ($doc);      $result = dumptree ($doc);
81    } else {    } else {
82      my $el = $doc->create_element_ns      my $el = $doc->create_element_ns
83        ('http://www.w3.org/1999/xhtml', [undef, $test->{element}]);        ('http://www.w3.org/1999/xhtml', [undef, $test->{element}]);
84      Whatpm::HTML->set_inner_html ($el, $test->{data}->[0], $onerror, $chk);      Whatpm::HTML->set_inner_html ($el, $test->{data}->[0], $onerror, $chk);
85      $result = serialize ($el);      $result = dumptree ($el);
86    }    }
87        
88    warn "No #errors section" unless $test->{errors};    warn "No #errors section ($test->{data}->[0])" unless $test->{errors};
89            
90    ok scalar @errors, scalar @{$test->{errors}->[0] or []},    ok scalar @errors, scalar @{$test->{errors}->[0] or []},
91      'Parse error: ' . Data::Dumper::qquote ($test->{data}->[0]) . '; ' .      'Parse error: ' . Data::Dumper::qquote ($test->{data}->[0]) . '; ' .
# Line 131  sub test ($) { Line 99  sub test ($) {
99        'Document tree: ' . Data::Dumper::qquote ($test->{data}->[0]);        'Document tree: ' . Data::Dumper::qquote ($test->{data}->[0]);
100  } # test  } # test
101    
102  ## NOTE: Spec: <http://wiki.whatwg.org/wiki/Parser_tests>.  my @FILES = grep {$_} split /\s+/, qq[
103  sub serialize ($) {                        ${test_dir_name}tokenizer-test-2.dat
104    my $node = shift;                        ${test_dir_name}tokenizer-test-3.dat
105    my $r = '';                        ${dir_name}tests1.dat
106                          ${dir_name}tests2.dat
107    my $ns_id = {                        ${dir_name}tests3.dat
108      q<http://www.w3.org/1999/xhtml> => 'html',                        ${dir_name}tests4.dat
109      q<http://www.w3.org/2000/svg> => 'svg',                        ${dir_name}tests5.dat
110      q<http://www.w3.org/1998/Math/MathML> => 'math',                        ${dir_name}tests6.dat
111      q<http://www.w3.org/1999/xlink> => 'xlink',                        ${dir_name}tests7.dat
112      q<http://www.w3.org/XML/1998/namespace> => 'xml',                        ${dir_name}tests8.dat
113      q<http://www.w3.org/2002/xmlns/> => 'xmlns',                        ${dir_name}tests9.dat
114    };                        ${dir_name}tests10.dat
115                          ${dir_name}tests11.dat
116                          ${dir_name}tests12.dat
117                          ${test_dir_name}tree-test-1.dat
118                          ${test_dir_name}tree-test-2.dat
119                          ${test_dir_name}tree-test-3.dat
120                          ${test_dir_name}tree-test-void.dat
121                          ${test_dir_name}tree-test-flow.dat
122                          ${test_dir_name}tree-test-phrasing.dat
123                          ${test_dir_name}tree-test-form.dat
124                          ${test_dir_name}tree-test-foreign.dat
125                         ];
126    
127    my @node = map { [$_, ''] } @{$node->child_nodes};  require 't/testfiles.pl';
128    while (@node) {  execute_test ($_, {
129      my $child = shift @node;    errors => {is_list => 1},
130      my $nt = $child->[0]->node_type;    shoulds => {is_list => 1},
131      if ($nt == $child->[0]->ELEMENT_NODE) {    document => {is_prefixed => 1},
132        my $ns = $child->[0]->namespace_uri;    'document-fragment' => {is_prefixed => 1},
133        unless (defined $ns) {  }, \&test) for @FILES;
         $ns = '{} ';  
       } elsif ($ns eq q<http://www.w3.org/1999/xhtml>) {  
         $ns = '';  
       } elsif ($ns_id->{$ns}) {  
         $ns = $ns_id->{$ns} . ' ';  
       } else {  
         $ns = '{' . $ns . '} ';  
       }  
       $r .= $child->[1] . '<' . $ns . $child->[0]->manakai_local_name . ">\x0A";  
   
       for my $attr (sort {$a->[0] cmp $b->[0]} map { [do {  
                       my $ns = $_->namespace_uri;  
                       unless (defined $ns) {  
                         $ns = '';  
                       } elsif ($ns_id->{$ns}) {  
                         $ns = $ns_id->{$ns} . ' ';  
                       } else {  
                         $ns = '{' . $ns . '} ';  
                       }  
                       $ns . $_->manakai_local_name;  
                     }, $_->value] }  
                     @{$child->[0]->attributes}) {  
         $r .= $child->[1] . '  ' . $attr->[0] . '="'; ## ISSUE: case?  
         $r .= $attr->[1] . '"' . "\x0A";  
       }  
         
       unshift @node,  
         map { [$_, $child->[1] . '  '] } @{$child->[0]->child_nodes};  
     } elsif ($nt == $child->[0]->TEXT_NODE) {  
       $r .= $child->[1] . '"' . $child->[0]->data . '"' . "\x0A";  
     } elsif ($nt == $child->[0]->COMMENT_NODE) {  
       $r .= $child->[1] . '<!-- ' . $child->[0]->data . " -->\x0A";  
     } elsif ($nt == $child->[0]->DOCUMENT_TYPE_NODE) {  
       $r .= $child->[1] . '<!DOCTYPE ' . $child->[0]->name;  
       my $pubid = $child->[0]->public_id;  
       my $sysid = $child->[0]->system_id;  
       if (length $pubid or length $sysid) {  
         $r .= ' "' . $pubid . '"';  
         $r .= ' "' . $sysid . '"';  
       }  
       $r .= ">\x0A";  
     } else {  
       $r .= $child->[1] . $child->[0]->node_type . "\x0A"; # error  
     }  
   }  
     
   return $r;  
 } # serialize  
134    
135  ## License: Public Domain.  ## License: Public Domain.
136  ## $Date$  ## $Date$
Legend:
Removed from v.1.41  
changed lines
  Added in v.1.44
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24