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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations) (download) (as text)
Tue May 1 07:46:42 2007 UTC (18 years, 2 months ago) by wakaba
Branch: MAIN
Changes since 1.2: +11 -41 lines
File MIME type: application/x-troff
++ whatpm/What/ChangeLog	1 May 2007 07:44:59 -0000
	* HTML.pm.src (parse_string): New method.
	(get_inner_html): Renamed from |inner_html|.

	* Makefile: A rule for |HTML.html| is added.

	* HTML.pod: New documentation.

2007-05-01  Wakaba  <wakaba@suika.fam.cx>

++ whatpm/t/ChangeLog	1 May 2007 07:46:34 -0000
	* HTML-tree.t: Use new |What::HTML->parse_string| method
	so that this test don't have to know parser class's
	internals.

	* tree-test-1.dat: New tests for "(<head> stuffs) in body"
	and "(<head> stuffs) after body" are added.

2007-05-01  Wakaba  <wakaba@suika.fam.cx>

1 wakaba 1.1 #!/usr/bin/perl
2     use strict;
3    
4     my $dir_name;
5 wakaba 1.2 my $test_dir_name;
6 wakaba 1.1 BEGIN {
7 wakaba 1.2 $test_dir_name = 't/';
8 wakaba 1.1 $dir_name = 't/tree-construction/';
9     my $skip = "You don't have make command";
10     eval q{
11     system ("cd $test_dir_name; make tree-construction-files") == 0 or die
12     unless -f $dir_name.'tests1.dat';
13     $skip = '';
14     };
15     if ($skip) {
16     print "1..1\n";
17     print "ok 1 # $skip\n";
18     exit;
19     }
20     }
21    
22     use Test;
23 wakaba 1.3 BEGIN { plan tests => 410 }
24 wakaba 1.1
25     use Data::Dumper;
26     $Data::Dumper::Useqq = 1;
27     sub Data::Dumper::qquote {
28     my $s = shift;
29     $s =~ s/([^\x20\x21-\x26\x28-\x5B\x5D-\x7E])/sprintf '\x{%02X}', ord $1/ge;
30     return q<qq'> . $s . q<'>;
31     } # Data::Dumper::qquote
32    
33 wakaba 1.2 for my $file_name (grep {$_} split /\s+/, qq[
34     ${dir_name}tests1.dat
35     ${dir_name}tests2.dat
36     ${dir_name}tests3.dat
37     ${dir_name}tests4.dat
38     ${test_dir_name}tree-test-1.dat
39 wakaba 1.1 ]) {
40 wakaba 1.2 open my $file, '<', $file_name
41     or die "$0: $file_name: $!";
42 wakaba 1.1
43     my $test;
44     my $mode = 'data';
45     while (<$file>) {
46     s/\x0D\x0A/\x0A/;
47     if (/^#data$/) {
48     undef $test;
49     $test->{data} = '';
50     $mode = 'data';
51     } elsif (/^#errors$/) {
52     $test->{errors} = [];
53     $mode = 'errors';
54     $test->{data} =~ s/\x0D?\x0A\z//;
55     } elsif (/^#document$/) {
56     $test->{document} = '';
57     $mode = 'document';
58 wakaba 1.2 } elsif (defined $test->{document} and /^$/) {
59     test ($test);
60 wakaba 1.1 undef $test;
61     } else {
62     if ($mode eq 'data' or $mode eq 'document') {
63     $test->{$mode} .= $_;
64     } elsif ($mode eq 'errors') {
65     tr/\x0D\x0A//d;
66     push @{$test->{errors}}, $_;
67     }
68     }
69     }
70     test ($test) if $test->{errors};
71     }
72    
73     use What::HTML;
74 wakaba 1.3 use What::NanoDOM;
75 wakaba 1.1
76     sub test ($) {
77     my $test = shift;
78    
79 wakaba 1.3 my $doc = What::NanoDOM::Document->new;
80 wakaba 1.1 my @errors;
81    
82     $SIG{INT} = sub {
83 wakaba 1.3 print scalar serialize ($doc);
84 wakaba 1.1 exit;
85     };
86 wakaba 1.3
87     What::HTML->parse_string
88     ($test->{data} => $doc, sub {
89     my $msg = shift;
90     push @errors, $msg;
91     });
92 wakaba 1.1
93     ok scalar @errors, scalar @{$test->{errors}},
94     'Parse error: ' . $test->{data} . '; ' .
95     join (', ', @errors) . ';' . join (', ', @{$test->{errors}});
96    
97     my $doc_s = serialize ($doc);
98     ok $doc_s, $test->{document}, 'Document tree: ' . $test->{data};
99     } # test
100    
101     sub serialize ($) {
102     my $node = shift;
103     my $r = '';
104    
105     my @node = map { [$_, ''] } @{$node->child_nodes};
106     while (@node) {
107     my $child = shift @node;
108     my $nt = $child->[0]->node_type;
109     if ($nt == $child->[0]->ELEMENT_NODE) {
110     $r .= '| ' . $child->[1] . '<' . $child->[0]->tag_name . ">\x0A"; ## ISSUE: case?
111    
112 wakaba 1.2 for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->name, $_->value] }
113 wakaba 1.1 @{$child->[0]->attributes}) {
114     $r .= '| ' . $child->[1] . ' ' . $attr->[0] . '="'; ## ISSUE: case?
115     $r .= $attr->[1] . '"' . "\x0A";
116     }
117    
118     unshift @node,
119     map { [$_, $child->[1] . ' '] } @{$child->[0]->child_nodes};
120     } elsif ($nt == $child->[0]->TEXT_NODE) {
121     $r .= '| ' . $child->[1] . '"' . $child->[0]->data . '"' . "\x0A";
122     } elsif ($nt == $child->[0]->COMMENT_NODE) {
123     $r .= '| ' . $child->[1] . '<!-- ' . $child->[0]->data . " -->\x0A";
124     } elsif ($nt == $child->[0]->DOCUMENT_TYPE_NODE) {
125     $r .= '| ' . $child->[1] . '<!DOCTYPE ' . $child->[0]->name . ">\x0A";
126     } else {
127     $r .= '| ' . $child->[1] . $child->[0]->node_type . "\x0A"; # error
128     }
129     }
130    
131     return $r;
132     } # serialize
133    
134     ## License: Public Domain.
135 wakaba 1.3 ## $Date: 2007/05/01 06:22:12 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24