/[suikacvs]/messaging/manakai/lib/Message/Util/ManakaiNodeTest.dis
Suika

Contents of /messaging/manakai/lib/Message/Util/ManakaiNodeTest.dis

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.5 - (hide annotations) (download)
Fri Sep 21 08:10:06 2007 UTC (17 years, 9 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
Changes since 1.4: +1 -1 lines
FILE REMOVED 
++ manakai/bin/ChangeLog	21 Sep 2007 07:55:21 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* daf.pl, mkdisdump.pl, grep-dis.pl, mkdommemlist.pl: Removed.

++ manakai/lib/Message/IMT/ChangeLog	21 Sep 2007 08:02:20 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* InternetMediaType.pm: Don't raise CoreException even if
	a read-only attribute is attempted to be modified.

++ manakai/lib/Message/Markup/ChangeLog	21 Sep 2007 07:46:59 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* SuikaWikiConfig21.dis, SuikaWikiConfig21.pm, common.dis,
	H2H.dis: Removed.

++ manakai/lib/Message/Util/ChangeLog	21 Sep 2007 07:44:10 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (clean): Don't remove generated files.

	* ManakaiNode.dis, ManakaiNodeTest.dis, PerlCode.dis,
	PerlCode.pm, ManakaiNode.pm, common.dis, DIS.dis, DIS.pm: Removed.

	* DIS/, AutoLoad/: Removed.

++ manakai/lib/Message/Util/Error/ChangeLog	21 Sep 2007 07:44:55 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* Core.dis, DOMException.pm, DOMException.dis: Removed.

++ manakai/lib/Message/Util/Formatter/ChangeLog	21 Sep 2007 08:09:07 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* Base.pm (___error_def): Error description key names
	are updated.

	* Muf2003.dis: Removed.

++ manakai/lib/manakai/ChangeLog	21 Sep 2007 07:52:20 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* DISLang.dis, Document.dis, NaturalLanguage.dis, DISMarkup.dis,
	ECMAScript.dis, Test.dis, Charset.dis, DISPerl.dis, Java.dis,
	XML.dis, DISCore.dis, DISRDF.dis, DISIDL.dis, DISSource.dis,
	Message.dis, daf-perl-t.pl, daf-dtd-modules.pl, daf-perl-pm.pl,
	dis-catalog, mndebug.pl: Removed.

++ manakai/t/ChangeLog	21 Sep 2007 08:00:31 -0000
2007-09-21  Wakaba  <wakaba@suika.fam.cx>

	* util-mnode.t: Removed.
1 wakaba 1.1 Module:
2     @QName: Util|ManakaiNodeTest
3     @FullName:
4     @@lang:en
5     @@@:
6     <Module::Util|ManakaiNode> Test Module
7    
8     @Namespace:
9     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ManakaiNodeTest#
10    
11     @DISCore:author: DISCore|Wakaba
12     @License: license|Perl+MPL
13     @Date:
14 wakaba 1.5 $Date: 2006/12/30 12:00:43 $
15 wakaba 1.1
16     @Require:
17     @@Module:
18     @@@QName: Util|ManakaiNode
19 wakaba 1.3 @@Module:
20     @@@QName: DISlib|Test
21 wakaba 1.1
22     Namespace:
23     @dis:
24     http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--
25     @DISlib:
26     http://suika.fam.cx/~wakaba/archive/2004/dis/
27     @kwd:
28     http://suika.fam.cx/~wakaba/archive/2005/rfc2119/
29     @lang:
30     http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#
31     @license:
32     http://suika.fam.cx/~wakaba/archive/2004/8/18/license#
33     @ManakaiDOM:
34     http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#
35     @mn:
36     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ManakaiNode#
37     @mnt:
38     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ManakaiNodeTest#
39     @rdf:
40     http://www.w3.org/1999/02/22-rdf-syntax-ns#
41     @rdfs:
42     http://www.w3.org/2000/01/rdf-schema#
43     @test:
44     http://suika.fam.cx/~wakaba/archive/2004/dis/Test#
45     @Util:
46     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/
47    
48     ElementTypeBinding:
49     @Name: ClsDef
50     @ElementType:
51     dis:ResourceDef
52     @ShadowContent:
53     @@rdf:type:
54     @@@@:
55     dis:MultipleResource
56     @@@ForCheck: !ManakaiDOM|ForClass !ManakaiDOM|ForIF
57     @@resourceFor: ManakaiDOM|ForClass
58     @@rdf:type:
59     @@@@: DISLang|Class
60     @@@ForCheck: ManakaiDOM|ForClass
61    
62     ElementTypeBinding:
63     @Name: IntMethod
64     @ElementType:
65     dis:ResourceDef
66     @ShadowContent:
67     @@rdf:type:
68     DISLang:Method
69     @@ManakaiDOM:isForInternal:1
70    
71     ElementTypeBinding:
72     @Name: Method
73     @ElementType:
74     dis:ResourceDef
75     @ShadowContent:
76     @@rdf:type:
77     DISLang:Method
78    
79     ElementTypeBinding:
80     @Name: Return
81     @ElementType:
82     dis:ResourceDef
83     @ShadowContent:
84     @@rdf:type:
85     DISLang:MethodReturn
86    
87     ElementTypeBinding:
88     @Name: Param
89     @ElementType:
90     dis:ResourceDef
91     @ShadowContent:
92     @@rdf:type:
93     DISLang:MethodParameter
94    
95     ElementTypeBinding:
96     @Name: PerlDef
97     @ElementType:
98     dis:Def
99     @ShadowContent:
100     @@ContentType:
101     lang:Perl
102    
103     ElementTypeBinding:
104     @Name: enDesc
105     @ElementType:
106     dis:Description
107     @ShadowContent:
108     @@lang:en
109    
110     ElementTypeBinding:
111     @Name: Test
112     @ElementType:
113     dis:ResourceDef
114     @ShadowContent:
115     @@rdf:type: test|StandaloneTest
116    
117     ElementTypeBinding:
118     @Name: ClsQName
119     @ElementType:
120     dis:QName
121     @ShadowContent:
122     @@ForCheck: ManakaiDOM|ForClass
123    
124     ElementTypeBinding:
125     @Name: ClsISA
126     @ElementType:
127     dis:ISA
128     @ShadowContent:
129     @@ForCheck: ManakaiDOM|ForClass
130    
131     PropDef:
132     @QName: mnt|parent
133    
134     PropDef:
135     @QName: mnt|children
136    
137     ElementTypeBinding:
138     @Name: PropDef
139     @ElementType:
140     dis:ResourceDef
141     @ShadowContent:
142     @@rdf:type: rdf|Property
143    
144     ClsDef:
145     @ClsQName: Node1
146    
147     @ClsISA: mn|ManakaiNodeRef
148    
149     @enDesc:
150     Simple tree pattern test.
151    
152     @IntMethod:
153     @@Name: newStem
154     @@ManakaiDOM:isStatic: 1
155     @@Return:
156     @@@Type: mn|NodeStem
157     @@@PerlDef:
158     $r = <ClassM::mn|ManakaiNodeStem.new> (<ClassName::Node1>);
159 wakaba 1.2 $r->{<H::mnt|children>} = [];
160     $r->{<H::mnt|attr>} = {};
161 wakaba 1.1 @mn:origin0: mnt|parent
162     @mn:subnode1: mnt|children
163 wakaba 1.2 @mn:subnode2: mnt|attr
164 wakaba 1.1
165     @IntMethod:
166     @@Name: getRef
167     @@ManakaiDOM:isStatic: 1
168     @@Param:
169     @@@Name: stem
170     @@@Type: mn|NodeStem
171     @@Return:
172     @@@Type: Node1
173     @@@PerlDef:
174     __CODE{mn|getNewReference::
175     $object => $stem,
176     $ref => $r,
177     $class => {<ClassName::Node1>},
178     }__;
179    
180     @Test:
181     @@QName: Node1.test1
182     @@PerlDef:
183     $test->id ('get.stem');
184     my $stem = <ClassM::Node1.newStem>;
185     $test->assert_isa ($stem, <IFName::mn|NodeStem>);
186     $test->assert_not_null ($stem->{<H::mn:nodeID>});
187     $test->assert_num_equals
188     (actual_value => $stem->{<H::mn:rc>},
189     expected_value => 0);
190     $test->assert_isa ($stem->{<H::mn:groveReferenceCounter>}, 'SCALAR');
191     $test->assert_num_equals
192     (actual_value => ${$stem->{<H::mn:groveReferenceCounter>}},
193     expected_value => 0);
194    
195     $test->id ('get.ref');
196     my $ref = <ClassM::Node1.getRef> ($stem);
197     $test->assert_isa ($ref, <IFName::mn|NodeRef>);
198     $test->assert_isa ($ref, <IFName::Node1>);
199     $test->assert_isa ($ref->{<H::mn:node>}, <IFName::mn|NodeStem>);
200     $test->assert_equals
201     ($ref->{<H::mn:node>}->{<H::mn:nodeID>},
202     $stem->{<H::mn:nodeID>});
203     $test->assert_num_equals
204     (actual_value => $stem->{<H::mn:rc>},
205     expected_value => 1);
206     $test->assert_isa ($stem->{<H::mn:groveReferenceCounter>}, 'SCALAR');
207     $test->assert_num_equals
208     (actual_value => ${$stem->{<H::mn:groveReferenceCounter>}},
209     expected_value => 1);
210    
211 wakaba 1.2 @Method:
212     @@Name: append
213     @@Param:
214     @@@Name: newChild
215     @@@Type: Node1
216     @@Return:
217     @@@PerlDef:
218     $self->{<H::mn:node>}-><M::mn:NodeStem.importTree>
219     ($newChild->{<H::mn:node>});
220     push @{$self->{<H::mn:node>}->{<H::mnt:children>}},
221     $newChild->{<H::mn:node>};
222     $newChild->{<H::mn:node>}->{<H::mnt:parent>} = $self->{<H::mn:node>};
223    
224     @@Test:
225     @@@QName: Node1.append.test
226     @@@PerlDef:
227     $test->id ('node.1');
228     my $stem1 = <ClassM::Node1.newStem>;
229     my $ref1 = <ClassM::Node1.getRef> ($stem1);
230     $test->assert_num_equals
231     (actual_value => $stem1->{<H::mn:rc>},
232     expected_value => 1);
233     $test->assert_num_equals
234     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
235     expected_value => 1);
236    
237     $test->id ('node.2');
238     my $stem2 = <ClassM::Node1.newStem>;
239     my $ref2 = <ClassM::Node1.getRef> ($stem2);
240     $test->assert_num_equals
241     (actual_value => $stem2->{<H::mn:rc>},
242     expected_value => 1);
243     $test->assert_num_equals
244     (actual_value => ${$stem2->{<H::mn:groveReferenceCounter>}},
245     expected_value => 1);
246    
247     $test->id ('diff.tid');
248     $test->assert_not_equals
249     (${$stem1->{<H::mn:treeID>}},
250     ${$stem2->{<H::mn:treeID>}});
251    
252     $test->id ('append');
253     $ref1-><M::Node1.append> ($ref2);
254    
255     $test->id ('appended.tid');
256     $test->assert_equals
257     (${$stem1->{<H::mn:treeID>}},
258     ${$stem2->{<H::mn:treeID>}});
259    
260     $test->id ('appended.rc');
261     $test->assert_num_equals
262     (actual_value => $stem1->{<H::mn:rc>},
263     expected_value => 1);
264     $test->assert_num_equals
265     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
266     expected_value => 2);
267     $test->assert_num_equals
268     (actual_value => $stem2->{<H::mn:rc>},
269     expected_value => 1);
270     $test->assert_num_equals
271     (actual_value => ${$stem2->{<H::mn:groveReferenceCounter>}},
272     expected_value => 2);
273    
274     @Method:
275     @@Name: set
276     @@Param:
277     @@@Name: ns
278 wakaba 1.4 @@@Type: DISPerl|String
279 wakaba 1.2 @@Param:
280     @@@Name: name
281 wakaba 1.4 @@@Type: DISPerl|String
282 wakaba 1.2 @@Param:
283     @@@Name: newChild
284     @@@Type: Node1
285     @@Return:
286     @@@PerlDef:
287     $self->{<H::mn:node>}-><M::mn:NodeStem.importTree>
288     ($newChild->{<H::mn:node>});
289     $self->{<H::mn:node>}->{<H::mnt:attr>}->{$ns}->{$name}
290     = $newChild->{<H::mn:node>};
291     $newChild->{<H::mn:node>}->{<H::mnt:parent>} = $self->{<H::mn:node>};
292    
293     @@Test:
294     @@@QName: Node1.set.test
295     @@@PerlDef:
296     $test->id ('node.1');
297     my $stem1 = <ClassM::Node1.newStem>;
298     my $ref1 = <ClassM::Node1.getRef> ($stem1);
299     $test->assert_num_equals
300     (actual_value => $stem1->{<H::mn:rc>},
301     expected_value => 1);
302     $test->assert_num_equals
303     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
304     expected_value => 1);
305    
306     $test->id ('node.2');
307     my $stem2 = <ClassM::Node1.newStem>;
308     my $ref2 = <ClassM::Node1.getRef> ($stem2);
309     $test->assert_num_equals
310     (actual_value => $stem2->{<H::mn:rc>},
311     expected_value => 1);
312     $test->assert_num_equals
313     (actual_value => ${$stem2->{<H::mn:groveReferenceCounter>}},
314     expected_value => 1);
315    
316     $test->id ('diff.tid');
317     $test->assert_not_equals
318     (${$stem1->{<H::mn:treeID>}},
319     ${$stem2->{<H::mn:treeID>}});
320    
321     $test->id ('append');
322     $ref1-><M::Node1.set> ('uri', 'name', $ref2);
323    
324     $test->id ('appended.tid');
325     $test->assert_equals
326     (${$stem1->{<H::mn:treeID>}},
327     ${$stem2->{<H::mn:treeID>}});
328    
329     $test->id ('appended.rc');
330     $test->assert_num_equals
331     (actual_value => $stem1->{<H::mn:rc>},
332     expected_value => 1);
333     $test->assert_num_equals
334     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
335     expected_value => 2);
336     $test->assert_num_equals
337     (actual_value => $stem2->{<H::mn:rc>},
338     expected_value => 1);
339     $test->assert_num_equals
340     (actual_value => ${$stem2->{<H::mn:groveReferenceCounter>}},
341     expected_value => 2);
342 wakaba 1.1 ##Node1
343    
344     ClsDef:
345     @ClsQName: Node2
346    
347     @ClsISA: mn|ManakaiNodeRef
348    
349     @enDesc:
350     Tree + ownwerDocument pattern test.
351    
352     @IntMethod:
353     @@Name: newStem
354     @@ManakaiDOM:isStatic: 1
355     @@Return:
356     @@@Type: mn|NodeStem
357     @@@PerlDef:
358     $r = <ClassM::mn|ManakaiNodeStem.new> (<ClassName::Node2>);
359 wakaba 1.2 $r->{<H::mnt|children>} = [];
360     $r->{<H::mnt|attr>} = {};
361 wakaba 1.1 @mn:origin0: mnt|parent
362     @mn:subnode1: mnt|children
363     @mn:xrefnode0: mnt|owner
364 wakaba 1.2 @mn:subnode2: mnt|attr
365 wakaba 1.1
366     @IntMethod:
367     @@Name: getRef
368     @@ManakaiDOM:isStatic: 1
369     @@Param:
370     @@@Name: stem
371     @@@Type: mn|NodeStem
372     @@Return:
373     @@@Type: Node2
374     @@@PerlDef:
375     __CODE{mn|getNewReference::
376     $object => $stem,
377     $ref => $r,
378     $class => {<ClassName::Node2>},
379     }__;
380 wakaba 1.2
381     @Method:
382     @@Name: append
383     @@Param:
384     @@@Name: newChild
385     @@@Type: Node2
386     @@Return:
387     @@@PerlDef:
388     $self->{<H::mn:node>}-><M::mn:NodeStem.importTree>
389     ($newChild->{<H::mn:node>});
390     push @{$self->{<H::mn:node>}->{<H::mnt:children>}},
391     $newChild->{<H::mn:node>};
392     $newChild->{<H::mn:node>}->{<H::mnt:parent>} = $self->{<H::mn:node>};
393    
394     @@Test:
395     @@@QName: Node2.append.test.1
396     @@@PerlDef:
397     $test->id ('node.1');
398     my $stem1 = <ClassM::Doc2.newStem>;
399     my $ref1 = <ClassM::Doc2.getRef> ($stem1);
400     $test->assert_num_equals
401     (actual_value => $stem1->{<H::mn:rc>},
402     expected_value => 1);
403     $test->assert_num_equals
404     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
405     expected_value => 1);
406    
407     $test->id ('node.2');
408     my $ref2 = $ref1-><M::Doc2.createNode>;
409     my $stem2 = $ref2->{<H::mn:node>};
410     $test->assert_num_equals
411     (actual_value => $stem2->{<H::mn:rc>},
412     expected_value => 1);
413     $test->assert_num_equals
414     (actual_value => ${$stem2->{<H::mn:groveReferenceCounter>}},
415     expected_value => 1);
416    
417     $test->id ('diff.tid');
418     $test->assert_not_equals
419     (${$stem1->{<H::mn:treeID>}},
420     ${$stem2->{<H::mn:treeID>}});
421     $test->assert_num_equals
422     (actual_value => $stem1->{<H::mn:rc>},
423     expected_value => 2);
424     $test->assert_num_equals
425     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
426     expected_value => 2);
427    
428     $test->id ('append');
429     $ref1-><M::Node2.append> ($ref2);
430    
431     $test->id ('appended.tid');
432     $test->assert_equals
433     (${$stem1->{<H::mn:treeID>}},
434     ${$stem2->{<H::mn:treeID>}});
435    
436     $test->id ('appended.rc');
437     $test->assert_num_equals
438     (actual_value => $stem1->{<H::mn:rc>},
439     expected_value => 1);
440     $test->assert_num_equals
441     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
442     expected_value => 2);
443     $test->assert_num_equals
444     (actual_value => $stem2->{<H::mn:rc>},
445     expected_value => 1);
446     $test->assert_num_equals
447     (actual_value => ${$stem2->{<H::mn:groveReferenceCounter>}},
448     expected_value => 2);
449    
450     @@Test:
451     @@@QName: Node2.append.test.2
452     @@@PerlDef:
453     $test->id ('node.1');
454     my $stem1 = <ClassM::Doc2.newStem>;
455     my $ref1 = <ClassM::Doc2.getRef> ($stem1);
456     $test->assert_num_equals
457     (actual_value => $stem1->{<H::mn:rc>},
458     expected_value => 1);
459     $test->assert_num_equals
460     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
461     expected_value => 1);
462    
463     $test->id ('node.2');
464     my $ref2 = $ref1-><M::Doc2.createNode>;
465     my $stem2 = $ref2->{<H::mn:node>};
466     $test->assert_num_equals
467     (actual_value => $stem2->{<H::mn:rc>},
468     expected_value => 1);
469     $test->assert_num_equals
470     (actual_value => ${$stem2->{<H::mn:groveReferenceCounter>}},
471     expected_value => 1);
472    
473     $test->id ('node.3');
474     my $ref3 = $ref1-><M::Doc2.createNode>;
475     my $stem3 = $ref3->{<H::mn:node>};
476     $test->assert_num_equals
477     (actual_value => $stem3->{<H::mn:rc>},
478     expected_value => 1);
479     $test->assert_num_equals
480     (actual_value => ${$stem3->{<H::mn:groveReferenceCounter>}},
481     expected_value => 1);
482    
483     $test->id ('diff.tid');
484     $test->assert_not_equals
485     (${$stem1->{<H::mn:treeID>}},
486     ${$stem2->{<H::mn:treeID>}});
487     $test->assert_not_equals
488     (${$stem2->{<H::mn:treeID>}},
489     ${$stem3->{<H::mn:treeID>}});
490     $test->assert_not_equals
491     (${$stem3->{<H::mn:treeID>}},
492     ${$stem1->{<H::mn:treeID>}});
493     $test->assert_num_equals
494     (actual_value => $stem1->{<H::mn:rc>},
495     expected_value => 3);
496     $test->assert_num_equals
497     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
498     expected_value => 3);
499    
500     $test->id ('append');
501     $ref2-><M::Node2.append> ($ref3);
502    
503     $test->id ('appended.tid');
504     $test->assert_not_equals
505     (${$stem1->{<H::mn:treeID>}},
506     ${$stem2->{<H::mn:treeID>}});
507     $test->assert_equals
508     (${$stem2->{<H::mn:treeID>}},
509     ${$stem3->{<H::mn:treeID>}});
510    
511     $test->id ('appended.rc');
512     $test->assert_num_equals
513     (actual_value => $stem1->{<H::mn:rc>},
514     expected_value => 3);
515     $test->assert_num_equals
516     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
517     expected_value => 3);
518     $test->assert_num_equals
519     (actual_value => $stem2->{<H::mn:rc>},
520     expected_value => 1);
521     $test->assert_num_equals
522     (actual_value => ${$stem2->{<H::mn:groveReferenceCounter>}},
523     expected_value => 2);
524     $test->assert_num_equals
525     (actual_value => $stem3->{<H::mn:rc>},
526     expected_value => 1);
527     $test->assert_num_equals
528     (actual_value => ${$stem3->{<H::mn:groveReferenceCounter>}},
529     expected_value => 2);
530    
531     $test->id ('stem1.unlinked');
532     undef $ref1;
533     $test->assert_num_equals
534     (actual_value => $stem1->{<H::mn:rc>},
535     expected_value => 2);
536     $test->assert_num_equals
537     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
538     expected_value => 2);
539    
540     $test->id ('stem2.unlinked');
541     undef $ref2;
542     $test->assert_num_equals
543     (actual_value => $stem1->{<H::mn:rc>},
544     expected_value => 2);
545     $test->assert_num_equals
546     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
547     expected_value => 2);
548     $test->assert_num_equals
549     (actual_value => $stem2->{<H::mn:rc>},
550     expected_value => 0);
551     $test->assert_num_equals
552     (actual_value => ${$stem2->{<H::mn:groveReferenceCounter>}},
553     expected_value => 1);
554     $test->assert_num_equals
555     (actual_value => $stem3->{<H::mn:rc>},
556     expected_value => 1);
557     $test->assert_num_equals
558     (actual_value => ${$stem3->{<H::mn:groveReferenceCounter>}},
559     expected_value => 1);
560    
561     $test->id ('stem3.unlinked');
562     undef $ref3;
563     $test->assert_null ($stem1->{<H::mn:rc>});
564     $test->assert_null ($stem2->{<H::mn:rc>});
565     $test->assert_null ($stem3->{<H::mn:rc>});
566     $test->assert_null ($stem1->{<H::mn:groveReferenceCounter>});
567     $test->assert_null ($stem2->{<H::mn:groveReferenceCounter>});
568     $test->assert_null ($stem3->{<H::mn:groveReferenceCounter>});
569    
570     @@Test:
571     @@@QName: Node2.append.test.3
572     @@@PerlDef:
573     $test->id ('node.1');
574     my $stem1 = <ClassM::Doc2.newStem>;
575     my $ref1 = <ClassM::Doc2.getRef> ($stem1);
576     $test->assert_num_equals
577     (actual_value => $stem1->{<H::mn:rc>},
578     expected_value => 1);
579     $test->assert_num_equals
580     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
581     expected_value => 1);
582    
583     $test->id ('node.2');
584     my $ref2 = $ref1-><M::Doc2.createNode>;
585     my $stem2 = $ref2->{<H::mn:node>};
586     $test->assert_num_equals
587     (actual_value => $stem2->{<H::mn:rc>},
588     expected_value => 1);
589     $test->assert_num_equals
590     (actual_value => ${$stem2->{<H::mn:groveReferenceCounter>}},
591     expected_value => 1);
592    
593     $test->id ('node.3');
594     my $ref3 = $ref1-><M::Doc2.createNode>;
595     my $stem3 = $ref3->{<H::mn:node>};
596     $test->assert_num_equals
597     (actual_value => $stem3->{<H::mn:rc>},
598     expected_value => 1);
599     $test->assert_num_equals
600     (actual_value => ${$stem3->{<H::mn:groveReferenceCounter>}},
601     expected_value => 1);
602    
603     $test->id ('diff.tid');
604     $test->assert_not_equals
605     (${$stem1->{<H::mn:treeID>}},
606     ${$stem2->{<H::mn:treeID>}});
607     $test->assert_not_equals
608     (${$stem2->{<H::mn:treeID>}},
609     ${$stem3->{<H::mn:treeID>}});
610     $test->assert_not_equals
611     (${$stem3->{<H::mn:treeID>}},
612     ${$stem1->{<H::mn:treeID>}});
613     $test->assert_num_equals
614     (actual_value => $stem1->{<H::mn:rc>},
615     expected_value => 3);
616     $test->assert_num_equals
617     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
618     expected_value => 3);
619    
620     $test->id ('append');
621     $ref2-><M::Node2.append> ($ref3);
622    
623     $test->id ('appended.tid');
624     $test->assert_not_equals
625     (${$stem1->{<H::mn:treeID>}},
626     ${$stem2->{<H::mn:treeID>}});
627     $test->assert_equals
628     (${$stem2->{<H::mn:treeID>}},
629     ${$stem3->{<H::mn:treeID>}});
630    
631     $test->id ('appended.rc');
632     $test->assert_num_equals
633     (actual_value => $stem1->{<H::mn:rc>},
634     expected_value => 3);
635     $test->assert_num_equals
636     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
637     expected_value => 3);
638     $test->assert_num_equals
639     (actual_value => $stem2->{<H::mn:rc>},
640     expected_value => 1);
641     $test->assert_num_equals
642     (actual_value => ${$stem2->{<H::mn:groveReferenceCounter>}},
643     expected_value => 2);
644     $test->assert_num_equals
645     (actual_value => $stem3->{<H::mn:rc>},
646     expected_value => 1);
647     $test->assert_num_equals
648     (actual_value => ${$stem3->{<H::mn:groveReferenceCounter>}},
649     expected_value => 2);
650    
651     @Method:
652     @@Name: set
653     @@Param:
654     @@@Name: ns
655 wakaba 1.4 @@@Type: DISPerl|String
656 wakaba 1.2 @@Param:
657     @@@Name: name
658 wakaba 1.4 @@@Type: DISPerl|String
659 wakaba 1.2 @@Param:
660     @@@Name: newChild
661     @@@Type: Node2
662     @@Return:
663     @@@PerlDef:
664     $self->{<H::mn:node>}-><M::mn:NodeStem.importTree>
665     ($newChild->{<H::mn:node>});
666     $self->{<H::mn:node>}->{<H::mnt:attr>}->{$ns}->{$name}
667     = $newChild->{<H::mn:node>};
668     $newChild->{<H::mn:node>}->{<H::mnt:parent>} = $self->{<H::mn:node>};
669    
670     @@Test:
671     @@@QName: Node2.set.test.3
672     @@@PerlDef:
673     $test->id ('node.1');
674     my $stem1 = <ClassM::Doc2.newStem>;
675     my $ref1 = <ClassM::Doc2.getRef> ($stem1);
676     $test->assert_num_equals
677     (actual_value => $stem1->{<H::mn:rc>},
678     expected_value => 1);
679     $test->assert_num_equals
680     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
681     expected_value => 1);
682    
683     $test->id ('node.2');
684     my $ref2 = $ref1-><M::Doc2.createNode>;
685     my $stem2 = $ref2->{<H::mn:node>};
686     $test->assert_num_equals
687     (actual_value => $stem2->{<H::mn:rc>},
688     expected_value => 1);
689     $test->assert_num_equals
690     (actual_value => ${$stem2->{<H::mn:groveReferenceCounter>}},
691     expected_value => 1);
692    
693     $test->id ('node.3');
694     my $ref3 = $ref1-><M::Doc2.createNode>;
695     my $stem3 = $ref3->{<H::mn:node>};
696     $test->assert_num_equals
697     (actual_value => $stem3->{<H::mn:rc>},
698     expected_value => 1);
699     $test->assert_num_equals
700     (actual_value => ${$stem3->{<H::mn:groveReferenceCounter>}},
701     expected_value => 1);
702    
703     $test->id ('diff.tid');
704     $test->assert_not_equals
705     (${$stem1->{<H::mn:treeID>}},
706     ${$stem2->{<H::mn:treeID>}});
707     $test->assert_not_equals
708     (${$stem2->{<H::mn:treeID>}},
709     ${$stem3->{<H::mn:treeID>}});
710     $test->assert_not_equals
711     (${$stem3->{<H::mn:treeID>}},
712     ${$stem1->{<H::mn:treeID>}});
713     $test->assert_num_equals
714     (actual_value => $stem1->{<H::mn:rc>},
715     expected_value => 3);
716     $test->assert_num_equals
717     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
718     expected_value => 3);
719    
720     $test->id ('append');
721     $ref2-><M::Node2.set> ('uri', 'name', $ref3);
722    
723     $test->id ('appended.tid');
724     $test->assert_not_equals
725     (${$stem1->{<H::mn:treeID>}},
726     ${$stem2->{<H::mn:treeID>}});
727     $test->assert_equals
728     (${$stem2->{<H::mn:treeID>}},
729     ${$stem3->{<H::mn:treeID>}});
730    
731     $test->id ('appended.rc');
732     $test->assert_num_equals
733     (actual_value => $stem1->{<H::mn:rc>},
734     expected_value => 3);
735     $test->assert_num_equals
736     (actual_value => ${$stem1->{<H::mn:groveReferenceCounter>}},
737     expected_value => 3);
738     $test->assert_num_equals
739     (actual_value => $stem2->{<H::mn:rc>},
740     expected_value => 1);
741     $test->assert_num_equals
742     (actual_value => ${$stem2->{<H::mn:groveReferenceCounter>}},
743     expected_value => 2);
744     $test->assert_num_equals
745     (actual_value => $stem3->{<H::mn:rc>},
746     expected_value => 1);
747     $test->assert_num_equals
748     (actual_value => ${$stem3->{<H::mn:groveReferenceCounter>}},
749     expected_value => 2);
750 wakaba 1.1 ##Node2
751    
752 wakaba 1.2 PropDef:
753     @QName: mnt|attr
754    
755 wakaba 1.1 ClsDef:
756     @ClsQName: Doc2
757    
758     @ClsISA: Node2
759    
760     @IntMethod:
761     @@Name: newStem
762     @@ManakaiDOM:isStatic: 1
763     @@Return:
764     @@@Type: mn|NodeStem
765     @@@PerlDef:
766     $r = <ClassM::mn|ManakaiNodeStem.new> (<ClassName::Doc2>);
767 wakaba 1.2 $r->{<H::mnt|children>} = [];
768     $r->{<H::mnt|attr>} = {};
769 wakaba 1.1
770     @IntMethod:
771     @@Name: getRef
772     @@ManakaiDOM:isStatic: 1
773     @@Param:
774     @@@Name: stem
775     @@@Type: mn|NodeStem
776     @@Return:
777     @@@Type: Doc2
778     @@@PerlDef:
779     __CODE{mn|getNewReference::
780     $object => $stem,
781     $ref => $r,
782     $class => {<ClassName::Doc2>},
783     }__;
784    
785     @IntMethod:
786     @@Name: newNodeStem
787     @@Return:
788     @@@Type: mn|NodeStem
789     @@@PerlDef:
790     $r = $self->{<H::mn:node>}-><M::mn|NodeStem.newNode> (<IFName::Node2>);
791     @@Test:
792     @@@QName: Doc2.newNodeStem.test
793     @@@PerlDef:
794     $test->id ('new.doc.stem');
795     my $stem = <ClassM::Doc2.newStem>;
796     $test->assert_isa ($stem, <IFName::mn|NodeStem>);
797     my $doc_tid = $stem->{<H::mn:treeID>};
798     my $doc = <ClassM::Doc2.getRef> ($stem);
799    
800     $test->id ('new.node.stem');
801     my $nstem = $doc-><M::Doc2.newNodeStem>;
802     $test->assert_isa ($nstem, <IFName::mn|NodeStem>);
803     my $node_tid = $nstem->{<H::mn:treeID>};
804    
805     $test->id ('doc.node.tid.equals');
806     $test->assert_equals ($$doc_tid, $$node_tid);
807    
808     @Method:
809     @@Name: createNode
810     @@Return:
811     @@@Type: Node2
812     @@@PerlDef:
813 wakaba 1.2 my $stem = <ClassM::Node2.newStem>;
814 wakaba 1.1 __CODE{mn:setXRefNode::
815     $referrer => $stem,
816     $propName => {<H::mnt|owner>},
817     $referent => {$self->{<H::mn:node>}},
818     }__;
819     $r = <ClassM::Node2.getRef> ($stem);
820     @@Test:
821     @@@QName: Doc2.createNode.test
822     @@@PerlDef:
823     $test->id ('new.doc');
824     my $doc_stem = <ClassM::Doc2.newStem>;
825     my $doc = <ClassM::Doc2.getRef> ($doc_stem);
826     $test->assert_isa ($doc, <ClassName::Doc2>);
827     $test->assert_num_equals
828     (actual_value => $doc_stem->{<H::mn:rc>},
829     expected_value => 1);
830     $test->assert_num_equals
831     (actual_value => ${$doc_stem->{<H::mn:groveReferenceCounter>}},
832     expected_value => 1);
833     my $doc_tid = $doc_stem->{<H::mn:treeID>};
834    
835     $test->id ('new.node');
836     my $node = $doc-><M::Doc2.createNode>;
837     $test->assert_isa ($node, <ClassName::Node2>);
838     my $node_stem = $node->{<H::mn:node>};
839     $test->assert_isa ($node_stem, <IFName::mn|NodeStem>);
840     $test->assert_num_equals
841     (actual_value => $node_stem->{<H::mn:rc>},
842     expected_value => 1);
843     $test->assert_num_equals
844     (actual_value => ${$node_stem->{<H::mn:groveReferenceCounter>}},
845     expected_value => 1);
846     my $node_tid = $node_stem->{<H::mn:treeID>};
847    
848     $test->id ('doc.node.diff.tid');
849     $test->assert_not_equals ($$doc_tid, $$node_tid);
850    
851     $test->id ('doc.rc');
852     $test->assert_num_equals
853     (actual_value => $doc_stem->{<H::mn:rc>},
854     expected_value => 2);
855     $test->assert_num_equals
856     (actual_value => ${$doc_stem->{<H::mn:groveReferenceCounter>}},
857     expected_value => 2);
858    
859     $test->id ('node.owner');
860     $test->assert_equals ($node_stem->{<H::mnt|owner>}, $doc_stem);
861    
862     $test->id ('doc.destroy');
863     undef $doc;
864     $test->assert_num_equals
865     (actual_value => $doc_stem->{<H::mn:rc>},
866     expected_value => 1);
867     $test->assert_num_equals
868     (actual_value => ${$doc_stem->{<H::mn:groveReferenceCounter>}},
869     expected_value => 1);
870     ##Doc2
871    
872     PropDef:
873     @QName: mnt|owner
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24