/[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.2 by wakaba, Tue May 1 06:22:12 2007 UTC revision 1.12 by wakaba, Sat Jun 23 03:53:35 2007 UTC
# Line 20  BEGIN { Line 20  BEGIN {
20  }  }
21    
22  use Test;  use Test;
23  BEGIN { plan tests => 402 }  BEGIN { plan tests => 472 }
24    
25  use Data::Dumper;  use Data::Dumper;
26  $Data::Dumper::Useqq = 1;  $Data::Dumper::Useqq = 1;
# Line 31  sub Data::Dumper::qquote { Line 31  sub Data::Dumper::qquote {
31  } # Data::Dumper::qquote  } # Data::Dumper::qquote
32    
33  for my $file_name (grep {$_} split /\s+/, qq[  for my $file_name (grep {$_} split /\s+/, qq[
34                          ${test_dir_name}tokenizer-test-2.dat
35                        ${dir_name}tests1.dat                        ${dir_name}tests1.dat
36                        ${dir_name}tests2.dat                        ${dir_name}tests2.dat
37                        ${dir_name}tests3.dat                        ${dir_name}tests3.dat
38                        ${dir_name}tests4.dat                        ${dir_name}tests4.dat
39                          ${dir_name}tests5.dat
40                          ${dir_name}tests6.dat
41                        ${test_dir_name}tree-test-1.dat                        ${test_dir_name}tree-test-1.dat
42                       ]) {                       ]) {
43    open my $file, '<', $file_name    open my $file, '<', $file_name
# Line 42  for my $file_name (grep {$_} split /\s+/ Line 45  for my $file_name (grep {$_} split /\s+/
45    
46    my $test;    my $test;
47    my $mode = 'data';    my $mode = 'data';
48      my $escaped;
49    while (<$file>) {    while (<$file>) {
50      s/\x0D\x0A/\x0A/;      s/\x0D\x0A/\x0A/;
51      if (/^#data$/) {      if (/^#data$/) {
52        undef $test;        undef $test;
53        $test->{data} = '';        $test->{data} = '';
54        $mode = 'data';        $mode = 'data';
55          undef $escaped;
56        } elsif (/^#data escaped$/) {
57          undef $test;
58          $test->{data} = '';
59          $mode = 'data';
60          $escaped = 1;
61      } elsif (/^#errors$/) {      } elsif (/^#errors$/) {
62        $test->{errors} = [];        $test->{errors} = [];
63        $mode = 'errors';        $mode = 'errors';
64          undef $escaped;
65        $test->{data} =~ s/\x0D?\x0A\z//;              $test->{data} =~ s/\x0D?\x0A\z//;      
66      } elsif (/^#document$/) {      } elsif (/^#document$/) {
67        $test->{document} = '';        $test->{document} = '';
68        $mode = 'document';        $mode = 'document';
69          undef $escaped;
70        } elsif (/^#document escaped$/) {
71          $test->{document} = '';
72          $mode = 'document';
73          $escaped = 1;
74        } elsif (/^#document-fragment (\S+)$/) {
75          $test->{document} = '';
76          $mode = 'document';
77          $test->{element} = $1;
78          undef $escaped;
79        } elsif (/^#document-fragment (\S+) escaped$/) {
80          $test->{document} = '';
81          $mode = 'document';
82          $test->{element} = $1;
83          $escaped = 1;
84      } elsif (defined $test->{document} and /^$/) {      } elsif (defined $test->{document} and /^$/) {
85        test ($test);        test ($test);
86        undef $test;        undef $test;
87      } else {      } else {
88        if ($mode eq 'data' or $mode eq 'document') {        if ($mode eq 'data' or $mode eq 'document') {
89          $test->{$mode} .= $_;          my $s = $_;
90            $s =~ s/\\u([0-9A-Fa-f]{4})/chr hex $1/ge if $escaped;
91            $test->{$mode} .= $s;
92        } elsif ($mode eq 'errors') {        } elsif ($mode eq 'errors') {
93          tr/\x0D\x0A//d;          tr/\x0D\x0A//d;
94          push @{$test->{errors}}, $_;          push @{$test->{errors}}, $_;
# Line 70  for my $file_name (grep {$_} split /\s+/ Line 98  for my $file_name (grep {$_} split /\s+/
98    test ($test) if $test->{errors};    test ($test) if $test->{errors};
99  }  }
100    
101  use What::HTML;  use Whatpm::HTML;
102    use Whatpm::NanoDOM;
103    
104  sub test ($) {  sub test ($) {
105    my $test = shift;    my $test = shift;
106    
107    my $s = $test->{data};    my $doc = Whatpm::NanoDOM::Document->new;
   
   my $p = What::HTML->new;  
   my $i = 0;  
   $p->{set_next_input_character} = sub {  
     my $self = shift;  
     $self->{next_input_character} = -1 and return if $i >= length $s;  
     $self->{next_input_character} = ord substr $s, $i++, 1;  
       
     if ($self->{next_input_character} == 0x000D) { # CR  
       if ($i >= length $s) {  
         #  
       } else {  
         my $next_char = ord substr $s, $i++, 1;  
         if ($next_char == 0x000A) { # LF  
           #  
         } else {  
           push @{$self->{char}}, $next_char;  
         }  
       }  
       $self->{next_input_character} = 0x000A; # LF # MUST  
     } elsif ($self->{next_input_character} > 0x10FFFF) {  
       $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST  
     } elsif ($self->{next_input_character} == 0x0000) { # NULL  
       $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST  
     }  
   };  
     
108    my @errors;    my @errors;
   $p->{parse_error} = sub {  
     my $msg = shift;  
     push @errors, $msg;  
   };  
109        
110    $SIG{INT} = sub {    $SIG{INT} = sub {
111      print scalar serialize ($p->{document});      print scalar serialize ($doc);
112      exit;      exit;
113    };    };
     
   $p->_initialize_tokenizer;  
   $p->_initialize_tree_constructor;  
   $p->_construct_tree;  
   $p->_terminate_tree_constructor;  
114    
115      my $onerror = sub {
116        my %opt = @_;
117        push @errors, join ':', $opt{line}, $opt{column}, $opt{type};
118      };
119      my $result;
120      unless (defined $test->{element}) {
121        Whatpm::HTML->parse_string ($test->{data} => $doc, $onerror);
122        $result = serialize ($doc);
123      } else {
124        my $el = $doc->create_element_ns
125          ('http://www.w3.org/1999/xhtml', [undef, $test->{element}]);
126        Whatpm::HTML->set_inner_html ($el, $test->{data}, $onerror);
127        $result = serialize ($el);
128      }
129        
130    ok scalar @errors, scalar @{$test->{errors}},    ok scalar @errors, scalar @{$test->{errors}},
131      'Parse error: ' . $test->{data} . '; ' .      'Parse error: ' . $test->{data} . '; ' .
132      join (', ', @errors) . ';' . join (', ', @{$test->{errors}});      join (', ', @errors) . ';' . join (', ', @{$test->{errors}});
133    
134    my $doc = $p->{document};    ok $result, $test->{document}, 'Document tree: ' . $test->{data};
   my $doc_s = serialize ($doc);  
   ok $doc_s, $test->{document}, 'Document tree: ' . $test->{data};  
135  } # test  } # test
136    
137  sub serialize ($) {  sub serialize ($) {
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.12
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24