/[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.2 - (hide annotations) (download)
Wed Jan 25 12:21:49 2006 UTC (19 years, 5 months ago) by wakaba
Branch: MAIN
Changes since 1.1: +514 -2 lines 
++ manakai/t/ChangeLog	24 Jan 2006 13:25:30 -0000
2006-01-24  Wakaba  <wakaba@suika.fam.cx>

	* Makefile (util-mntest.t): Calls |mndebug.pl| subroutines.

++ manakai/lib/Message/Util/ChangeLog	25 Jan 2006 12:19:43 -0000
2006-01-25  Wakaba  <wakaba@suika.fam.cx>

	* ManakaiNodeTest.dis: Tests for |mn:subnode2| hash-hash added.

2006-01-24  Wakaba  <wakaba@suika.fam.cx>

	* ManakaiNodeTest.dis: Tests added.

++ manakai/lib/Message/Util/DIS/ChangeLog	25 Jan 2006 12:21:17 -0000
2006-01-25  Wakaba  <wakaba@suika.fam.cx>

	* Perl.dis: Typos in URIs fixed.
	(plCodeFragment): |lang:dis| |dis:SetProp| |CheckReadOnly|
	check code was inserted to incorrect place.

2006-01-24  Wakaba  <wakaba@suika.fam.cx>

	* Perl.dis (plCodeFragment): Gives URI as argument
	to ensure |isReferred| switch turned on.

++ manakai/lib/Message/DOM/ChangeLog	25 Jan 2006 12:18:34 -0000
2006-01-25  Wakaba  <wakaba@suika.fam.cx>

	* XDoctype.dis (setElementTypeDefinitionNode,
	setAttributeDefinitionNode): Throws |c:INUSE_DEFINITION_ERR|
	if the new node is already used for another definition.
	(DocumentTypeDefinition, ElementTypeDefinition): Node
	property name was incorrect.
	(elementTypes, attributeDefinitions): Checks to
	ensure the collection is empty added.

	* Tree.dis: Property name typos fixed.
	(setNamedItem, setAttributeNode): Don't return any node
	if it replace itself.
	(c:userDeterminedId): Missing definition added.

	* DOMXML.dis (Notation): Missing property specification
	of|c:ownerDocument| as |mn:xrefnode0| is added.

++ manakai/lib/manakai/ChangeLog	24 Jan 2006 13:23:58 -0000
2006-01-24  Wakaba  <wakaba@suika.fam.cx>

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