Module: @QName: Util|ManakaiNodeTest @FullName: @@lang:en @@@: Test Module @Namespace: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ManakaiNodeTest# @DISCore:author: DISCore|Wakaba @License: license|Perl+MPL @Date: $Date: 2006/02/26 06:42:57 $ @Require: @@Module: @@@QName: Util|ManakaiNode @@@WithFor: ManakaiDOM|Perl @@Module: @@@QName: DISlib|Test @@@WithFor: ManakaiDOM|all @DefaultFor: ManakaiDOM:Perl Namespace: @dis: http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis-- @DISlib: http://suika.fam.cx/~wakaba/archive/2004/dis/ @kwd: http://suika.fam.cx/~wakaba/archive/2005/rfc2119/ @lang: http://suika.fam.cx/~wakaba/archive/2004/8/18/lang# @license: http://suika.fam.cx/~wakaba/archive/2004/8/18/license# @ManakaiDOM: http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom# @mn: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ManakaiNode# @mnt: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ManakaiNodeTest# @rdf: http://www.w3.org/1999/02/22-rdf-syntax-ns# @rdfs: http://www.w3.org/2000/01/rdf-schema# @test: http://suika.fam.cx/~wakaba/archive/2004/dis/Test# @Util: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ ElementTypeBinding: @Name: ClsDef @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: @@@@: dis:MultipleResource @@@ForCheck: !ManakaiDOM|ForClass !ManakaiDOM|ForIF @@resourceFor: ManakaiDOM|ForClass @@rdf:type: @@@@: DISLang|Class @@@ForCheck: ManakaiDOM|ForClass @@ForCheck: ManakaiDOM|Perl ElementTypeBinding: @Name: IntMethod @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang:Method @@ManakaiDOM:isForInternal:1 ElementTypeBinding: @Name: Method @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang:Method ElementTypeBinding: @Name: Return @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang:MethodReturn ElementTypeBinding: @Name: Param @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: DISLang:MethodParameter ElementTypeBinding: @Name: PerlDef @ElementType: dis:Def @ShadowContent: @@ContentType: lang:Perl ElementTypeBinding: @Name: enDesc @ElementType: dis:Description @ShadowContent: @@lang:en ElementTypeBinding: @Name: Test @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: test|StandaloneTest ElementTypeBinding: @Name: ClsQName @ElementType: dis:QName @ShadowContent: @@ForCheck: ManakaiDOM|ForClass ElementTypeBinding: @Name: ClsISA @ElementType: dis:ISA @ShadowContent: @@ForCheck: ManakaiDOM|ForClass PropDef: @QName: mnt|parent PropDef: @QName: mnt|children ElementTypeBinding: @Name: PropDef @ElementType: dis:ResourceDef @ShadowContent: @@rdf:type: rdf|Property @@For: =ManakaiDOM|all ClsDef: @ClsQName: Node1 @ClsISA: mn|ManakaiNodeRef @enDesc: Simple tree pattern test. @IntMethod: @@Name: newStem @@ManakaiDOM:isStatic: 1 @@Return: @@@Type: mn|NodeStem @@@PerlDef: $r = (); $r->{} = []; $r->{} = {}; @mn:origin0: mnt|parent @mn:subnode1: mnt|children @mn:subnode2: mnt|attr @IntMethod: @@Name: getRef @@ManakaiDOM:isStatic: 1 @@Param: @@@Name: stem @@@Type: mn|NodeStem @@Return: @@@Type: Node1 @@@PerlDef: __CODE{mn|getNewReference:: $object => $stem, $ref => $r, $class => {}, }__; @Test: @@QName: Node1.test1 @@PerlDef: $test->id ('get.stem'); my $stem = ; $test->assert_isa ($stem, ); $test->assert_not_null ($stem->{}); $test->assert_num_equals (actual_value => $stem->{}, expected_value => 0); $test->assert_isa ($stem->{}, 'SCALAR'); $test->assert_num_equals (actual_value => ${$stem->{}}, expected_value => 0); $test->id ('get.ref'); my $ref = ($stem); $test->assert_isa ($ref, ); $test->assert_isa ($ref, ); $test->assert_isa ($ref->{}, ); $test->assert_equals ($ref->{}->{}, $stem->{}); $test->assert_num_equals (actual_value => $stem->{}, expected_value => 1); $test->assert_isa ($stem->{}, 'SCALAR'); $test->assert_num_equals (actual_value => ${$stem->{}}, expected_value => 1); @Method: @@Name: append @@Param: @@@Name: newChild @@@Type: Node1 @@Return: @@@PerlDef: $self->{}-> ($newChild->{}); push @{$self->{}->{}}, $newChild->{}; $newChild->{}->{} = $self->{}; @@Test: @@@QName: Node1.append.test @@@PerlDef: $test->id ('node.1'); my $stem1 = ; my $ref1 = ($stem1); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 1); $test->id ('node.2'); my $stem2 = ; my $ref2 = ($stem2); $test->assert_num_equals (actual_value => $stem2->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem2->{}}, expected_value => 1); $test->id ('diff.tid'); $test->assert_not_equals (${$stem1->{}}, ${$stem2->{}}); $test->id ('append'); $ref1-> ($ref2); $test->id ('appended.tid'); $test->assert_equals (${$stem1->{}}, ${$stem2->{}}); $test->id ('appended.rc'); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 2); $test->assert_num_equals (actual_value => $stem2->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem2->{}}, expected_value => 2); @Method: @@Name: set @@Param: @@@Name: ns @@@Type: DISPerl|String||ManakaiDOM|all @@Param: @@@Name: name @@@Type: DISPerl|String||ManakaiDOM|all @@Param: @@@Name: newChild @@@Type: Node1 @@Return: @@@PerlDef: $self->{}-> ($newChild->{}); $self->{}->{}->{$ns}->{$name} = $newChild->{}; $newChild->{}->{} = $self->{}; @@Test: @@@QName: Node1.set.test @@@PerlDef: $test->id ('node.1'); my $stem1 = ; my $ref1 = ($stem1); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 1); $test->id ('node.2'); my $stem2 = ; my $ref2 = ($stem2); $test->assert_num_equals (actual_value => $stem2->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem2->{}}, expected_value => 1); $test->id ('diff.tid'); $test->assert_not_equals (${$stem1->{}}, ${$stem2->{}}); $test->id ('append'); $ref1-> ('uri', 'name', $ref2); $test->id ('appended.tid'); $test->assert_equals (${$stem1->{}}, ${$stem2->{}}); $test->id ('appended.rc'); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 2); $test->assert_num_equals (actual_value => $stem2->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem2->{}}, expected_value => 2); ##Node1 ClsDef: @ClsQName: Node2 @ClsISA: mn|ManakaiNodeRef @enDesc: Tree + ownwerDocument pattern test. @IntMethod: @@Name: newStem @@ManakaiDOM:isStatic: 1 @@Return: @@@Type: mn|NodeStem @@@PerlDef: $r = (); $r->{} = []; $r->{} = {}; @mn:origin0: mnt|parent @mn:subnode1: mnt|children @mn:xrefnode0: mnt|owner @mn:subnode2: mnt|attr @IntMethod: @@Name: getRef @@ManakaiDOM:isStatic: 1 @@Param: @@@Name: stem @@@Type: mn|NodeStem @@Return: @@@Type: Node2 @@@PerlDef: __CODE{mn|getNewReference:: $object => $stem, $ref => $r, $class => {}, }__; @Method: @@Name: append @@Param: @@@Name: newChild @@@Type: Node2 @@Return: @@@PerlDef: $self->{}-> ($newChild->{}); push @{$self->{}->{}}, $newChild->{}; $newChild->{}->{} = $self->{}; @@Test: @@@QName: Node2.append.test.1 @@@PerlDef: $test->id ('node.1'); my $stem1 = ; my $ref1 = ($stem1); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 1); $test->id ('node.2'); my $ref2 = $ref1->; my $stem2 = $ref2->{}; $test->assert_num_equals (actual_value => $stem2->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem2->{}}, expected_value => 1); $test->id ('diff.tid'); $test->assert_not_equals (${$stem1->{}}, ${$stem2->{}}); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 2); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 2); $test->id ('append'); $ref1-> ($ref2); $test->id ('appended.tid'); $test->assert_equals (${$stem1->{}}, ${$stem2->{}}); $test->id ('appended.rc'); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 2); $test->assert_num_equals (actual_value => $stem2->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem2->{}}, expected_value => 2); @@Test: @@@QName: Node2.append.test.2 @@@PerlDef: $test->id ('node.1'); my $stem1 = ; my $ref1 = ($stem1); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 1); $test->id ('node.2'); my $ref2 = $ref1->; my $stem2 = $ref2->{}; $test->assert_num_equals (actual_value => $stem2->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem2->{}}, expected_value => 1); $test->id ('node.3'); my $ref3 = $ref1->; my $stem3 = $ref3->{}; $test->assert_num_equals (actual_value => $stem3->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem3->{}}, expected_value => 1); $test->id ('diff.tid'); $test->assert_not_equals (${$stem1->{}}, ${$stem2->{}}); $test->assert_not_equals (${$stem2->{}}, ${$stem3->{}}); $test->assert_not_equals (${$stem3->{}}, ${$stem1->{}}); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 3); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 3); $test->id ('append'); $ref2-> ($ref3); $test->id ('appended.tid'); $test->assert_not_equals (${$stem1->{}}, ${$stem2->{}}); $test->assert_equals (${$stem2->{}}, ${$stem3->{}}); $test->id ('appended.rc'); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 3); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 3); $test->assert_num_equals (actual_value => $stem2->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem2->{}}, expected_value => 2); $test->assert_num_equals (actual_value => $stem3->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem3->{}}, expected_value => 2); $test->id ('stem1.unlinked'); undef $ref1; $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 2); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 2); $test->id ('stem2.unlinked'); undef $ref2; $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 2); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 2); $test->assert_num_equals (actual_value => $stem2->{}, expected_value => 0); $test->assert_num_equals (actual_value => ${$stem2->{}}, expected_value => 1); $test->assert_num_equals (actual_value => $stem3->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem3->{}}, expected_value => 1); $test->id ('stem3.unlinked'); undef $ref3; $test->assert_null ($stem1->{}); $test->assert_null ($stem2->{}); $test->assert_null ($stem3->{}); $test->assert_null ($stem1->{}); $test->assert_null ($stem2->{}); $test->assert_null ($stem3->{}); @@Test: @@@QName: Node2.append.test.3 @@@PerlDef: $test->id ('node.1'); my $stem1 = ; my $ref1 = ($stem1); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 1); $test->id ('node.2'); my $ref2 = $ref1->; my $stem2 = $ref2->{}; $test->assert_num_equals (actual_value => $stem2->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem2->{}}, expected_value => 1); $test->id ('node.3'); my $ref3 = $ref1->; my $stem3 = $ref3->{}; $test->assert_num_equals (actual_value => $stem3->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem3->{}}, expected_value => 1); $test->id ('diff.tid'); $test->assert_not_equals (${$stem1->{}}, ${$stem2->{}}); $test->assert_not_equals (${$stem2->{}}, ${$stem3->{}}); $test->assert_not_equals (${$stem3->{}}, ${$stem1->{}}); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 3); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 3); $test->id ('append'); $ref2-> ($ref3); $test->id ('appended.tid'); $test->assert_not_equals (${$stem1->{}}, ${$stem2->{}}); $test->assert_equals (${$stem2->{}}, ${$stem3->{}}); $test->id ('appended.rc'); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 3); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 3); $test->assert_num_equals (actual_value => $stem2->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem2->{}}, expected_value => 2); $test->assert_num_equals (actual_value => $stem3->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem3->{}}, expected_value => 2); @Method: @@Name: set @@Param: @@@Name: ns @@@Type: DISPerl|String||ManakaiDOM|all @@Param: @@@Name: name @@@Type: DISPerl|String||ManakaiDOM|all @@Param: @@@Name: newChild @@@Type: Node2 @@Return: @@@PerlDef: $self->{}-> ($newChild->{}); $self->{}->{}->{$ns}->{$name} = $newChild->{}; $newChild->{}->{} = $self->{}; @@Test: @@@QName: Node2.set.test.3 @@@PerlDef: $test->id ('node.1'); my $stem1 = ; my $ref1 = ($stem1); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 1); $test->id ('node.2'); my $ref2 = $ref1->; my $stem2 = $ref2->{}; $test->assert_num_equals (actual_value => $stem2->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem2->{}}, expected_value => 1); $test->id ('node.3'); my $ref3 = $ref1->; my $stem3 = $ref3->{}; $test->assert_num_equals (actual_value => $stem3->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem3->{}}, expected_value => 1); $test->id ('diff.tid'); $test->assert_not_equals (${$stem1->{}}, ${$stem2->{}}); $test->assert_not_equals (${$stem2->{}}, ${$stem3->{}}); $test->assert_not_equals (${$stem3->{}}, ${$stem1->{}}); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 3); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 3); $test->id ('append'); $ref2-> ('uri', 'name', $ref3); $test->id ('appended.tid'); $test->assert_not_equals (${$stem1->{}}, ${$stem2->{}}); $test->assert_equals (${$stem2->{}}, ${$stem3->{}}); $test->id ('appended.rc'); $test->assert_num_equals (actual_value => $stem1->{}, expected_value => 3); $test->assert_num_equals (actual_value => ${$stem1->{}}, expected_value => 3); $test->assert_num_equals (actual_value => $stem2->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem2->{}}, expected_value => 2); $test->assert_num_equals (actual_value => $stem3->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$stem3->{}}, expected_value => 2); ##Node2 PropDef: @QName: mnt|attr ClsDef: @ClsQName: Doc2 @ClsISA: Node2 @IntMethod: @@Name: newStem @@ManakaiDOM:isStatic: 1 @@Return: @@@Type: mn|NodeStem @@@PerlDef: $r = (); $r->{} = []; $r->{} = {}; @IntMethod: @@Name: getRef @@ManakaiDOM:isStatic: 1 @@Param: @@@Name: stem @@@Type: mn|NodeStem @@Return: @@@Type: Doc2 @@@PerlDef: __CODE{mn|getNewReference:: $object => $stem, $ref => $r, $class => {}, }__; @IntMethod: @@Name: newNodeStem @@Return: @@@Type: mn|NodeStem @@@PerlDef: $r = $self->{}-> (); @@Test: @@@QName: Doc2.newNodeStem.test @@@PerlDef: $test->id ('new.doc.stem'); my $stem = ; $test->assert_isa ($stem, ); my $doc_tid = $stem->{}; my $doc = ($stem); $test->id ('new.node.stem'); my $nstem = $doc->; $test->assert_isa ($nstem, ); my $node_tid = $nstem->{}; $test->id ('doc.node.tid.equals'); $test->assert_equals ($$doc_tid, $$node_tid); @Method: @@Name: createNode @@Return: @@@Type: Node2 @@@PerlDef: my $stem = ; __CODE{mn:setXRefNode:: $referrer => $stem, $propName => {}, $referent => {$self->{}}, }__; $r = ($stem); @@Test: @@@QName: Doc2.createNode.test @@@PerlDef: $test->id ('new.doc'); my $doc_stem = ; my $doc = ($doc_stem); $test->assert_isa ($doc, ); $test->assert_num_equals (actual_value => $doc_stem->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$doc_stem->{}}, expected_value => 1); my $doc_tid = $doc_stem->{}; $test->id ('new.node'); my $node = $doc->; $test->assert_isa ($node, ); my $node_stem = $node->{}; $test->assert_isa ($node_stem, ); $test->assert_num_equals (actual_value => $node_stem->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$node_stem->{}}, expected_value => 1); my $node_tid = $node_stem->{}; $test->id ('doc.node.diff.tid'); $test->assert_not_equals ($$doc_tid, $$node_tid); $test->id ('doc.rc'); $test->assert_num_equals (actual_value => $doc_stem->{}, expected_value => 2); $test->assert_num_equals (actual_value => ${$doc_stem->{}}, expected_value => 2); $test->id ('node.owner'); $test->assert_equals ($node_stem->{}, $doc_stem); $test->id ('doc.destroy'); undef $doc; $test->assert_num_equals (actual_value => $doc_stem->{}, expected_value => 1); $test->assert_num_equals (actual_value => ${$doc_stem->{}}, expected_value => 1); ##Doc2 PropDef: @QName: mnt|owner