/[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.3 by wakaba, Tue May 1 07:46:42 2007 UTC revision 1.23 by wakaba, Mon Mar 3 11:56:18 2008 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2  use strict;  use strict;
3    
4    my $DEBUG = $ENV{DEBUG};
5    
6  my $dir_name;  my $dir_name;
7  my $test_dir_name;  my $test_dir_name;
8  BEGIN {  BEGIN {
# Line 20  BEGIN { Line 22  BEGIN {
22  }  }
23    
24  use Test;  use Test;
25  BEGIN { plan tests => 410 }  BEGIN { plan tests => 980 }
26    
27  use Data::Dumper;  use Data::Dumper;
28  $Data::Dumper::Useqq = 1;  $Data::Dumper::Useqq = 1;
# Line 30  sub Data::Dumper::qquote { Line 32  sub Data::Dumper::qquote {
32    return q<qq'> . $s . q<'>;    return q<qq'> . $s . q<'>;
33  } # Data::Dumper::qquote  } # Data::Dumper::qquote
34    
35    
36    if ($DEBUG) {
37      my $not_found = {%$Whatpm::HTML::Debug::cp};
38      $Whatpm::HTML::Debug::cp_pass = sub {
39        my $id = shift;
40        delete $not_found->{$id};
41      };
42    
43      END {
44        for my $id (sort {$a <=> $b || $a cmp $b} keys %$not_found) {
45          print "# checkpoint $id is not reached\n";
46        }
47      }
48    }
49    
50  for my $file_name (grep {$_} split /\s+/, qq[  for my $file_name (grep {$_} split /\s+/, qq[
51                          ${test_dir_name}tokenizer-test-2.dat
52                        ${dir_name}tests1.dat                        ${dir_name}tests1.dat
53                        ${dir_name}tests2.dat                        ${dir_name}tests2.dat
54                        ${dir_name}tests3.dat                        ${dir_name}tests3.dat
55                        ${dir_name}tests4.dat                        ${dir_name}tests4.dat
56                          ${dir_name}tests5.dat
57                          ${dir_name}tests6.dat
58                        ${test_dir_name}tree-test-1.dat                        ${test_dir_name}tree-test-1.dat
59                          ${test_dir_name}tree-test-2.dat
60                       ]) {                       ]) {
61    open my $file, '<', $file_name    open my $file, '<', $file_name
62      or die "$0: $file_name: $!";      or die "$0: $file_name: $!";
63      print "# $file_name\n";
64    
65    my $test;    my $test;
66    my $mode = 'data';    my $mode = 'data';
67      my $escaped;
68    while (<$file>) {    while (<$file>) {
69      s/\x0D\x0A/\x0A/;      s/\x0D\x0A/\x0A/;
70      if (/^#data$/) {      if (/^#data$/) {
71        undef $test;        undef $test;
72        $test->{data} = '';        $test->{data} = '';
73        $mode = 'data';        $mode = 'data';
74          undef $escaped;
75        } elsif (/^#data escaped$/) {
76          undef $test;
77          $test->{data} = '';
78          $mode = 'data';
79          $escaped = 1;
80      } elsif (/^#errors$/) {      } elsif (/^#errors$/) {
81        $test->{errors} = [];        $test->{errors} = [];
82        $mode = 'errors';        $mode = 'errors';
83        $test->{data} =~ s/\x0D?\x0A\z//;              $test->{data} =~ s/\x0D?\x0A\z//;      
84          $test->{data} =~ s/\\u([0-9A-Fa-f]{4})/chr hex $1/ge if $escaped;
85          undef $escaped;
86      } elsif (/^#document$/) {      } elsif (/^#document$/) {
87        $test->{document} = '';        $test->{document} = '';
88        $mode = 'document';        $mode = 'document';
89          undef $escaped;
90        } elsif (/^#document escaped$/) {
91          $test->{document} = '';
92          $mode = 'document';
93          $escaped = 1;
94        } elsif (/^#document-fragment$/) {
95          $test->{element} = '';
96          $mode = 'element';
97          undef $escaped;
98        } elsif (/^#document-fragment (\S+)$/) {
99          $test->{document} = '';
100          $mode = 'document';
101          $test->{element} = $1;
102          undef $escaped;
103        } elsif (/^#document-fragment (\S+) escaped$/) {
104          $test->{document} = '';
105          $mode = 'document';
106          $test->{element} = $1;
107          $escaped = 1;
108      } elsif (defined $test->{document} and /^$/) {      } elsif (defined $test->{document} and /^$/) {
109          $test->{document} =~ s/\\u([0-9A-Fa-f]{4})/chr hex $1/ge if $escaped;
110        test ($test);        test ($test);
111        undef $test;        undef $test;
112      } else {      } else {
113        if ($mode eq 'data' or $mode eq 'document') {        if ($mode eq 'data' or $mode eq 'document') {
114          $test->{$mode} .= $_;          $test->{$mode} .= $_;
115          } elsif ($mode eq 'element') {
116            tr/\x0D\x0A//d;
117            $test->{$mode} .= $_;
118        } elsif ($mode eq 'errors') {        } elsif ($mode eq 'errors') {
119          tr/\x0D\x0A//d;          tr/\x0D\x0A//d;
120          push @{$test->{errors}}, $_;          push @{$test->{errors}}, $_;
# Line 70  for my $file_name (grep {$_} split /\s+/ Line 124  for my $file_name (grep {$_} split /\s+/
124    test ($test) if $test->{errors};    test ($test) if $test->{errors};
125  }  }
126    
127  use What::HTML;  use Whatpm::HTML;
128  use What::NanoDOM;  use Whatpm::NanoDOM;
129    
130  sub test ($) {  sub test ($) {
131    my $test = shift;    my $test = shift;
132    
133    my $doc = What::NanoDOM::Document->new;    my $doc = Whatpm::NanoDOM::Document->new;
134    my @errors;    my @errors;
135        
136    $SIG{INT} = sub {    $SIG{INT} = sub {
# Line 84  sub test ($) { Line 138  sub test ($) {
138      exit;      exit;
139    };    };
140    
141    What::HTML->parse_string    my $onerror = sub {
142        ($test->{data} => $doc, sub {      my %opt = @_;
143           my $msg = shift;      push @errors, join ':', $opt{line}, $opt{column}, $opt{type};
144           push @errors, $msg;    };
145         });    my $result;
146      unless (defined $test->{element}) {
147        Whatpm::HTML->parse_string ($test->{data} => $doc, $onerror);
148        $result = serialize ($doc);
149      } else {
150        my $el = $doc->create_element_ns
151          ('http://www.w3.org/1999/xhtml', [undef, $test->{element}]);
152        Whatpm::HTML->set_inner_html ($el, $test->{data}, $onerror);
153        $result = serialize ($el);
154      }
155        
156    ok scalar @errors, scalar @{$test->{errors}},    ok scalar @errors, scalar @{$test->{errors}},
157      'Parse error: ' . $test->{data} . '; ' .      'Parse error: ' . Data::Dumper::qquote ($test->{data}) . '; ' .
158      join (', ', @errors) . ';' . join (', ', @{$test->{errors}});      join (', ', @errors) . ';' . join (', ', @{$test->{errors}});
159    
160    my $doc_s = serialize ($doc);    ok $result, $test->{document},
161    ok $doc_s, $test->{document}, 'Document tree: ' . $test->{data};        'Document tree: ' . Data::Dumper::qquote ($test->{data});
162  } # test  } # test
163    
164  sub serialize ($) {  sub serialize ($) {
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.23
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24