manakai/t/DOM-Attr.t

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

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

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

my $ent = $doc->create_attribute ('attr');

## Constants
my $constants = [
                 [NO_TYPE_ATTR => 0],
                 [CDATA_ATTR => 1],
                 [ID_ATTR => 2],
                 [IDREF_ATTR => 3],
                 [IDREFS_ATTR => 4],
                 [ENTITY_ATTR => 5],
                 [ENTITIES_ATTR => 6],
                 [NMTOKEN_ATTR => 7],
                 [NMTOKENS_ATTR => 8],
                 [NOTATION_ATTR => 9],
                 [ENUMERATION_ATTR => 10],
                 [UNKNOWN_ATTR => 11],
];
for (@$constants) {
  my $const_name = $_->[0];
  ok $ent->can ($const_name) ? 1 : 0, 1, "can ($const_name)";
  ok $ent->$const_name, $_->[1], $const_name;
}

## |specified|
{
  my $prop = 'specified';
  ok $ent->can ($prop) ? 1 : 0, 1, 'can ' . $prop;
  ok $ent->$prop ? 1 : 0, 1, $prop . ' test is valid?';
  
  for (0, 1, '') {
    $ent->$prop ($_);
    ok $ent->$prop ? 1 : 0, 1, $prop . ' ' . $_;
  }

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

  my $el = $doc->create_element ('element');
  $el->set_attribute_node ($ent); # set owner_element
  ok $ent->$prop ? 1 : 0, 1, $prop . ' test is valid? (has owner_element)';

  for (0, 1, '') {
    $ent->$prop ($_);
    ok $ent->$prop ? 1 : 0, $_ ? 1 : 0, $prop . ' (has owner_element) ' . $_;
  }

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

{
  my $attr = $doc->create_attribute_ns (undef, 'at1');
  my $el = $doc->create_element_ns (undef, 'el');
  $el->set_attribute_node_ns ($attr);
  ok $attr->specified ? 1 : 0, 1, 'specified [1]';
  $attr->specified (0);
  ok $attr->specified ? 1 : 0, 0, 'specified [2]';
  $attr->specified (1);
  ok $attr->specified ? 1 : 0, 1, 'specified [3]';
  $attr->specified (0);
  $el->remove_attribute_node ($attr);
  ok $attr->specified ? 1 : 0, 1, 'specified [4]';
}

{
  my $attr = $doc->create_attribute_ns (undef, 'at1');
  my $el = $doc->create_element_ns (undef, 'el');
  $el->set_attribute_node_ns ($attr);
  $attr->specified (0);
  my $attr2 = $doc->create_attribute_ns (undef, 'at1');
  $el->set_attribute_node_ns ($attr2);
  ok $attr->specified ? 1 : 0, 1, 'specified [5]';
}

for my $prop (qw/manakai_attribute_type/) {
  ok $ent->can ($prop) ? 1 : 0, 1, 'can ' . $prop;
  local $^W = 0;
  
  for (-3..10, 'abc', '') {
    $ent->$prop ($_);
    ok $ent->$prop, 0+$_, $prop . $_;
  }

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

## |schemaTypeInfo|
{
  my $el = $doc->create_element ('el');
  $el->owner_document->dom_config->set_parameter
      ('schema-type' => undef);
  $el->set_attribute_ns (undef, 'a', 'b');
  my $attr = $el->get_attribute_node_ns (undef, 'a');
  my $sti = $attr->schema_type_info;
  ok UNIVERSAL::isa ($sti, 'Message::IF::TypeInfo') ? 1 : 0, 1, 'sti if [1]';
  ok $sti->type_name, undef, 'sti type_name [1]';
  ok $sti->type_namespace, undef, 'sti type_namespace [1]';
}

{
  my $el = $doc->create_element ('el');
  $el->owner_document->dom_config->set_parameter
      ('schema-type' => q<http://www.w3.org/TR/REC-xml>);
  $el->set_attribute_ns (undef, 'a', 'b');
  my $attr = $el->get_attribute_node_ns (undef, 'a');
  my $sti = $attr->schema_type_info;
  ok UNIVERSAL::isa ($sti, 'Message::IF::TypeInfo') ? 1 : 0, 1, 'sti if [2]';
  ok $sti->type_name, undef, 'sti type_name [2]';
  ok $sti->type_namespace, undef, 'sti type_namespace [2]';
}

{
  my $el = $doc->create_element ('el');
  $el->owner_document->dom_config->set_parameter
      ('schema-type' => q<http://www.w3.org/TR/REC-xml>);
  $el->set_attribute_ns (undef, 'a', 'b');
  my $attr = $el->get_attribute_node_ns (undef, 'a');
  for (
       [$attr->CDATA_ATTR, 'CDATA'],
       [$attr->ID_ATTR, 'ID'],
       [$attr->IDREF_ATTR, 'IDREF'],
       [$attr->IDREFS_ATTR, 'IDREFS'],
       [$attr->ENTITY_ATTR, 'ENTITY'],
       [$attr->ENTITIES_ATTR, 'ENTITIES'],
       [$attr->NOTATION_ATTR, 'NOTATION'],
       [$attr->ENUMERATION_ATTR, 'ENUMERATION'],
       [$attr->NMTOKEN_ATTR, 'NMTOKEN'],
       [$attr->NMTOKENS_ATTR, 'NMTOKENS'],
      ) {
    $attr->manakai_attribute_type ($_->[0]);
    my $sti = $attr->schema_type_info;
    ok UNIVERSAL::isa ($sti, 'Message::IF::TypeInfo') ? 1 : 0, 1,
        'sti if '.$_->[1].' [3]';
    ok $sti->type_name, $_->[1], 'sti type_name '.$_->[1].' [3]';
    ok $sti->type_namespace, q<http://www.w3.org/TR/REC-xml>,
        'sti type_namespace '.$_->[1].' [3]';
  }

  for (
       [$attr->NO_TYPE_ATTR, 'NO_VALUE'],
       [$attr->UNKNOWN_ATTR, 'UNKNOWN'],
      ) {
    $attr->manakai_attribute_type ($_->[0]);
    my $sti = $attr->schema_type_info;
    ok UNIVERSAL::isa ($sti, 'Message::IF::TypeInfo') ? 1 : 0, 1,
        'sti if '.$_->[1].' [3]';
    ok $sti->type_name, undef, 'sti type_name '.$_->[1].' [3]';
    ok $sti->type_namespace, undef, 'sti type_namespace '.$_->[1].' [3]';
  }
}

## |isId|
{
  my $attr = $doc->create_attribute ('a');
  $attr->manakai_attribute_type ($attr->ID_ATTR);
  ok $attr->is_id ? 1 : 0, 1, 'is_id [1]';
  $attr->is_id (1);
  ok $attr->is_id ? 1 : 0, 1, 'is_id [2]';
  $attr->is_id (0);
  ok $attr->is_id ? 1 : 0, 1, 'is_id [3]';
}

{
  my $attr = $doc->create_attribute ('a');
  for (
       $attr->CDATA_ATTR,
       $attr->IDREF_ATTR,
       $attr->IDREFS_ATTR,
       $attr->ENTITY_ATTR,
       $attr->ENTITIES_ATTR,
       $attr->NOTATION_ATTR,
       $attr->ENUMERATION_ATTR,
       $attr->NMTOKEN_ATTR,
       $attr->NMTOKENS_ATTR,
       $attr->NO_TYPE_ATTR,
       $attr->UNKNOWN_ATTR,
    ) {
    $attr->manakai_attribute_type ($_);
    ok $attr->is_id ? 1 : 0, 0, 'is_id '.$_.' [1]';
    $attr->is_id (1);
    ok $attr->is_id ? 1 : 0, 1, 'is_id '.$_.' [2]';
    $attr->is_id (0);
    ok $attr->is_id ? 1 : 0, 0, 'is_id '.$_.' [3]';
  }
}

{
  my $attr = $doc->create_attribute ('xml:id');
  ok $attr->is_id ? 1 : 0, 1, 'is_id xml:id [1]';
  $attr->is_id (0);
  ok $attr->is_id ? 1 : 0, 1, 'is_id xml:id [2]';
  $attr->is_id (1);
  ok $attr->is_id ? 1 : 0, 1, 'is_id xml:id [3]';
}

{
  my $attr = $doc->create_attribute_ns
      (q<http://www.w3.org/XML/1998/namespace>, 'xml:id');
  ok $attr->is_id ? 1 : 0, 1, 'is_id xml:id [4]';
  $attr->is_id (0);
  ok $attr->is_id ? 1 : 0, 1, 'is_id xml:id [5]';
  $attr->is_id (1);
  ok $attr->is_id ? 1 : 0, 1, 'is_id xml:id [6]';
}

=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/06/17 13:37:42 $
1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3			use Test;
4	wakaba	1.2	BEGIN { plan tests => 142 }
5	wakaba	1.1
6			require Message::DOM::DOMImplementation;
7			use Message::Util::Error;
8
9	wakaba	1.2	my $dom = Message::DOM::DOMImplementation->new;
10	wakaba	1.1	my $doc = $dom->create_document;
11
12			my $ent = $doc->create_attribute ('attr');
13
14	wakaba	1.2	## Constants
15			my $constants = [
16			[NO_TYPE_ATTR => 0],
17			[CDATA_ATTR => 1],
18			[ID_ATTR => 2],
19			[IDREF_ATTR => 3],
20			[IDREFS_ATTR => 4],
21			[ENTITY_ATTR => 5],
22			[ENTITIES_ATTR => 6],
23			[NMTOKEN_ATTR => 7],
24			[NMTOKENS_ATTR => 8],
25			[NOTATION_ATTR => 9],
26			[ENUMERATION_ATTR => 10],
27			[UNKNOWN_ATTR => 11],
28			];
29			for (@$constants) {
30			my $const_name = $_->[0];
31			ok $ent->can ($const_name) ? 1 : 0, 1, "can ($const_name)";
32			ok $ent->$const_name, $_->[1], $const_name;
33			}
34
35			## \|specified\|
36	wakaba	1.1	{
37			my $prop = 'specified';
38			ok $ent->can ($prop) ? 1 : 0, 1, 'can ' . $prop;
39			ok $ent->$prop ? 1 : 0, 1, $prop . ' test is valid?';
40
41			for (0, 1, '') {
42			$ent->$prop ($_);
43			ok $ent->$prop ? 1 : 0, 1, $prop . ' ' . $_;
44			}
45
46			$ent->$prop (undef);
47			ok $ent->$prop ? 1 : 0, 1, $prop . ' undef';
48
49			my $el = $doc->create_element ('element');
50			$el->set_attribute_node ($ent); # set owner_element
51			ok $ent->$prop ? 1 : 0, 1, $prop . ' test is valid? (has owner_element)';
52
53			for (0, 1, '') {
54			$ent->$prop ($_);
55			ok $ent->$prop ? 1 : 0, $_ ? 1 : 0, $prop . ' (has owner_element) ' . $_;
56			}
57
58			$ent->$prop (undef);
59			ok $ent->$prop ? 1 : 0, 0, $prop . ' (has owner_element) undef';
60			}
61
62	wakaba	1.2	{
63			my $attr = $doc->create_attribute_ns (undef, 'at1');
64			my $el = $doc->create_element_ns (undef, 'el');
65			$el->set_attribute_node_ns ($attr);
66			ok $attr->specified ? 1 : 0, 1, 'specified [1]';
67			$attr->specified (0);
68			ok $attr->specified ? 1 : 0, 0, 'specified [2]';
69			$attr->specified (1);
70			ok $attr->specified ? 1 : 0, 1, 'specified [3]';
71			$attr->specified (0);
72			$el->remove_attribute_node ($attr);
73			ok $attr->specified ? 1 : 0, 1, 'specified [4]';
74			}
75
76			{
77			my $attr = $doc->create_attribute_ns (undef, 'at1');
78			my $el = $doc->create_element_ns (undef, 'el');
79			$el->set_attribute_node_ns ($attr);
80			$attr->specified (0);
81			my $attr2 = $doc->create_attribute_ns (undef, 'at1');
82			$el->set_attribute_node_ns ($attr2);
83			ok $attr->specified ? 1 : 0, 1, 'specified [5]';
84			}
85
86	wakaba	1.1	for my $prop (qw/manakai_attribute_type/) {
87			ok $ent->can ($prop) ? 1 : 0, 1, 'can ' . $prop;
88			local $^W = 0;
89
90			for (-3..10, 'abc', '') {
91			$ent->$prop ($_);
92			ok $ent->$prop, 0+$_, $prop . $_;
93			}
94
95			$ent->$prop (undef);
96			ok $ent->$prop, 0, $prop . ' undef';
97			}
98
99	wakaba	1.2	## \|schemaTypeInfo\|
100			{
101			my $el = $doc->create_element ('el');
102			$el->owner_document->dom_config->set_parameter
103			('schema-type' => undef);
104			$el->set_attribute_ns (undef, 'a', 'b');
105			my $attr = $el->get_attribute_node_ns (undef, 'a');
106			my $sti = $attr->schema_type_info;
107			ok UNIVERSAL::isa ($sti, 'Message::IF::TypeInfo') ? 1 : 0, 1, 'sti if [1]';
108			ok $sti->type_name, undef, 'sti type_name [1]';
109			ok $sti->type_namespace, undef, 'sti type_namespace [1]';
110			}
111
112			{
113			my $el = $doc->create_element ('el');
114			$el->owner_document->dom_config->set_parameter
115			('schema-type' => q<http://www.w3.org/TR/REC-xml>);
116			$el->set_attribute_ns (undef, 'a', 'b');
117			my $attr = $el->get_attribute_node_ns (undef, 'a');
118			my $sti = $attr->schema_type_info;
119			ok UNIVERSAL::isa ($sti, 'Message::IF::TypeInfo') ? 1 : 0, 1, 'sti if [2]';
120			ok $sti->type_name, undef, 'sti type_name [2]';
121			ok $sti->type_namespace, undef, 'sti type_namespace [2]';
122			}
123
124			{
125			my $el = $doc->create_element ('el');
126			$el->owner_document->dom_config->set_parameter
127			('schema-type' => q<http://www.w3.org/TR/REC-xml>);
128			$el->set_attribute_ns (undef, 'a', 'b');
129			my $attr = $el->get_attribute_node_ns (undef, 'a');
130			for (
131			[$attr->CDATA_ATTR, 'CDATA'],
132			[$attr->ID_ATTR, 'ID'],
133			[$attr->IDREF_ATTR, 'IDREF'],
134			[$attr->IDREFS_ATTR, 'IDREFS'],
135			[$attr->ENTITY_ATTR, 'ENTITY'],
136			[$attr->ENTITIES_ATTR, 'ENTITIES'],
137			[$attr->NOTATION_ATTR, 'NOTATION'],
138			[$attr->ENUMERATION_ATTR, 'ENUMERATION'],
139			[$attr->NMTOKEN_ATTR, 'NMTOKEN'],
140			[$attr->NMTOKENS_ATTR, 'NMTOKENS'],
141			) {
142			$attr->manakai_attribute_type ($_->[0]);
143			my $sti = $attr->schema_type_info;
144			ok UNIVERSAL::isa ($sti, 'Message::IF::TypeInfo') ? 1 : 0, 1,
145			'sti if '.$_->[1].' [3]';
146			ok $sti->type_name, $_->[1], 'sti type_name '.$_->[1].' [3]';
147			ok $sti->type_namespace, q<http://www.w3.org/TR/REC-xml>,
148			'sti type_namespace '.$_->[1].' [3]';
149			}
150
151			for (
152			[$attr->NO_TYPE_ATTR, 'NO_VALUE'],
153			[$attr->UNKNOWN_ATTR, 'UNKNOWN'],
154			) {
155			$attr->manakai_attribute_type ($_->[0]);
156			my $sti = $attr->schema_type_info;
157			ok UNIVERSAL::isa ($sti, 'Message::IF::TypeInfo') ? 1 : 0, 1,
158			'sti if '.$_->[1].' [3]';
159			ok $sti->type_name, undef, 'sti type_name '.$_->[1].' [3]';
160			ok $sti->type_namespace, undef, 'sti type_namespace '.$_->[1].' [3]';
161			}
162			}
163
164			## \|isId\|
165			{
166			my $attr = $doc->create_attribute ('a');
167			$attr->manakai_attribute_type ($attr->ID_ATTR);
168			ok $attr->is_id ? 1 : 0, 1, 'is_id [1]';
169			$attr->is_id (1);
170			ok $attr->is_id ? 1 : 0, 1, 'is_id [2]';
171			$attr->is_id (0);
172			ok $attr->is_id ? 1 : 0, 1, 'is_id [3]';
173			}
174
175			{
176			my $attr = $doc->create_attribute ('a');
177			for (
178			$attr->CDATA_ATTR,
179			$attr->IDREF_ATTR,
180			$attr->IDREFS_ATTR,
181			$attr->ENTITY_ATTR,
182			$attr->ENTITIES_ATTR,
183			$attr->NOTATION_ATTR,
184			$attr->ENUMERATION_ATTR,
185			$attr->NMTOKEN_ATTR,
186			$attr->NMTOKENS_ATTR,
187			$attr->NO_TYPE_ATTR,
188			$attr->UNKNOWN_ATTR,
189			) {
190			$attr->manakai_attribute_type ($_);
191			ok $attr->is_id ? 1 : 0, 0, 'is_id '.$_.' [1]';
192			$attr->is_id (1);
193			ok $attr->is_id ? 1 : 0, 1, 'is_id '.$_.' [2]';
194			$attr->is_id (0);
195			ok $attr->is_id ? 1 : 0, 0, 'is_id '.$_.' [3]';
196			}
197			}
198
199			{
200			my $attr = $doc->create_attribute ('xml:id');
201			ok $attr->is_id ? 1 : 0, 1, 'is_id xml:id [1]';
202			$attr->is_id (0);
203			ok $attr->is_id ? 1 : 0, 1, 'is_id xml:id [2]';
204			$attr->is_id (1);
205			ok $attr->is_id ? 1 : 0, 1, 'is_id xml:id [3]';
206			}
207
208			{
209			my $attr = $doc->create_attribute_ns
210			(q<http://www.w3.org/XML/1998/namespace>, 'xml:id');
211			ok $attr->is_id ? 1 : 0, 1, 'is_id xml:id [4]';
212			$attr->is_id (0);
213			ok $attr->is_id ? 1 : 0, 1, 'is_id xml:id [5]';
214			$attr->is_id (1);
215			ok $attr->is_id ? 1 : 0, 1, 'is_id xml:id [6]';
216			}
217
218	wakaba	1.1	=head1 LICENSE
219
220			Copyright 2007 Wakaba <w@suika.fam.cx>
221
222			This program is free software; you can redistribute it and/or
223			modify it under the same terms as Perl itself.
224
225			=cut
226
227	wakaba	1.2	## $Date: 2007/06/17 13:37:42 $