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	#!/usr/bin/perl
2	use strict;
3	use Test;
4	BEGIN { plan tests => 128 }
5
6	require Message::DOM::DOMImplementation;
7	use Message::Util::Error;
8
9	## TODO: \|create_document\| tests
10
11	my $dom = Message::DOM::DOMImplementation->____new;
12	my $doc = $dom->create_document;
13
14	## AUTOLOAD test
15	ok $doc->can ('create_element_ns') ? 1 : 0, 1, "can create_element_ns";
16	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	## NOTE: Tests for \|create_*\| methods found in \|DOM-Node.t\|.
28
29	my $impl = $doc->implementation;
30	ok UNIVERSAL::isa ($impl, 'Message::IF::DOMImplementation') ? 1 : 0, 1;
31
32	## \|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	## \|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	{
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	## 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	## $Date: 2007/07/07 07:36:58 $