manakai/t/DOM-Document.t

#!/usr/bin/perl
use strict;
use Test;
BEGIN { plan tests => 128 } 

require Message::DOM::DOMImplementation;
use Message::Util::Error;

## TODO: |create_document| tests

my $dom = Message::DOM::DOMImplementation->____new;
my $doc = $dom->create_document;

## AUTOLOAD test
ok $doc->can ('create_element_ns') ? 1 : 0, 1, "can create_element_ns";
my $el = $doc->create_element_ns (undef, 'test');
ok UNIVERSAL::isa ($el, 'Message::IF::Element');

ok $doc->can ('no_such_method') ? 1 : 0, 0;
my $something_called = 0;
eval {
  $doc->no_such_method;
  $something_called = 1;
};
ok $something_called, 0;

## NOTE: Tests for |create_*| methods found in |DOM-Node.t|.

my $impl = $doc->implementation;
ok UNIVERSAL::isa ($impl, 'Message::IF::DOMImplementation') ? 1 : 0, 1;

## |xmlVersion|
ok $doc->can ('xml_version') ? 1 : 0, 1, 'can xml_version';

ok $doc->xml_version, '1.0', 'xml_version initial';

$doc->xml_version ('1.1');
ok $doc->xml_version, '1.1', 'xml_version 1.1';

$doc->xml_version ('1.0');
ok $doc->xml_version, '1.0', 'xml_version 1.0';

try {
  $doc->xml_version ('1.2');
  ok undef, 'NOT_SUPPORTED_ERR', 'xml_version 1.2 exception';
} catch Message::IF::DOMException with {
  my $err = shift;
  ok $err->type, 'NOT_SUPPORTED_ERR', 'xml_version 1.2 exception';
};
ok $doc->xml_version, '1.0', 'xml_version 1.2';

## |xmlVersion| and |manakaiIsHTML|
my $html_doc = $doc->implementation->create_document;
{
  $html_doc->manakai_is_html (1);
  ok $html_doc->manakai_is_html ? 1 : 0, 1, 'HTMLDocument->manakai_is_html 1';
  ok $html_doc->xml_version, undef, 'HTMLDocument->xml_version';
  
  try {
    $html_doc->xml_version ('1.0');
    ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_version 1.0 exception';
  } catch Message::IF::DOMException with {
    my $err = shift;
    ok $err->type, 'NOT_SUPPORTED_ERR',
        'HTMLDocument->xml_version 1.0 exception';
  };
  ok $html_doc->xml_version, undef, 'HTMLDocument->xml_version 1.0';

  $html_doc->manakai_is_html (0);
  ok $html_doc->manakai_is_html ? 1 : 0, 0, 'HTMLDocument->manakai_is_html 0';
  ok $html_doc->xml_version, '1.0', '(was HTML) Document->xml_version 1.0';

  $html_doc->manakai_is_html (1);
}

## |xmlEncoding|
{
  ok $doc->can ('xml_encoding') ? 1 : 0, 1, 'can xml_encoding';

  $doc->xml_encoding ('utf-8');
  ok $doc->xml_encoding, 'utf-8', 'xml_encoding legal';

  $doc->xml_encoding ('\abcd');
  ok $doc->xml_encoding, '\abcd', 'xml_encoding illegal';

  $doc->xml_encoding (undef);
  ok $doc->xml_encoding, undef, 'xml_encoding null';

  ok $html_doc->xml_encoding, undef, 'HTMLDocument->xml_encoding';
  
  try {
    $html_doc->xml_encoding ('utf-8');
    ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_encoding exception';
  } catch Message::IF::DOMException with {
    my $err = shift;
    ok $err->type, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_encoding exception';
  };
  ok $html_doc->xml_encoding, undef, 'HTMLDocument->xml_encoding';
  
  try {
    $html_doc->xml_encoding (undef);
    ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_encoding exception 2';
  } catch Message::IF::DOMException with {
    my $err = shift;
    ok $err->type, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_encoding exception 2';
  };
  ok $html_doc->xml_encoding, undef, 'HTMLDocument->xml_encoding 2';
}

## |xmlStandalone|
{
  ok $doc->can ('xml_standalone') ? 1 : 0, 1, 'can xml_standalone';

  $doc->xml_standalone (1);
  ok $doc->xml_standalone ? 1 : 0, 1, 'xml_standalone 1';

  $doc->xml_standalone (0);
  ok $doc->xml_standalone ? 1 : 0, 0, 'xml_standalone 0';

  ok $html_doc->xml_standalone ? 1 : 0, 0, 'HTMLDocument->xml_standalone';
  
  try {
    $html_doc->xml_standalone (1);
    ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_standalone 1 exception';
  } catch Message::IF::DOMException with {
    my $err = shift;
    ok $err->type, 'NOT_SUPPORTED_ERR',
        'HTMLDocument->xml_standalone 1 exception';
  };
  ok $html_doc->xml_standalone ? 1 : 0, 0, 'HTMLDocument->xml_standalone 1';
  
  try {
    $html_doc->xml_standalone (0);
    ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_standalone 0 exception';
  } catch Message::IF::DOMException with {
    my $err = shift;
    ok $err->type, 'NOT_SUPPORTED_ERR',
        'HTMLDocument->xml_standalone 0 exception';
  };
  ok $html_doc->xml_standalone ? 1 : 0, 0, 'HTMLDocument->xml_standalone 0';
}

## |strictErrorChecking|
{
  ok $doc->can ('strict_error_checking') ? 1 : 0, 1, 'can strict_error_checking';

  $doc->strict_error_checking (0);
  ok $doc->strict_error_checking ? 1 : 0, 0, 'strict_error_checking 0';

  $doc->strict_error_checking (1);
  ok $doc->strict_error_checking ? 1 : 0, 1, 'strict_error_checking 1';

  $doc->strict_error_checking (undef);
  ok $doc->strict_error_checking ? 1 : 0, 0, 'strict_error_checking undef';

  $doc->strict_error_checking (1);
}

for my $prop (qw/document_uri input_encoding/) {
  ok $doc->can ($prop) ? 1 : 0, 1, 'can ' . $prop;
  
  for ('http://absuri.test/', 'reluri', 0, '') {
    $doc->$prop ($_);
    ok $doc->$prop, $_, $prop . $_;
  }

  $doc->$prop (undef);
  ok $doc->$prop, undef, $prop . ' undef';
}

for my $prop (qw/all_declarations_processed/) {
  ok $doc->can ($prop) ? 1 : 0, 1, 'can ' . $prop;
  
  for (1, 0, '') {
    $doc->$prop ($_);
    ok $doc->$prop ? 1 : 0, $_ ? 1 : 0, $prop . $_;
  }

  $doc->$prop (undef);
  ok $doc->$prop ? 1 : 0, 0, $prop . ' undef';
}

## |manakaiIsHTML|, |compatMode|, and |manakaiCompatMode|
{
  my $doc2 = $doc->implementation->create_document;
  ok $doc2->can ('manakai_is_html') ? 1 : 0, 1, "can manakai_is_html";
  ok $doc2->can ('compat_mode') ? 1 : 0, 1, "can compat_mode";
  ok $doc2->can ('manakai_compat_mode') ? 1 : 0, 1, "can manakai_compat_mode";
  ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [0]";
  ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [0]';
  ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [0]';

  $doc2->manakai_compat_mode ('quirks');
  ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [1]";
  ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [1]';
  ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [1]';

  $doc2->manakai_compat_mode ('limited quirks');
  ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [2]";
  ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [2]';
  ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [2]';

  $doc2->manakai_compat_mode ('no quirks');
  ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [3]";
  ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [3]';
  ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [3]';

  $doc2->manakai_compat_mode ('bogus');
  ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [4]";
  ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [4]';
  ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [4]';

  $doc2->manakai_is_html (1);
  ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [5]";
  ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [5]';
  ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [5]';

  $doc2->manakai_compat_mode ('quirks');
  ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [6]";
  ok $doc2->compat_mode, 'BackCompat', 'compat_mode [6]';
  ok $doc2->manakai_compat_mode, 'quirks', 'manakai_compat_mode [6]';

  $doc2->manakai_compat_mode ('limited quirks');
  ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [7]";
  ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [7]';
  ok $doc2->manakai_compat_mode, 'limited quirks', 'manakai_compat_mode [7]';

  $doc2->manakai_compat_mode ('no quirks');
  ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [8]";
  ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [8]';
  ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [8]';

  $doc2->manakai_compat_mode ('bogus');
  ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [9]";
  ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [9]';
  ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [9]';

  $doc2->manakai_compat_mode ('quirks');
  $doc2->manakai_is_html (0);
  ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [10]";
  ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [10]';
  ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [10]';

  $doc2->manakai_is_html (1);
  ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [11]";
  ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [11]';
  ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [11]';
}

{
  ok $doc->can ('implementation') ? 1 : 0, 1, 'Document->implementation can';
  my $impl = $doc->implementation;
  ok UNIVERSAL::isa ($impl, 'Message::DOM::DOMImplementation') ? 1 : 0,
      1, 'Document->implementation class';
  my $impl2 = $doc->implementation;
  ok $impl eq $impl2 ? 1 : 0, 1, 'Document->implementation eq D->i';
  ok $impl ne $impl2 ? 1 : 0, 0, 'Document->implementation ne D->i';
  ok $impl == $impl2 ? 1 : 0, 1, 'Document->implementation == D->i';
  ok $impl != $impl2 ? 1 : 0, 0, 'Document->implementation != D->i';
}

{
  my $doc2 = $doc->implementation->create_document;
  ok $doc2->doctype, undef, 'Document->implementation [0]';

  my $doctype = $doc2->implementation->create_document_type ('dt');
  my $el = $doc2->create_element_ns (undef, 'e');
  $doc2->append_child ($doctype);
  $doc2->append_child ($el);

  ok $doc2->doctype, $doctype, 'Document->implementation [1]';
}

{
  my $doc2 = $doc->implementation->create_document;
  my $doctype = $doc2->implementation->create_document_type ('dt');
  my $el = $doc2->create_element_ns (undef, 'e');
  my $comment = $doc->create_comment ('');
  $doc2->append_child ($comment);
  $doc2->append_child ($doctype);
  $doc2->append_child ($el);

  ok $doc2->doctype, $doctype, 'Document->implementation [2]';
}

{
  my $doc2 = $doc->implementation->create_document;
  ok $doc2->can ('document_element') ? 1 : 0, 1, 'Document->document_el can';
  ok $doc2->document_element, undef, 'Document->document_element [0]';

  my $el = $doc2->create_element_ns (undef, 'e');
  $doc2->append_child ($el);

  ok $doc2->document_element, $el, 'Document->document_element [1]';
}

{
  my $doc2 = $doc->implementation->create_document;
  my $doctype = $doc2->implementation->create_document_type ('dt');
  $doc2->append_child ($doctype);
  my $el = $doc2->create_element_ns (undef, 'e');
  $doc2->append_child ($el);

  ok $doc2->document_element, $el, 'Document->document_element [1]';
}

{
  ok $doc->can ('dom_config') ? 1 : 0, 1, 'Document->dom_config can';
  my $cfg = $doc->dom_config;
  ok UNIVERSAL::isa ($cfg, 'Message::IF::DOMConfiguration') ? 1 : 0,
      1, 'Document->dom_config interface';
}

{
  my $impl = $doc->implementation;
  my $doc1 = $impl->create_document;
  my $doc2 = $impl->create_document;

  ok $doc2->can ('adopt_node') ? 1 : 0, 1, 'Document->adopt_node can';

  my $el1 = $doc1->create_element_ns (undef, 'e');
  my $el2 = $doc2->adopt_node ($el1);

  ok $el1 eq $el2 ? 1 : 0, 1, 'Document->adopt_node return == source';
  ok $el2->owner_document, $doc2, 'Document->adopt_node owner_document';
  
  my $node = $doc1->create_element ('e');
  my $udh_called = 0;
  $node->set_user_data (key => {}, sub {
    my ($op, $key, $data, $src, $dest) = @_;
    $udh_called = 1;
    
    ok $op, 5, 'adopt_node user data handler operation';
    ok $key, 'key', 'adopt_node user data handler key';
    ok ref $data, 'HASH', 'adopt_node user data handler data';
    ok $src, $node, 'adopt_node user data handler src';
    ok $dest, undef, 'adopt_node user data handler dest';
  });

  $doc2->adopt_node ($node);

  ok $udh_called, 1, 'Document->adopt_node udh called';

  $node->set_user_data (key => undef, undef);

  my $el3 = $doc1->create_element_ns (undef, 'e');
  my $el4 = $doc1->adopt_node ($el3);
  
  ok $el4, $el3, 'Document->adopt_node samedoc return';
  ok $el4->owner_document, $doc1, 'Document->adopt_node samedoc od';

  my $parent = $doc1->create_element ('pa');
  my $child = $doc1->create_element ('ch');
  $parent->append_child ($child);

  my $child2 = $doc2->adopt_node ($child);
  
  ok $child2, $child, 'Document->adopt_node return [2]';
  ok $child2->owner_document, $doc2, 'Document->adopt_node->od [2]';
  ok $child2->parent_node, undef, 'Document->adopt_node->parent_node [2]';
  ok 0+@{$parent->child_nodes}, 0, 'Document->adopt_node parent->cn @{} 0+ [2]';

  my $attr = $doc1->create_attribute ('e');
  $parent->set_attribute_node ($attr);

  my $attr2 = $doc2->adopt_node ($attr);
  ok $attr2, $attr, 'Document->adopt_node return [3]';
  ok $attr2->owner_document, $doc2, 'Document->adopt_node->od [3]';
  ok $attr2->owner_element, undef, 'Document->adopt_node->oe [3]';
  ok 0+@{$parent->attributes}, 0, 'Document->adopt_node parent->a @{} 0+ [3]';
}

## TODO: manakai_entity_base_uri

=head1 LICENSE

Copyright 2007 Wakaba <w@suika.fam.cx>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

## $Date: 2007/07/07 07:36:58 $
1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3			use Test;
4	wakaba	1.5	BEGIN { plan tests => 128 }
5	wakaba	1.1
6			require Message::DOM::DOMImplementation;
7	wakaba	1.2	use Message::Util::Error;
8	wakaba	1.1
9			## TODO: \|create_document\| tests
10
11			my $dom = Message::DOM::DOMImplementation->____new;
12			my $doc = $dom->create_document;
13
14			## AUTOLOAD test
15	wakaba	1.2	ok $doc->can ('create_element_ns') ? 1 : 0, 1, "can create_element_ns";
16	wakaba	1.1	my $el = $doc->create_element_ns (undef, 'test');
17			ok UNIVERSAL::isa ($el, 'Message::IF::Element');
18
19			ok $doc->can ('no_such_method') ? 1 : 0, 0;
20			my $something_called = 0;
21			eval {
22			$doc->no_such_method;
23			$something_called = 1;
24			};
25			ok $something_called, 0;
26
27	wakaba	1.2	## NOTE: Tests for \|create_*\| methods found in \|DOM-Node.t\|.
28	wakaba	1.1
29			my $impl = $doc->implementation;
30			ok UNIVERSAL::isa ($impl, 'Message::IF::DOMImplementation') ? 1 : 0, 1;
31
32	wakaba	1.2	## \|xmlVersion\|
33			ok $doc->can ('xml_version') ? 1 : 0, 1, 'can xml_version';
34
35			ok $doc->xml_version, '1.0', 'xml_version initial';
36
37			$doc->xml_version ('1.1');
38			ok $doc->xml_version, '1.1', 'xml_version 1.1';
39
40			$doc->xml_version ('1.0');
41			ok $doc->xml_version, '1.0', 'xml_version 1.0';
42
43			try {
44			$doc->xml_version ('1.2');
45			ok undef, 'NOT_SUPPORTED_ERR', 'xml_version 1.2 exception';
46			} catch Message::IF::DOMException with {
47			my $err = shift;
48			ok $err->type, 'NOT_SUPPORTED_ERR', 'xml_version 1.2 exception';
49			};
50			ok $doc->xml_version, '1.0', 'xml_version 1.2';
51
52			## \|xmlVersion\| and \|manakaiIsHTML\|
53			my $html_doc = $doc->implementation->create_document;
54			{
55			$html_doc->manakai_is_html (1);
56			ok $html_doc->manakai_is_html ? 1 : 0, 1, 'HTMLDocument->manakai_is_html 1';
57			ok $html_doc->xml_version, undef, 'HTMLDocument->xml_version';
58
59			try {
60			$html_doc->xml_version ('1.0');
61			ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_version 1.0 exception';
62			} catch Message::IF::DOMException with {
63			my $err = shift;
64			ok $err->type, 'NOT_SUPPORTED_ERR',
65			'HTMLDocument->xml_version 1.0 exception';
66			};
67			ok $html_doc->xml_version, undef, 'HTMLDocument->xml_version 1.0';
68
69			$html_doc->manakai_is_html (0);
70			ok $html_doc->manakai_is_html ? 1 : 0, 0, 'HTMLDocument->manakai_is_html 0';
71			ok $html_doc->xml_version, '1.0', '(was HTML) Document->xml_version 1.0';
72
73			$html_doc->manakai_is_html (1);
74			}
75
76			## \|xmlEncoding\|
77			{
78			ok $doc->can ('xml_encoding') ? 1 : 0, 1, 'can xml_encoding';
79
80			$doc->xml_encoding ('utf-8');
81			ok $doc->xml_encoding, 'utf-8', 'xml_encoding legal';
82
83			$doc->xml_encoding ('\abcd');
84			ok $doc->xml_encoding, '\abcd', 'xml_encoding illegal';
85
86			$doc->xml_encoding (undef);
87			ok $doc->xml_encoding, undef, 'xml_encoding null';
88
89			ok $html_doc->xml_encoding, undef, 'HTMLDocument->xml_encoding';
90
91			try {
92			$html_doc->xml_encoding ('utf-8');
93			ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_encoding exception';
94			} catch Message::IF::DOMException with {
95			my $err = shift;
96			ok $err->type, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_encoding exception';
97			};
98			ok $html_doc->xml_encoding, undef, 'HTMLDocument->xml_encoding';
99
100			try {
101			$html_doc->xml_encoding (undef);
102			ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_encoding exception 2';
103			} catch Message::IF::DOMException with {
104			my $err = shift;
105			ok $err->type, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_encoding exception 2';
106			};
107			ok $html_doc->xml_encoding, undef, 'HTMLDocument->xml_encoding 2';
108			}
109
110			## \|xmlStandalone\|
111			{
112			ok $doc->can ('xml_standalone') ? 1 : 0, 1, 'can xml_standalone';
113
114			$doc->xml_standalone (1);
115			ok $doc->xml_standalone ? 1 : 0, 1, 'xml_standalone 1';
116
117			$doc->xml_standalone (0);
118			ok $doc->xml_standalone ? 1 : 0, 0, 'xml_standalone 0';
119
120			ok $html_doc->xml_standalone ? 1 : 0, 0, 'HTMLDocument->xml_standalone';
121
122			try {
123			$html_doc->xml_standalone (1);
124			ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_standalone 1 exception';
125			} catch Message::IF::DOMException with {
126			my $err = shift;
127			ok $err->type, 'NOT_SUPPORTED_ERR',
128			'HTMLDocument->xml_standalone 1 exception';
129			};
130			ok $html_doc->xml_standalone ? 1 : 0, 0, 'HTMLDocument->xml_standalone 1';
131
132			try {
133			$html_doc->xml_standalone (0);
134			ok undef, 'NOT_SUPPORTED_ERR', 'HTMLDocument->xml_standalone 0 exception';
135			} catch Message::IF::DOMException with {
136			my $err = shift;
137			ok $err->type, 'NOT_SUPPORTED_ERR',
138			'HTMLDocument->xml_standalone 0 exception';
139			};
140			ok $html_doc->xml_standalone ? 1 : 0, 0, 'HTMLDocument->xml_standalone 0';
141			}
142
143			## \|strictErrorChecking\|
144			{
145			ok $doc->can ('strict_error_checking') ? 1 : 0, 1, 'can strict_error_checking';
146
147			$doc->strict_error_checking (0);
148			ok $doc->strict_error_checking ? 1 : 0, 0, 'strict_error_checking 0';
149
150			$doc->strict_error_checking (1);
151			ok $doc->strict_error_checking ? 1 : 0, 1, 'strict_error_checking 1';
152
153			$doc->strict_error_checking (undef);
154			ok $doc->strict_error_checking ? 1 : 0, 0, 'strict_error_checking undef';
155
156			$doc->strict_error_checking (1);
157			}
158
159			for my $prop (qw/document_uri input_encoding/) {
160			ok $doc->can ($prop) ? 1 : 0, 1, 'can ' . $prop;
161
162			for ('http://absuri.test/', 'reluri', 0, '') {
163			$doc->$prop ($_);
164			ok $doc->$prop, $_, $prop . $_;
165			}
166
167			$doc->$prop (undef);
168			ok $doc->$prop, undef, $prop . ' undef';
169			}
170
171			for my $prop (qw/all_declarations_processed/) {
172			ok $doc->can ($prop) ? 1 : 0, 1, 'can ' . $prop;
173
174			for (1, 0, '') {
175			$doc->$prop ($_);
176			ok $doc->$prop ? 1 : 0, $_ ? 1 : 0, $prop . $_;
177			}
178
179			$doc->$prop (undef);
180			ok $doc->$prop ? 1 : 0, 0, $prop . ' undef';
181			}
182
183	wakaba	1.3	## \|manakaiIsHTML\|, \|compatMode\|, and \|manakaiCompatMode\|
184			{
185			my $doc2 = $doc->implementation->create_document;
186			ok $doc2->can ('manakai_is_html') ? 1 : 0, 1, "can manakai_is_html";
187			ok $doc2->can ('compat_mode') ? 1 : 0, 1, "can compat_mode";
188			ok $doc2->can ('manakai_compat_mode') ? 1 : 0, 1, "can manakai_compat_mode";
189			ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [0]";
190			ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [0]';
191			ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [0]';
192
193			$doc2->manakai_compat_mode ('quirks');
194			ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [1]";
195			ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [1]';
196			ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [1]';
197
198			$doc2->manakai_compat_mode ('limited quirks');
199			ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [2]";
200			ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [2]';
201			ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [2]';
202
203			$doc2->manakai_compat_mode ('no quirks');
204			ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [3]";
205			ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [3]';
206			ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [3]';
207
208			$doc2->manakai_compat_mode ('bogus');
209			ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [4]";
210			ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [4]';
211			ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [4]';
212
213			$doc2->manakai_is_html (1);
214			ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [5]";
215			ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [5]';
216			ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [5]';
217
218			$doc2->manakai_compat_mode ('quirks');
219			ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [6]";
220			ok $doc2->compat_mode, 'BackCompat', 'compat_mode [6]';
221			ok $doc2->manakai_compat_mode, 'quirks', 'manakai_compat_mode [6]';
222
223			$doc2->manakai_compat_mode ('limited quirks');
224			ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [7]";
225			ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [7]';
226			ok $doc2->manakai_compat_mode, 'limited quirks', 'manakai_compat_mode [7]';
227
228			$doc2->manakai_compat_mode ('no quirks');
229			ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [8]";
230			ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [8]';
231			ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [8]';
232
233			$doc2->manakai_compat_mode ('bogus');
234			ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [9]";
235			ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [9]';
236			ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [9]';
237
238			$doc2->manakai_compat_mode ('quirks');
239			$doc2->manakai_is_html (0);
240			ok $doc2->manakai_is_html ? 1 : 0, 0, "manakai_is_html [10]";
241			ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [10]';
242			ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [10]';
243
244			$doc2->manakai_is_html (1);
245			ok $doc2->manakai_is_html ? 1 : 0, 1, "manakai_is_html [11]";
246			ok $doc2->compat_mode, 'CSS1Compat', 'compat_mode [11]';
247			ok $doc2->manakai_compat_mode, 'no quirks', 'manakai_compat_mode [11]';
248			}
249
250	wakaba	1.4	{
251			ok $doc->can ('implementation') ? 1 : 0, 1, 'Document->implementation can';
252			my $impl = $doc->implementation;
253			ok UNIVERSAL::isa ($impl, 'Message::DOM::DOMImplementation') ? 1 : 0,
254			1, 'Document->implementation class';
255			my $impl2 = $doc->implementation;
256			ok $impl eq $impl2 ? 1 : 0, 1, 'Document->implementation eq D->i';
257			ok $impl ne $impl2 ? 1 : 0, 0, 'Document->implementation ne D->i';
258			ok $impl == $impl2 ? 1 : 0, 1, 'Document->implementation == D->i';
259			ok $impl != $impl2 ? 1 : 0, 0, 'Document->implementation != D->i';
260			}
261
262			{
263			my $doc2 = $doc->implementation->create_document;
264			ok $doc2->doctype, undef, 'Document->implementation [0]';
265
266			my $doctype = $doc2->implementation->create_document_type ('dt');
267			my $el = $doc2->create_element_ns (undef, 'e');
268			$doc2->append_child ($doctype);
269			$doc2->append_child ($el);
270
271			ok $doc2->doctype, $doctype, 'Document->implementation [1]';
272			}
273
274			{
275			my $doc2 = $doc->implementation->create_document;
276			my $doctype = $doc2->implementation->create_document_type ('dt');
277			my $el = $doc2->create_element_ns (undef, 'e');
278			my $comment = $doc->create_comment ('');
279			$doc2->append_child ($comment);
280			$doc2->append_child ($doctype);
281			$doc2->append_child ($el);
282
283			ok $doc2->doctype, $doctype, 'Document->implementation [2]';
284			}
285
286			{
287			my $doc2 = $doc->implementation->create_document;
288			ok $doc2->can ('document_element') ? 1 : 0, 1, 'Document->document_el can';
289			ok $doc2->document_element, undef, 'Document->document_element [0]';
290
291			my $el = $doc2->create_element_ns (undef, 'e');
292			$doc2->append_child ($el);
293
294			ok $doc2->document_element, $el, 'Document->document_element [1]';
295			}
296
297			{
298			my $doc2 = $doc->implementation->create_document;
299			my $doctype = $doc2->implementation->create_document_type ('dt');
300			$doc2->append_child ($doctype);
301			my $el = $doc2->create_element_ns (undef, 'e');
302			$doc2->append_child ($el);
303
304			ok $doc2->document_element, $el, 'Document->document_element [1]';
305			}
306
307			{
308			ok $doc->can ('dom_config') ? 1 : 0, 1, 'Document->dom_config can';
309			my $cfg = $doc->dom_config;
310			ok UNIVERSAL::isa ($cfg, 'Message::IF::DOMConfiguration') ? 1 : 0,
311			1, 'Document->dom_config interface';
312			}
313
314			{
315			my $impl = $doc->implementation;
316			my $doc1 = $impl->create_document;
317			my $doc2 = $impl->create_document;
318
319			ok $doc2->can ('adopt_node') ? 1 : 0, 1, 'Document->adopt_node can';
320
321			my $el1 = $doc1->create_element_ns (undef, 'e');
322			my $el2 = $doc2->adopt_node ($el1);
323
324			ok $el1 eq $el2 ? 1 : 0, 1, 'Document->adopt_node return == source';
325			ok $el2->owner_document, $doc2, 'Document->adopt_node owner_document';
326
327			my $node = $doc1->create_element ('e');
328			my $udh_called = 0;
329			$node->set_user_data (key => {}, sub {
330			my ($op, $key, $data, $src, $dest) = @_;
331			$udh_called = 1;
332
333			ok $op, 5, 'adopt_node user data handler operation';
334			ok $key, 'key', 'adopt_node user data handler key';
335			ok ref $data, 'HASH', 'adopt_node user data handler data';
336			ok $src, $node, 'adopt_node user data handler src';
337			ok $dest, undef, 'adopt_node user data handler dest';
338			});
339
340			$doc2->adopt_node ($node);
341
342			ok $udh_called, 1, 'Document->adopt_node udh called';
343
344			$node->set_user_data (key => undef, undef);
345
346			my $el3 = $doc1->create_element_ns (undef, 'e');
347			my $el4 = $doc1->adopt_node ($el3);
348
349			ok $el4, $el3, 'Document->adopt_node samedoc return';
350			ok $el4->owner_document, $doc1, 'Document->adopt_node samedoc od';
351
352			my $parent = $doc1->create_element ('pa');
353			my $child = $doc1->create_element ('ch');
354			$parent->append_child ($child);
355
356			my $child2 = $doc2->adopt_node ($child);
357
358			ok $child2, $child, 'Document->adopt_node return [2]';
359			ok $child2->owner_document, $doc2, 'Document->adopt_node->od [2]';
360			ok $child2->parent_node, undef, 'Document->adopt_node->parent_node [2]';
361			ok 0+@{$parent->child_nodes}, 0, 'Document->adopt_node parent->cn @{} 0+ [2]';
362
363			my $attr = $doc1->create_attribute ('e');
364			$parent->set_attribute_node ($attr);
365
366			my $attr2 = $doc2->adopt_node ($attr);
367			ok $attr2, $attr, 'Document->adopt_node return [3]';
368			ok $attr2->owner_document, $doc2, 'Document->adopt_node->od [3]';
369			ok $attr2->owner_element, undef, 'Document->adopt_node->oe [3]';
370			ok 0+@{$parent->attributes}, 0, 'Document->adopt_node parent->a @{} 0+ [3]';
371			}
372
373	wakaba	1.2	## TODO: manakai_entity_base_uri
374
375			=head1 LICENSE
376
377			Copyright 2007 Wakaba <w@suika.fam.cx>
378
379			This program is free software; you can redistribute it and/or
380			modify it under the same terms as Perl itself.
381
382			=cut
383
384	wakaba	1.5	## $Date: 2007/07/07 07:36:58 $