/[suikacvs]/messaging/manakai/t/DOM-DOMStringList.t
Suika

Contents of /messaging/manakai/t/DOM-DOMStringList.t

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.1 - (show annotations) (download) (as text)
Sat Jul 7 04:47:30 2007 UTC (17 years, 10 months ago) by wakaba
Branch: MAIN
CVS Tags: manakai-release-0-4-0, HEAD
File MIME type: application/x-troff 
++ manakai/t/ChangeLog	7 Jul 2007 04:46:19 -0000
2007-07-07  Wakaba  <wakaba@suika.fam.cx>

	* DOM-AttributeDefinition.t: Tests for |allowed_tokens|
	are added.

	* DOM-DOMStringList.t: New test script.

++ manakai/lib/Message/DOM/ChangeLog	7 Jul 2007 04:47:13 -0000
2007-07-07  Wakaba  <wakaba@suika.fam.cx>

	* AttributeDefinition.pm (allowed_tokens): Implemented.

	* DOMStringList.pm: New Perl module.
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 $
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24