/[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.13 by wakaba, Sat Jun 23 06:38:12 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
44      or die "$0: $file_name: $!";      or die "$0: $file_name: $!";
45      print "# $file_name\n";
46    
47    my $test;    my $test;
48    my $mode = 'data';    my $mode = 'data';
49      my $escaped;
50    while (<$file>) {    while (<$file>) {
51      s/\x0D\x0A/\x0A/;      s/\x0D\x0A/\x0A/;
52      if (/^#data$/) {      if (/^#data$/) {
53        undef $test;        undef $test;
54        $test->{data} = '';        $test->{data} = '';
55        $mode = 'data';        $mode = 'data';
56          undef $escaped;
57        } elsif (/^#data escaped$/) {
58          undef $test;
59          $test->{data} = '';
60          $mode = 'data';
61          $escaped = 1;
62      } elsif (/^#errors$/) {      } elsif (/^#errors$/) {
63        $test->{errors} = [];        $test->{errors} = [];
64        $mode = 'errors';        $mode = 'errors';
65        $test->{data} =~ s/\x0D?\x0A\z//;              $test->{data} =~ s/\x0D?\x0A\z//;      
66          $test->{data} =~ s/\\u([0-9A-Fa-f]{4})/chr hex $1/ge if $escaped;
67          undef $escaped;
68      } elsif (/^#document$/) {      } elsif (/^#document$/) {
69        $test->{document} = '';        $test->{document} = '';
70        $mode = 'document';        $mode = 'document';
71          undef $escaped;
72        } elsif (/^#document escaped$/) {
73          $test->{document} = '';
74          $mode = 'document';
75          $escaped = 1;
76        } elsif (/^#document-fragment (\S+)$/) {
77          $test->{document} = '';
78          $mode = 'document';
79          $test->{element} = $1;
80          undef $escaped;
81        } elsif (/^#document-fragment (\S+) escaped$/) {
82          $test->{document} = '';
83          $mode = 'document';
84          $test->{element} = $1;
85          $escaped = 1;
86      } elsif (defined $test->{document} and /^$/) {      } elsif (defined $test->{document} and /^$/) {
87          $test->{document} =~ s/\\u([0-9A-Fa-f]{4})/chr hex $1/ge if $escaped;
88        test ($test);        test ($test);
89        undef $test;        undef $test;
90      } else {      } else {
# Line 70  for my $file_name (grep {$_} split /\s+/ Line 99  for my $file_name (grep {$_} split /\s+/
99    test ($test) if $test->{errors};    test ($test) if $test->{errors};
100  }  }
101    
102  use What::HTML;  use Whatpm::HTML;
103    use Whatpm::NanoDOM;
104    
105  sub test ($) {  sub test ($) {
106    my $test = shift;    my $test = shift;
107    
108    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  
     }  
   };  
     
109    my @errors;    my @errors;
   $p->{parse_error} = sub {  
     my $msg = shift;  
     push @errors, $msg;  
   };  
110        
111    $SIG{INT} = sub {    $SIG{INT} = sub {
112      print scalar serialize ($p->{document});      print scalar serialize ($doc);
113      exit;      exit;
114    };    };
     
   $p->_initialize_tokenizer;  
   $p->_initialize_tree_constructor;  
   $p->_construct_tree;  
   $p->_terminate_tree_constructor;  
115    
116      my $onerror = sub {
117        my %opt = @_;
118        push @errors, join ':', $opt{line}, $opt{column}, $opt{type};
119      };
120      my $result;
121      unless (defined $test->{element}) {
122        Whatpm::HTML->parse_string ($test->{data} => $doc, $onerror);
123        $result = serialize ($doc);
124      } else {
125        my $el = $doc->create_element_ns
126          ('http://www.w3.org/1999/xhtml', [undef, $test->{element}]);
127        Whatpm::HTML->set_inner_html ($el, $test->{data}, $onerror);
128        $result = serialize ($el);
129      }
130        
131    ok scalar @errors, scalar @{$test->{errors}},    ok scalar @errors, scalar @{$test->{errors}},
132      'Parse error: ' . $test->{data} . '; ' .      'Parse error: ' . $test->{data} . '; ' .
133      join (', ', @errors) . ';' . join (', ', @{$test->{errors}});      join (', ', @errors) . ';' . join (', ', @{$test->{errors}});
134    
135    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};  
136  } # test  } # test
137    
138  sub serialize ($) {  sub serialize ($) {
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.13
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24