manakai/t/DOM-AttributeDefinition.t

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

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

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

for my $v (
  [a => undef],
  [abc => undef],
  ['a:b' => undef],
  [1 => 'INVALID_CHARACTER_ERR'],
  [1234 => 'INVALID_CHARACTER_ERR'],
  ["\x{3001}\x{3002}" => 'INVALID_CHARACTER_ERR'], ## XML 1.1 Name
  [':aa' => undef],
  [':1' => undef],
  ['a:' => undef],
  ["a:\x{3005}b" => undef], ## XML 1.0 Name, XML 1.1 QName
) {
  $doc->strict_error_checking (1);
  if (not defined $v->[1]) {
    try {
      my $dt = $doc->create_attribute_definition ($v->[0]);
      ok $dt->node_name, $v->[0], 'create_attribute_definition '.$v->[0];
    } catch Message::IF::DOMException with {
      my $e = shift;
      ok $e->type, undef, 'create_attribute_definition '.$v->[0];
    };
  } else {
    try {
      $doc->create_attribute_definition ($v->[0]);
      ok 0, 1, 'create_attribute_definition '.$v->[0];
    } catch Message::IF::DOMException with {
      my $e = shift;
      ok $e->type, $v->[1], 'create_attribute_definition '.$v->[0];
    };
  }
  $doc->strict_error_checking (0);
  my $dt = $doc->create_attribute_definition ($v->[0]);
  ok $dt->node_name, $v->[0], 'create_attribute_definition s '.$v->[0];
}
$doc->strict_error_checking (1);

my $ent = $doc->create_attribute_definition ('ad');

## 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],
                 [UNKNOWN_DEFAULT => 0],
                 [FIXED_DEFAULT => 1],
                 [REQUIRED_DEFAULT => 2],
                 [IMPLIED_DEFAULT => 3],
                 [EXPLICIT_DEFAULT => 4],
];
for (@$constants) {
  my $const_name = $_->[0];
  ok $ent->can ($const_name) ? 1 : 0, 1, "can ($const_name)";
  ok $ent->$const_name, $_->[1], $const_name;
}

for my $prop (qw/declared_type default_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';
}

## allowedToken
{
  my $at = $doc->create_attribute_definition ('ay');

  ok $at->can ('allowed_tokens') ? 1 : 0, 1, 'can allowedTokens';

  my $list = $at->allowed_tokens;
  ok UNIVERSAL::isa ($list, 'Message::IF::DOMStringList') ? 1 : 0, 1,
      'allowedTokens interface';
  ok 0+@$list, 0, 'allowedTokens @{} 0+';

  push @$list, 'NMTOKEN';
  ok $list->[0], 'NMTOKEN', 'allowedTokens->[0]';
  undef $list;

  my $list2 = $at->allowed_tokens;
  ok $list2->[0], 'NMTOKEN', 'allowedTokens->[0] 2';

  my $list3 = $at->allowed_tokens;
  my $at2 = $doc->create_attribute_definition ('at2');
  my $list4 = $at2->allowed_tokens;

  ok $list2 eq $list3 ? 1 : 0, 1, 'allowedTokens eq allowedTokens';
  ok $list2 ne $list3 ? 1 : 0, 0, 'allowedTokens ne allowedTokens';
  ok $list2 eq $list4 ? 1 : 0, 0, 'allowedTokens eq allowedTokens2';
  ok $list2 ne $list4 ? 1 : 0, 1, 'allowedTokens ne allowedTokens2';
}

=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 04:47:30 $
1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3			use Test;
4	wakaba	1.3	BEGIN { plan tests => 99 }
5	wakaba	1.1
6			require Message::DOM::DOMImplementation;
7			use Message::Util::Error;
8
9			my $dom = Message::DOM::DOMImplementation->____new;
10			my $doc = $dom->create_document;
11
12	wakaba	1.3	for my $v (
13			[a => undef],
14			[abc => undef],
15			['a:b' => undef],
16			[1 => 'INVALID_CHARACTER_ERR'],
17			[1234 => 'INVALID_CHARACTER_ERR'],
18			["\x{3001}\x{3002}" => 'INVALID_CHARACTER_ERR'], ## XML 1.1 Name
19			[':aa' => undef],
20			[':1' => undef],
21			['a:' => undef],
22			["a:\x{3005}b" => undef], ## XML 1.0 Name, XML 1.1 QName
23			) {
24			$doc->strict_error_checking (1);
25			if (not defined $v->[1]) {
26			try {
27			my $dt = $doc->create_attribute_definition ($v->[0]);
28			ok $dt->node_name, $v->[0], 'create_attribute_definition '.$v->[0];
29			} catch Message::IF::DOMException with {
30			my $e = shift;
31			ok $e->type, undef, 'create_attribute_definition '.$v->[0];
32			};
33			} else {
34			try {
35			$doc->create_attribute_definition ($v->[0]);
36			ok 0, 1, 'create_attribute_definition '.$v->[0];
37			} catch Message::IF::DOMException with {
38			my $e = shift;
39			ok $e->type, $v->[1], 'create_attribute_definition '.$v->[0];
40			};
41			}
42			$doc->strict_error_checking (0);
43			my $dt = $doc->create_attribute_definition ($v->[0]);
44			ok $dt->node_name, $v->[0], 'create_attribute_definition s '.$v->[0];
45			}
46			$doc->strict_error_checking (1);
47
48	wakaba	1.1	my $ent = $doc->create_attribute_definition ('ad');
49
50			## Constants
51			my $constants = [
52			[NO_TYPE_ATTR => 0],
53			[CDATA_ATTR => 1],
54			[ID_ATTR => 2],
55			[IDREF_ATTR => 3],
56			[IDREFS_ATTR => 4],
57			[ENTITY_ATTR => 5],
58			[ENTITIES_ATTR => 6],
59			[NMTOKEN_ATTR => 7],
60			[NMTOKENS_ATTR => 8],
61			[NOTATION_ATTR => 9],
62			[ENUMERATION_ATTR => 10],
63			[UNKNOWN_ATTR => 11],
64			[UNKNOWN_DEFAULT => 0],
65			[FIXED_DEFAULT => 1],
66			[REQUIRED_DEFAULT => 2],
67			[IMPLIED_DEFAULT => 3],
68			[EXPLICIT_DEFAULT => 4],
69			];
70			for (@$constants) {
71			my $const_name = $_->[0];
72			ok $ent->can ($const_name) ? 1 : 0, 1, "can ($const_name)";
73			ok $ent->$const_name, $_->[1], $const_name;
74			}
75
76			for my $prop (qw/declared_type default_type/) {
77			ok $ent->can ($prop) ? 1 : 0, 1, 'can ' . $prop;
78			local $^W = 0;
79
80			for (-3..10, 'abc', '') {
81			$ent->$prop ($_);
82			ok $ent->$prop, 0+$_, $prop . $_;
83			}
84
85			$ent->$prop (undef);
86			ok $ent->$prop, 0, $prop . ' undef';
87			}
88
89	wakaba	1.2	## allowedToken
90			{
91			my $at = $doc->create_attribute_definition ('ay');
92
93			ok $at->can ('allowed_tokens') ? 1 : 0, 1, 'can allowedTokens';
94
95			my $list = $at->allowed_tokens;
96			ok UNIVERSAL::isa ($list, 'Message::IF::DOMStringList') ? 1 : 0, 1,
97			'allowedTokens interface';
98			ok 0+@$list, 0, 'allowedTokens @{} 0+';
99
100			push @$list, 'NMTOKEN';
101			ok $list->[0], 'NMTOKEN', 'allowedTokens->[0]';
102			undef $list;
103
104			my $list2 = $at->allowed_tokens;
105			ok $list2->[0], 'NMTOKEN', 'allowedTokens->[0] 2';
106
107			my $list3 = $at->allowed_tokens;
108			my $at2 = $doc->create_attribute_definition ('at2');
109			my $list4 = $at2->allowed_tokens;
110
111			ok $list2 eq $list3 ? 1 : 0, 1, 'allowedTokens eq allowedTokens';
112			ok $list2 ne $list3 ? 1 : 0, 0, 'allowedTokens ne allowedTokens';
113			ok $list2 eq $list4 ? 1 : 0, 0, 'allowedTokens eq allowedTokens2';
114			ok $list2 ne $list4 ? 1 : 0, 1, 'allowedTokens ne allowedTokens2';
115			}
116
117	wakaba	1.1	=head1 LICENSE
118
119			Copyright 2007 Wakaba <w@suika.fam.cx>
120
121			This program is free software; you can redistribute it and/or
122			modify it under the same terms as Perl itself.
123
124			=cut
125
126	wakaba	1.3	## $Date: 2007/07/07 04:47:30 $