manakai/t/DOM-DOMStringList.t

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

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

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

{
  my $at = $doc->create_attribute_definition ('ad');
  my $list = $at->allowed_tokens;

  ## length (0)
  ok 0+@$list, 0, 'DOMStringList @{} 0+ [0]';
  ok $list->length, 0, 'DOMStringList->length [0]';

  ## PUSH
  push @$list, 'String1';

  ## length (1)
  ok 0+@$list, 1, 'DOMStringList @{} 0+ [1]';
  ok $list->length, 1, 'DOMStringList->length [1]';

  ## FETCH
  ok $list->[0], 'String1', 'DOMStringList->[0] [1]';
  ok $list->item (0), 'String1', 'DOMStringList->item (0) [1]';

  ## PUSH
  push @$list, 'String2';

  ## length (2)
  ok 0+@$list, 2, 'DOMStringList @{} 0+ [2]';
  ok $list->length, 2, 'DOMStringList->length [2]';

  ## FETCH
  ok $list->[1], 'String2', 'DOMStringList->[1] [2]';
  ok $list->item (1), 'String2', 'DOMStringList->item (1) [2]';
  
  ## EXISTS
  ok exists $list->[0] ? 1 : 0, 1, 'DOMStringList exists 0 [2]';
  ok exists $list->[1] ? 1 : 0, 1, 'DOMStringList exists 1 [2]';
  ok exists $list->[2] ? 1 : 0, 0, 'DOMStringList exists 2 [2]';
  ok exists $list->[3] ? 1 : 0, 0, 'DOMStringList exists 3 [2]';

  ## DELETE
  delete $list->[0];
    
  ## FETCHSIZE
  ok 0+@$list, 1, 'DOMStringList @{} 0+ [3]';

  ## EXISTS
  ok exists $list->[0] ? 1 : 0, 1, 'DOMStringList exists 0 [3]';
  ok exists $list->[1] ? 1 : 0, 0, 'DOMStringList exists 1 [3]';
  ok exists $list->[2] ? 1 : 0, 0, 'DOMStringList exists 2 [3]';
  ok exists $list->[3] ? 1 : 0, 0, 'DOMStringList exists 3 [3]';

  ## FETCH
  ok $list->[0], 'String2', 'DOMStringList->[0] [3]';
  ok $list->[1], undef, 'DOMStringList->[1] [3]';
  
  ## STORE
  $list->[0] = 'String3';

  ## FETCH
  ok $list->[0], 'String3', 'DOMStringList->[0] [4]';
  ok $list->[1], undef, 'DOMStringList->[1] [4]';
 
  ## STORE
  $list->[1] = 'String4';
  ok $list->[0], 'String3', 'DOMStringList->[0] [5]';
  ok $list->[1], 'String4', 'DOMStringList->[1] [5]';

  $list->[2] = 'String5';
  ok $list->[0], 'String3', 'DOMStringList->[0] [6]';
  ok $list->[1], 'String4', 'DOMStringList->[1] [6]';
  ok $list->[2], 'String5', 'DOMStringList->[2] [6]';
  ok 0+@$list, 3, 'DOMStringList @{} 0+ [6]';

  ## contains
  ok $list->contains ('String1') ? 1 : 0, 0, 'DOMStringList contains 1 [6]';
  ok $list->contains ('String2') ? 1 : 0, 0, 'DOMStringList contains 2 [6]';
  ok $list->contains ('String3') ? 1 : 0, 1, 'DOMStringList contains 3 [6]';
  ok $list->contains ('String4') ? 1 : 0, 1, 'DOMStringList contains 4 [6]';
  ok $list->contains ('String5') ? 1 : 0, 1, 'DOMStringList contains 5 [6]';

  ## DELETE
  delete $list->[2];
  ok exists $list->[0] ? 1 : 0, 1, 'DOMStringList exists 0 [7]';
  ok exists $list->[1] ? 1 : 0, 1, 'DOMStringList exists 1 [7]';
  ok exists $list->[2] ? 1 : 0, 0, 'DOMStringList exists 2 [7]';
  ok exists $list->[3] ? 1 : 0, 0, 'DOMStringList exists 3 [7]';
  ok exists $list->[4] ? 1 : 0, 0, 'DOMStringList exists 4 [7]';
  ok 0+@$list, 2, 'DOMStringList @{} 0+ [7]';
}

{
  my $at1 = $doc->create_attribute_definition ('ad');
  my $list1 = $at1->allowed_tokens;
  my $at2 = $doc->create_attribute_definition ('ad');
  my $list2 = $at2->allowed_tokens;

  ok $list1 == $list1 ? 1 : 0, 1, 'a == a [0]';
  ok $list1 != $list1 ? 1 : 0, 0, 'a != a [0]';
  ok $list1 eq $list1 ? 1 : 0, 1, 'a eq a [0]';
  ok $list1 ne $list1 ? 1 : 0, 0, 'a ne a [0]';
  ok $list1 == $list2 ? 1 : 0, 1, 'a == b [0]';
  ok $list1 != $list2 ? 1 : 0, 0, 'a != b [0]';
  ok $list1 eq $list2 ? 1 : 0, 0, 'a eq b [0]';
  ok $list1 ne $list2 ? 1 : 0, 1, 'a ne b [0]';

  push @$list1, '';
  push @$list2, '';
  ok $list1 == $list2 ? 1 : 0, 1, 'a == b [1]';
  ok $list1 != $list2 ? 1 : 0, 0, 'a != b [1]';
  ok $list1 eq $list2 ? 1 : 0, 0, 'a eq b [1]';
  ok $list1 ne $list2 ? 1 : 0, 1, 'a ne b [1]';

  push @$list1, 'str';
  push @$list2, 'str';
  ok $list1 == $list2 ? 1 : 0, 1, 'a == b [2]';
  ok $list1 != $list2 ? 1 : 0, 0, 'a != b [2]';
  ok $list1 eq $list2 ? 1 : 0, 0, 'a eq b [2]';
  ok $list1 ne $list2 ? 1 : 0, 1, 'a ne b [2]';

  push @$list1, 'a';
  ok $list1 == $list2 ? 1 : 0, 0, 'a == b [2]';
  ok $list1 != $list2 ? 1 : 0, 1, 'a != b [2]';
  ok $list1 eq $list2 ? 1 : 0, 0, 'a eq b [2]';
  ok $list1 ne $list2 ? 1 : 0, 1, 'a ne b [2]';

  push @$list2, 'b';
  ok $list1 == $list2 ? 1 : 0, 0, 'a == b [3]';
  ok $list1 != $list2 ? 1 : 0, 1, 'a != b [3]';
  ok $list1 eq $list2 ? 1 : 0, 0, 'a eq b [3]';
  ok $list1 ne $list2 ? 1 : 0, 1, 'a ne b [3]';

  push @$list1, 'b';
  push @$list2, 'a';
  ok $list1 == $list2 ? 1 : 0, 1, 'a == b [4]';
  ok $list1 != $list2 ? 1 : 0, 0, 'a != b [4]';
  ok $list1 eq $list2 ? 1 : 0, 0, 'a eq b [4]';
  ok $list1 ne $list2 ? 1 : 0, 1, 'a ne b [4]';
}

=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			BEGIN { plan tests => 68 }
5
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			{
13			my $at = $doc->create_attribute_definition ('ad');
14			my $list = $at->allowed_tokens;
15
16			## length (0)
17			ok 0+@$list, 0, 'DOMStringList @{} 0+ [0]';
18			ok $list->length, 0, 'DOMStringList->length [0]';
19
20			## PUSH
21			push @$list, 'String1';
22
23			## length (1)
24			ok 0+@$list, 1, 'DOMStringList @{} 0+ [1]';
25			ok $list->length, 1, 'DOMStringList->length [1]';
26
27			## FETCH
28			ok $list->[0], 'String1', 'DOMStringList->[0] [1]';
29			ok $list->item (0), 'String1', 'DOMStringList->item (0) [1]';
30
31			## PUSH
32			push @$list, 'String2';
33
34			## length (2)
35			ok 0+@$list, 2, 'DOMStringList @{} 0+ [2]';
36			ok $list->length, 2, 'DOMStringList->length [2]';
37
38			## FETCH
39			ok $list->[1], 'String2', 'DOMStringList->[1] [2]';
40			ok $list->item (1), 'String2', 'DOMStringList->item (1) [2]';
41
42			## EXISTS
43			ok exists $list->[0] ? 1 : 0, 1, 'DOMStringList exists 0 [2]';
44			ok exists $list->[1] ? 1 : 0, 1, 'DOMStringList exists 1 [2]';
45			ok exists $list->[2] ? 1 : 0, 0, 'DOMStringList exists 2 [2]';
46			ok exists $list->[3] ? 1 : 0, 0, 'DOMStringList exists 3 [2]';
47
48			## DELETE
49			delete $list->[0];
50
51			## FETCHSIZE
52			ok 0+@$list, 1, 'DOMStringList @{} 0+ [3]';
53
54			## EXISTS
55			ok exists $list->[0] ? 1 : 0, 1, 'DOMStringList exists 0 [3]';
56			ok exists $list->[1] ? 1 : 0, 0, 'DOMStringList exists 1 [3]';
57			ok exists $list->[2] ? 1 : 0, 0, 'DOMStringList exists 2 [3]';
58			ok exists $list->[3] ? 1 : 0, 0, 'DOMStringList exists 3 [3]';
59
60			## FETCH
61			ok $list->[0], 'String2', 'DOMStringList->[0] [3]';
62			ok $list->[1], undef, 'DOMStringList->[1] [3]';
63
64			## STORE
65			$list->[0] = 'String3';
66
67			## FETCH
68			ok $list->[0], 'String3', 'DOMStringList->[0] [4]';
69			ok $list->[1], undef, 'DOMStringList->[1] [4]';
70
71			## STORE
72			$list->[1] = 'String4';
73			ok $list->[0], 'String3', 'DOMStringList->[0] [5]';
74			ok $list->[1], 'String4', 'DOMStringList->[1] [5]';
75
76			$list->[2] = 'String5';
77			ok $list->[0], 'String3', 'DOMStringList->[0] [6]';
78			ok $list->[1], 'String4', 'DOMStringList->[1] [6]';
79			ok $list->[2], 'String5', 'DOMStringList->[2] [6]';
80			ok 0+@$list, 3, 'DOMStringList @{} 0+ [6]';
81
82			## contains
83			ok $list->contains ('String1') ? 1 : 0, 0, 'DOMStringList contains 1 [6]';
84			ok $list->contains ('String2') ? 1 : 0, 0, 'DOMStringList contains 2 [6]';
85			ok $list->contains ('String3') ? 1 : 0, 1, 'DOMStringList contains 3 [6]';
86			ok $list->contains ('String4') ? 1 : 0, 1, 'DOMStringList contains 4 [6]';
87			ok $list->contains ('String5') ? 1 : 0, 1, 'DOMStringList contains 5 [6]';
88
89			## DELETE
90			delete $list->[2];
91			ok exists $list->[0] ? 1 : 0, 1, 'DOMStringList exists 0 [7]';
92			ok exists $list->[1] ? 1 : 0, 1, 'DOMStringList exists 1 [7]';
93			ok exists $list->[2] ? 1 : 0, 0, 'DOMStringList exists 2 [7]';
94			ok exists $list->[3] ? 1 : 0, 0, 'DOMStringList exists 3 [7]';
95			ok exists $list->[4] ? 1 : 0, 0, 'DOMStringList exists 4 [7]';
96			ok 0+@$list, 2, 'DOMStringList @{} 0+ [7]';
97			}
98
99			{
100			my $at1 = $doc->create_attribute_definition ('ad');
101			my $list1 = $at1->allowed_tokens;
102			my $at2 = $doc->create_attribute_definition ('ad');
103			my $list2 = $at2->allowed_tokens;
104
105			ok $list1 == $list1 ? 1 : 0, 1, 'a == a [0]';
106			ok $list1 != $list1 ? 1 : 0, 0, 'a != a [0]';
107			ok $list1 eq $list1 ? 1 : 0, 1, 'a eq a [0]';
108			ok $list1 ne $list1 ? 1 : 0, 0, 'a ne a [0]';
109			ok $list1 == $list2 ? 1 : 0, 1, 'a == b [0]';
110			ok $list1 != $list2 ? 1 : 0, 0, 'a != b [0]';
111			ok $list1 eq $list2 ? 1 : 0, 0, 'a eq b [0]';
112			ok $list1 ne $list2 ? 1 : 0, 1, 'a ne b [0]';
113
114			push @$list1, '';
115			push @$list2, '';
116			ok $list1 == $list2 ? 1 : 0, 1, 'a == b [1]';
117			ok $list1 != $list2 ? 1 : 0, 0, 'a != b [1]';
118			ok $list1 eq $list2 ? 1 : 0, 0, 'a eq b [1]';
119			ok $list1 ne $list2 ? 1 : 0, 1, 'a ne b [1]';
120
121			push @$list1, 'str';
122			push @$list2, 'str';
123			ok $list1 == $list2 ? 1 : 0, 1, 'a == b [2]';
124			ok $list1 != $list2 ? 1 : 0, 0, 'a != b [2]';
125			ok $list1 eq $list2 ? 1 : 0, 0, 'a eq b [2]';
126			ok $list1 ne $list2 ? 1 : 0, 1, 'a ne b [2]';
127
128			push @$list1, 'a';
129			ok $list1 == $list2 ? 1 : 0, 0, 'a == b [2]';
130			ok $list1 != $list2 ? 1 : 0, 1, 'a != b [2]';
131			ok $list1 eq $list2 ? 1 : 0, 0, 'a eq b [2]';
132			ok $list1 ne $list2 ? 1 : 0, 1, 'a ne b [2]';
133
134			push @$list2, 'b';
135			ok $list1 == $list2 ? 1 : 0, 0, 'a == b [3]';
136			ok $list1 != $list2 ? 1 : 0, 1, 'a != b [3]';
137			ok $list1 eq $list2 ? 1 : 0, 0, 'a eq b [3]';
138			ok $list1 ne $list2 ? 1 : 0, 1, 'a ne b [3]';
139
140			push @$list1, 'b';
141			push @$list2, 'a';
142			ok $list1 == $list2 ? 1 : 0, 1, 'a == b [4]';
143			ok $list1 != $list2 ? 1 : 0, 0, 'a != b [4]';
144			ok $list1 eq $list2 ? 1 : 0, 0, 'a eq b [4]';
145			ok $list1 ne $list2 ? 1 : 0, 1, 'a ne b [4]';
146			}
147
148			=head1 LICENSE
149
150			Copyright 2007 Wakaba <w@suika.fam.cx>
151
152			This program is free software; you can redistribute it and/or
153			modify it under the same terms as Perl itself.
154
155			=cut
156
157			## $Date: 2007/06/17 13:37:42 $