/[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.36 by wakaba, Sat Oct 4 11:32:16 2008 UTC revision 1.43 by wakaba, Tue Oct 14 07:49:55 2008 UTC
# Line 4  use strict; Line 4  use strict;
4  my $DEBUG = $ENV{DEBUG};  my $DEBUG = $ENV{DEBUG};
5    
6  use lib qw[/home/wakaba/work/manakai2/lib];  use lib qw[/home/wakaba/work/manakai2/lib];
7    my $test_dir_name = 't/';
8  my $dir_name;  my $dir_name = 't/tree-construction/';
 my $test_dir_name;  
 BEGIN {  
   $test_dir_name = 't/';  
   $dir_name = 't/tree-construction/';  
   my $skip = "You don't have make command";  
   eval q{  
          system ("cd $test_dir_name; make tree-construction-files") == 0 or die  
            unless -f $dir_name.'tests1.dat';  
          $skip = '';  
         };  
   if ($skip) {  
     print "1..1\n";  
     print "ok 1 # $skip\n";  
     exit;  
   }  
 }  
9    
10  use Test;  use Test;
11  BEGIN { plan tests => 3105 }  BEGIN { plan tests => 4935 }
12    
13  use Data::Dumper;  use Data::Dumper;
14  $Data::Dumper::Useqq = 1;  $Data::Dumper::Useqq = 1;
# Line 34  sub Data::Dumper::qquote { Line 18  sub Data::Dumper::qquote {
18    return q<qq'> . $s . q<'>;    return q<qq'> . $s . q<'>;
19  } # Data::Dumper::qquote  } # Data::Dumper::qquote
20    
   
21  if ($DEBUG) {  if ($DEBUG) {
22    my $not_found = {%{$Whatpm::HTML::Debug::cp or {}}};    my $not_found = {%{$Whatpm::HTML::Debug::cp or {}}};
23    $Whatpm::HTML::Debug::cp_pass = sub {    $Whatpm::HTML::Debug::cp_pass = sub {
# Line 49  if ($DEBUG) { Line 32  if ($DEBUG) {
32    }    }
33  }  }
34    
35  for my $file_name (grep {$_} split /\s+/, qq[  my @FILES = grep {$_} split /\s+/, qq[
36                        ${test_dir_name}tokenizer-test-2.dat                        ${test_dir_name}tokenizer-test-2.dat
37                        ${test_dir_name}tokenizer-test-3.dat                        ${test_dir_name}tokenizer-test-3.dat
38                        ${dir_name}tests1.dat                        ${dir_name}tests1.dat
# Line 59  for my $file_name (grep {$_} split /\s+/ Line 42  for my $file_name (grep {$_} split /\s+/
42                        ${dir_name}tests5.dat                        ${dir_name}tests5.dat
43                        ${dir_name}tests6.dat                        ${dir_name}tests6.dat
44                        ${dir_name}tests7.dat                        ${dir_name}tests7.dat
45                          ${dir_name}tests8.dat
46                          ${dir_name}tests9.dat
47                          ${dir_name}tests10.dat
48                          ${dir_name}tests11.dat
49                          ${dir_name}tests12.dat
50                        ${test_dir_name}tree-test-1.dat                        ${test_dir_name}tree-test-1.dat
51                        ${test_dir_name}tree-test-2.dat                        ${test_dir_name}tree-test-2.dat
52                        ${test_dir_name}tree-test-3.dat                        ${test_dir_name}tree-test-3.dat
53                        ${test_dir_name}tree-test-void.dat                        ${test_dir_name}tree-test-void.dat
54                        ${test_dir_name}tree-test-flow.dat                        ${test_dir_name}tree-test-flow.dat
55                        ${test_dir_name}tree-test-phrasing.dat                        ${test_dir_name}tree-test-phrasing.dat
56                          ${test_dir_name}tree-test-form.dat
57                        ${test_dir_name}tree-test-foreign.dat                        ${test_dir_name}tree-test-foreign.dat
58                       ]) {                       ];
59    open my $file, '<', $file_name  
60      or die "$0: $file_name: $!";  require 't/testfiles.pl';
61    print "# $file_name\n";  execute_test ($_, {
62      errors => {is_list => 1},
63    my $test;    shoulds => {is_list => 1},
64    my $mode = 'data';    document => {is_prefixed => 1},
65    my $escaped;    'document-fragment' => {is_prefixed => 1},
66    while (<$file>) {  }, \&test) for @FILES;
     s/\x0D\x0A/\x0A/;  
     if (/^#data$/) {  
       undef $test;  
       $test->{data} = '';  
       $mode = 'data';  
       undef $escaped;  
     } elsif (/^#data escaped$/) {  
       undef $test;  
       $test->{data} = '';  
       $mode = 'data';  
       $escaped = 1;  
     } elsif (/^#errors$/) {  
       $test->{errors} = [];  
       $mode = 'errors';  
       $test->{data} =~ s/\x0D?\x0A\z//;        
       $test->{data} =~ s/\\u([0-9A-Fa-f]{4})/chr hex $1/ge if $escaped;  
       $test->{data} =~ s/\\U([0-9A-Fa-f]{8})/chr hex $1/ge if $escaped;  
       undef $escaped;  
     } elsif (/^#shoulds$/) {  
       $test->{shoulds} = [];  
       $mode = 'shoulds';  
     } elsif (/^#document$/) {  
       $test->{document} = '';  
       $mode = 'document';  
       undef $escaped;  
     } elsif (/^#document escaped$/) {  
       $test->{document} = '';  
       $mode = 'document';  
       $escaped = 1;  
     } elsif (/^#document-fragment$/) {  
       $test->{element} = '';  
       $mode = 'element';  
       undef $escaped;  
     } elsif (/^#document-fragment (\S+)$/) {  
       $test->{document} = '';  
       $mode = 'document';  
       $test->{element} = $1;  
       undef $escaped;  
     } elsif (/^#document-fragment (\S+) escaped$/) {  
       $test->{document} = '';  
       $mode = 'document';  
       $test->{element} = $1;  
       $escaped = 1;  
     } elsif (defined $test->{document} and /^$/) {  
       $test->{document} =~ s/\\u([0-9A-Fa-f]{4})/chr hex $1/ge if $escaped;  
       $test->{document} =~ s/\\U([0-9A-Fa-f]{8})/chr hex $1/ge if $escaped;  
       test ($test);  
       undef $test;  
     } else {  
       if ($mode eq 'data' or $mode eq 'document') {  
         $test->{$mode} .= $_;  
       } elsif ($mode eq 'element') {  
         tr/\x0D\x0A//d;  
         $test->{$mode} .= $_;  
       } elsif ($mode eq 'errors') {  
         tr/\x0D\x0A//d;  
         push @{$test->{errors}}, $_;  
       } elsif ($mode eq 'shoulds') {  
         tr/\x0D\x0A//d;  
         push @{$test->{shoulds}}, $_;  
       }  
     }  
   }  
   test ($test) if $test->{errors};  
 }  
67    
68  use Whatpm::HTML;  use Whatpm::HTML;
69  use Whatpm::NanoDOM;  use Whatpm::NanoDOM;
70  use Whatpm::Charset::UnicodeChecker;  use Whatpm::Charset::UnicodeChecker;
71    use Whatpm::HTML::Dumper qw/dumptree/;
72    
73  sub test ($) {  sub test ($) {
74    my $test = shift;    my $test = shift;
75    
76      if ($test->{'document-fragment'}) {
77        if (@{$test->{'document-fragment'}->[1]}) {
78          ## NOTE: Old format.
79          $test->{element} = $test->{'document-fragment'}->[1]->[0];
80          $test->{document} ||= $test->{'document-fragment'};
81        } else {
82          ## NOTE: New format.
83          $test->{element} = $test->{'document-fragment'}->[0];
84        }
85      }
86    
87    my $doc = Whatpm::NanoDOM::Document->new;    my $doc = Whatpm::NanoDOM::Document->new;
88    my @errors;    my @errors;
89    my @shoulds;    my @shoulds;
90        
91    $SIG{INT} = sub {    $SIG{INT} = sub {
92      print scalar serialize ($doc);      print scalar dumptree ($doc);
93      exit;      exit;
94    };    };
95    
# Line 172  sub test ($) { Line 108  sub test ($) {
108    
109    my $result;    my $result;
110    unless (defined $test->{element}) {    unless (defined $test->{element}) {
111      Whatpm::HTML->parse_char_string ($test->{data} => $doc, $onerror, $chk);      Whatpm::HTML->parse_char_string
112      $result = serialize ($doc);          ($test->{data}->[0] => $doc, $onerror, $chk);
113        $result = dumptree ($doc);
114    } else {    } else {
115      my $el = $doc->create_element_ns      my $el = $doc->create_element_ns
116        ('http://www.w3.org/1999/xhtml', [undef, $test->{element}]);        ('http://www.w3.org/1999/xhtml', [undef, $test->{element}]);
117      Whatpm::HTML->set_inner_html ($el, $test->{data}, $onerror, $chk);      Whatpm::HTML->set_inner_html ($el, $test->{data}->[0], $onerror, $chk);
118      $result = serialize ($el);      $result = dumptree ($el);
119    }    }
120      
121      warn "No #errors section ($test->{data}->[0])" unless $test->{errors};
122            
123    ok scalar @errors, scalar @{$test->{errors}},    ok scalar @errors, scalar @{$test->{errors}->[0] or []},
124      'Parse error: ' . Data::Dumper::qquote ($test->{data}) . '; ' .      'Parse error: ' . Data::Dumper::qquote ($test->{data}->[0]) . '; ' .
125      join (', ', @errors) . ';' . join (', ', @{$test->{errors}});      join (', ', @errors) . ';' . join (', ', @{$test->{errors}->[0] or []});
126    ok scalar @shoulds, scalar @{$test->{shoulds} or []},    ok scalar @shoulds, scalar @{$test->{shoulds}->[0] or []},
127      'SHOULD-level error: ' . Data::Dumper::qquote ($test->{data}) . '; ' .      'SHOULD-level error: ' . Data::Dumper::qquote ($test->{data}->[0]) . '; ' .
128      join (', ', @shoulds) . ';' . join (', ', @{$test->{shoulds} or []});      join (', ', @shoulds) . ';' . join (', ', @{$test->{shoulds}->[0] or []});
129    
130    ok $result, $test->{document},    $test->{document}->[0] .= "\x0A" if length $test->{document}->[0];
131        'Document tree: ' . Data::Dumper::qquote ($test->{data});    ok $result, $test->{document}->[0],
132          'Document tree: ' . Data::Dumper::qquote ($test->{data}->[0]);
133  } # test  } # test
134    
 sub serialize ($) {  
   my $node = shift;  
   my $r = '';  
   
   my @node = map { [$_, ''] } @{$node->child_nodes};  
   while (@node) {  
     my $child = shift @node;  
     my $nt = $child->[0]->node_type;  
     if ($nt == $child->[0]->ELEMENT_NODE) {  
       $r .= '| ' . $child->[1] . '<' . $child->[0]->tag_name . ">\x0A"; ## ISSUE: case?  
   
       for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->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;  
       $r .= ' PUBLIC "' . $pubid . '"' if length $pubid;  
       my $sysid = $child->[0]->system_id;  
       $r .= ' SYSTEM' if not length $pubid and length $sysid;  
       $r .= ' "' . $sysid . '"' if length $sysid;  
       $r .= ">\x0A";  
     } else {  
       $r .= '| ' . $child->[1] . $child->[0]->node_type . "\x0A"; # error  
     }  
   }  
     
   return $r;  
 } # serialize  
   
135  ## License: Public Domain.  ## License: Public Domain.
136  ## $Date$  ## $Date$
Legend:
Removed from v.1.36  
changed lines
  Added in v.1.43
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24