/[suikacvs]/markup/html/whatpm/t/content-checker.pl
Suika

Contents of /markup/html/whatpm/t/content-checker.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations) (download)
Sat Dec 6 10:00:58 2008 UTC (16 years, 7 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +10 -10 lines
File MIME type: text/plain
++ whatpm/t/ChangeLog	6 Dec 2008 10:00:34 -0000
2008-12-06  Wakaba  <wakaba@suika.fam.cx>

	* content-checker.pl: Use new XML parser for parsing test data.
	Use NanoDOM instead of manakai DOM implementation.

++ whatpm/Whatpm/ChangeLog	6 Dec 2008 09:58:56 -0000
2008-12-06  Wakaba  <wakaba@suika.fam.cx>

	* NanoDOM.pm (document_uri): New attribute.

	* ContentChecker.pm: Don't use methods not implemented by NanoDOM.

++ whatpm/Whatpm/ContentChecker/ChangeLog	6 Dec 2008 09:59:53 -0000
2008-12-06  Wakaba  <wakaba@suika.fam.cx>

	* HTML.pm: Use |Message::URL| for relative URL resolution.  Don't
	use attributes not supported by NanoDOM.

1 use strict;
2
3 ## ISSUE: Currently we require manakai XML parser to test arbitrary XML tree.
4 use lib qw[/home/wakaba/work/manakai2/lib];
5
6 use Test;
7
8 require Whatpm::ContentChecker;
9 require Whatpm::XML::Parser;
10 require Whatpm::HTML;
11 require Whatpm::NanoDOM;
12 require Message::URI::URIReference;
13 require Message::DOM::Atom::AtomElement;
14 *Whatpm::NanoDOM::Element::rel
15 = \&Message::DOM::Atom::AtomElement::AtomLinkElement::rel;
16
17 sub test_files (@) {
18 my @FILES = @_;
19
20 require 't/testfiles.pl';
21 execute_test ($_, {
22 errors => {is_list => 1},
23 }, \&test) for @FILES;
24 } # test_files
25
26 sub test ($) {
27 my $test = shift;
28
29 $test->{parse_as} = 'xml';
30 $test->{parse_as} = 'html'
31 if $test->{data}->[1] and $test->{data}->[1]->[0] eq 'html';
32
33 unless ($test->{data}) {
34 warn "No #data field\n";
35 } elsif (not $test->{errors}) {
36 warn "No #errors field ($test->{data}->[0])\n";
37 }
38
39 my $doc;
40 if ($test->{parse_as} eq 'xml') {
41 $doc = Whatpm::NanoDOM::Document->new;
42 Whatpm::XML::Parser->parse_char_string ($test->{data}->[0] => $doc);
43 ## NOTE: There should be no well-formedness error; if there is,
44 ## then it is an error of the test case itself.
45 } else {
46 $doc = Whatpm::NanoDOM::Document->new;
47 Whatpm::HTML->parse_char_string ($test->{data}->[0] => $doc);
48 }
49 $doc->document_uri (q<thismessage:/>);
50
51 my @error;
52 Whatpm::ContentChecker->check_element
53 ($doc->document_element, sub {
54 my %opt = @_;
55 if ($opt{type} =~ /^status:/ and $opt{level} eq 'i') {
56 #
57 } else {
58 push @error, get_node_path ($opt{node}) . ';' . $opt{type} .
59 (defined $opt{text} ? ';' . $opt{text} : '') .
60 (defined $opt{level} ? ';'.$opt{level} : '');
61 }
62 }, sub {
63 my $opt = shift;
64 push @error, get_node_path ($opt->{container_node}) . ';SUBDOC';
65 });
66
67 ok join ("\n", sort {$a cmp $b} @error),
68 join ("\n", sort {$a cmp $b} @{$test->{errors}->[0]}), $test->{data}->[0];
69 } # test
70
71 sub get_node_path ($) {
72 my $node = shift;
73 my @r;
74 while (defined $node) {
75 my $rs;
76 if ($node->node_type == 1) {
77 $rs = $node->manakai_local_name;
78 $node = $node->parent_node;
79 } elsif ($node->node_type == 2) {
80 $rs = '@' . $node->manakai_local_name;
81 $node = $node->owner_element;
82 } elsif ($node->node_type == 3) {
83 $rs = '"' . $node->data . '"';
84 $node = $node->parent_node;
85 } elsif ($node->node_type == 9) {
86 $rs = '';
87 $node = $node->parent_node;
88 } else {
89 $rs = '#' . $node->node_type;
90 $node = $node->parent_node;
91 }
92 unshift @r, $rs;
93 }
94 return join '/', @r;
95 } # get_node_path
96
97 =head1 NAME
98
99 content-checker.pl - Test engine for document conformance checking
100
101 =head1 DESCRIPTION
102
103 The C<content-checker.pl> script implements a test engine for the
104 conformance checking modules, directly or indirectly referenced from
105 L<Whatpm::ContentChecker>.
106
107 This script is C<require>d by various test scripts, including
108 C<ContentCheker.t>, C<ContentChecker-Atom.t>, and C<LangTag.t>.
109
110 =head1 AUTHOR
111
112 Wakaba <w@suika.fam.cx>.
113
114 =head1 LICENSE
115
116 Public Domain.
117
118 =cut
119
120 1; ## $Date: 2008/09/20 07:00:53 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24