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

Diff of /messaging/manakai/t/DOM-Node.t

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by wakaba, Sat Jun 16 15:27:45 2007 UTC revision 1.5 by wakaba, Sun Jun 17 14:15:39 2007 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2  use strict;  use strict;
3  use Test;  use Test;
4  BEGIN { plan tests => 4 }  BEGIN { plan tests => 1921 }
5    
6  require Message::DOM::DOMImplementation;  require Message::DOM::DOMImplementation;
7  use Message::Util::Error;  use Message::Util::Error;
# Line 9  use Message::Util::Error; Line 9  use Message::Util::Error;
9  my $dom = Message::DOM::DOMImplementation->____new;  my $dom = Message::DOM::DOMImplementation->____new;
10  my $doc = $dom->create_document;  my $doc = $dom->create_document;
11    
12    
13    sub create_nodes () {
14      (
15       $doc->create_attribute ('attr1'),
16       $doc->create_attribute_definition ('at1'),
17       $doc->create_cdata_section ('cdata1'),
18       $doc->create_comment ('comment1'),
19       $doc->create_element ('element1'),
20       $doc->create_element_type_definition ('et1'),
21       $doc->create_general_entity ('entity1'),
22       $doc->create_entity_reference ('entity-reference1'),
23       $doc->implementation->create_document,
24       $doc->create_document_fragment,
25       $doc->create_document_type_definition ('dt1'),
26       $doc->create_notation ('notation1'),
27       $doc->create_processing_instruction ('pi1', 'pi1data'),
28       $doc->create_text_node ('text1'),
29      );
30    } # create_nodes
31    
32    sub create_parent_nodes () {
33      (
34       $doc->create_attribute ('attr1'),
35       $doc->create_attribute_definition ('at1'),
36       $doc->create_element ('element1'),
37       $doc->create_general_entity ('entity1'),
38       $doc->create_entity_reference ('entity-reference1'),
39       $doc->implementation->create_document,
40       $doc->create_document_fragment,
41       $doc->create_document_type_definition ('dt1'),
42      );
43    } # create_parent_nodes
44    
45  ## Constants  ## Constants
46  my $constants = [  my $constants = [
47    [ELEMENT_NODE => 1],    [ELEMENT_NODE => 1],
# Line 28  my $constants = [ Line 61  my $constants = [
61  ];  ];
62    
63  my $tests = {  my $tests = {
64    attr => {    attr1 => {
65      node => sub {      node => sub { return $doc->create_attribute ('a') },
       my $attr = $doc->create_attribute ('a');  
       $attr->value ('b');  
       return $attr;  
     },  
66      attr_get => {      attr_get => {
67          manakai_attribute_type => 0,
68          base_uri => undef,
69        first_child => undef,        first_child => undef,
70        last_child => undef,        last_child => undef,
71        local_name => 'a',        local_name => 'a',
# Line 43  my $tests = { Line 74  my $tests = {
74        next_sibling => undef,        next_sibling => undef,
75        node_name => 'a',        node_name => 'a',
76        name => 'a',        name => 'a',
77        node_value => 'b',        node_value => '',
78        owner_document => $doc,        owner_document => $doc,
79        parent_node => undef,        parent_node => undef,
80        prefix => undef,        prefix => undef,
81        previous_sibling => undef,        previous_sibling => undef,
82        value => 'b',        value => '',
83        attributes => undef,        attributes => undef,
84      },      },
85        attr_get_bool => {
86          specified => 1,
87        },
88    },    },
89    attr_ns_default => {    attr2 => {
90      node => sub {      node => sub {
91        my $attr = $doc->create_attribute_ns (undef, 'a');        my $attr = $doc->create_attribute ('a');
92        $attr->value ('b');        $attr->value ('b');
93        return $attr;        return $attr;
94      },      },
95      attr_get => {      attr_get => {
96        first_child => undef,        manakai_attribute_type => 0,
97        last_child => undef,        base_uri => undef,
98        local_name => 'a',        local_name => 'a',
99        manakai_local_name => 'a',        manakai_local_name => 'a',
100        namespace_uri => undef,        namespace_uri => undef,
# Line 71  my $tests = { Line 105  my $tests = {
105        owner_document => $doc,        owner_document => $doc,
106        parent_node => undef,        parent_node => undef,
107        prefix => undef,        prefix => undef,
108          previous_sibling => undef,
109        value => 'b',        value => 'b',
110        attributes => undef,        attributes => undef,
111        },
112        attr_get_bool => {
113          specified => 1,
114        },
115      },
116      attr_ns_default => {
117        node => sub { return $doc->create_attribute_ns (undef, 'a') },
118        attr_get => {
119          base_uri => undef,
120          local_name => 'a',
121          manakai_local_name => 'a',
122          namespace_uri => undef,
123          next_sibling => undef,
124          node_name => 'a',
125          name => 'a',
126          node_value => '',
127          owner_document => $doc,
128          parent_node => undef,
129          prefix => undef,
130          value => '',
131          attributes => undef,
132        previous_sibling => undef,        previous_sibling => undef,
133      },      },
134    },    },
135    attr_ns_prefixed => {    attr_ns_prefixed => {
136      node => sub {      node => sub { return $doc->create_attribute_ns ('http://test/', 'a:b') },
       my $attr = $doc->create_attribute_ns ('http://test/', 'a:b');  
       $attr->value ('c');  
       return $attr;  
     },  
137      attr_get => {      attr_get => {
138        first_child => undef,        base_uri => undef,
       last_child => undef,  
139        local_name => 'b',        local_name => 'b',
140        manakai_local_name => 'b',        manakai_local_name => 'b',
141        namespace_uri => 'http://test/',        namespace_uri => 'http://test/',
142        next_sibling => undef,        next_sibling => undef,
143        node_name => 'a:b',        node_name => 'a:b',
144        name => 'a:b',        name => 'a:b',
145        node_value => 'c',        node_value => '',
146        owner_document => $doc,        owner_document => $doc,
147        parent_node => undef,        parent_node => undef,
148        prefix => 'a',        prefix => 'a',
149        value => 'c',        value => '',
150        attributes => undef,        attributes => undef,
151        previous_sibling => undef,        previous_sibling => undef,
152      },      },
# Line 103  my $tests = { Line 154  my $tests = {
154    cdatasection => {    cdatasection => {
155      node => sub { return $doc->create_cdata_section ('cdatadata') },      node => sub { return $doc->create_cdata_section ('cdatadata') },
156      attr_get => {      attr_get => {
157          base_uri => undef,
158        first_child => undef,        first_child => undef,
159        last_child => undef,        last_child => undef,
160        local_name => undef,        local_name => undef,
# Line 122  my $tests = { Line 174  my $tests = {
174    cdatasectionmde => {    cdatasectionmde => {
175      node => sub { return $doc->create_cdata_section ('cdata]]>data') },      node => sub { return $doc->create_cdata_section ('cdata]]>data') },
176      attr_get => {      attr_get => {
177          base_uri => undef,
178        first_child => undef,        first_child => undef,
179        last_child => undef,        last_child => undef,
180        local_name => undef,        local_name => undef,
# Line 141  my $tests = { Line 194  my $tests = {
194    comment => {    comment => {
195      node => sub { return $doc->create_comment ('commentdata') },      node => sub { return $doc->create_comment ('commentdata') },
196      attr_get => {      attr_get => {
197          base_uri => undef,
198        first_child => undef,        first_child => undef,
199        last_child => undef,        last_child => undef,
200        local_name => undef,        local_name => undef,
# Line 160  my $tests = { Line 214  my $tests = {
214    commentcom1 => {    commentcom1 => {
215      node => sub { return $doc->create_comment ('comment--data') },      node => sub { return $doc->create_comment ('comment--data') },
216      attr_get => {      attr_get => {
217          base_uri => undef,
218        first_child => undef,        first_child => undef,
219        last_child => undef,        last_child => undef,
220        local_name => undef,        local_name => undef,
# Line 179  my $tests = { Line 234  my $tests = {
234    commentcom2 => {    commentcom2 => {
235      node => sub { return $doc->create_comment ('commentdata-') },      node => sub { return $doc->create_comment ('commentdata-') },
236      attr_get => {      attr_get => {
237          base_uri => undef,
238        first_child => undef,        first_child => undef,
239        last_child => undef,        last_child => undef,
240        local_name => undef,        local_name => undef,
# Line 199  my $tests = { Line 255  my $tests = {
255      node => sub { return $doc },      node => sub { return $doc },
256      attr_get => {      attr_get => {
257        attributes => undef,        attributes => undef,
258          base_uri => undef,
259          document_uri => undef,
260          manakai_entity_base_uri => undef,
261        first_child => undef,        first_child => undef,
262        implementation => $dom,        implementation => $dom,
263        last_child => undef,        last_child => undef,
# Line 212  my $tests = { Line 271  my $tests = {
271        parent_node => undef,        parent_node => undef,
272        prefix => undef,        prefix => undef,
273        previous_sibling => undef,        previous_sibling => undef,
274          xml_encoding => undef,
275          xml_version => '1.0',
276        },
277        attr_get_bool => {
278          all_declarations_processed => 0,
279          manakai_is_html => 0,
280          strict_error_checking => 1,
281          xml_standalone => 0,
282      },      },
283    },    },
284    document_fragment => {    document_fragment => {
285      node => sub { return $doc->create_document_fragment },      node => sub { return $doc->create_document_fragment },
286      attr_get => {      attr_get => {
287        attributes => undef,        attributes => undef,
288          base_uri => undef,
289        first_child => undef,        first_child => undef,
290        last_child => undef,        last_child => undef,
291        local_name => undef,        local_name => undef,
# Line 236  my $tests = { Line 304  my $tests = {
304      node => sub { return $doc->implementation->create_document_type ('n') },      node => sub { return $doc->implementation->create_document_type ('n') },
305      attr_get => {      attr_get => {
306        attributes => undef,        attributes => undef,
307          base_uri => undef,
308          declaration_base_uri => undef,
309          manakai_declaration_base_uri => undef,
310        first_child => undef,        first_child => undef,
311        implementation => $dom,        implementation => $dom,
312        last_child => undef,        last_child => undef,
# Line 249  my $tests = { Line 320  my $tests = {
320        parent_node => undef,        parent_node => undef,
321        prefix => undef,        prefix => undef,
322        previous_sibling => undef,        previous_sibling => undef,
323          public_id => undef,
324          system_id => undef,
325      },      },
326    },    },
327    document_type_definition => {    document_type_definition => {
328      node => sub { return $doc->create_document_type_definition ('n') },      node => sub { return $doc->create_document_type_definition ('n') },
329      attr_get => {      attr_get => {
330        attributes => undef,        attributes => undef,
331          base_uri => undef,
332          declaration_base_uri => undef,
333          manakai_declaration_base_uri => undef,
334        first_child => undef,        first_child => undef,
335        implementation => $dom,        implementation => $dom,
336        last_child => undef,        last_child => undef,
# Line 268  my $tests = { Line 344  my $tests = {
344        parent_node => undef,        parent_node => undef,
345        prefix => undef,        prefix => undef,
346        previous_sibling => undef,        previous_sibling => undef,
347          public_id => undef,
348          system_id => undef,
349      },      },
350    },    },
351    element => {    element => {
352      node => sub { return $doc->create_element ('e') },      node => sub { return $doc->create_element ('e') },
353      attr_get => {      attr_get => {
354        ## TODO: attributes =>        ## TODO: attributes =>
355          base_uri => undef,
356          manakai_base_uri => undef,
357        first_child => undef,        first_child => undef,
358        last_child => undef,        last_child => undef,
359        local_name => 'e',        local_name => 'e',
# Line 292  my $tests = { Line 372  my $tests = {
372      node => sub { return $doc->create_element_ns ('http://test/', 'f') },      node => sub { return $doc->create_element_ns ('http://test/', 'f') },
373      attr_get => {      attr_get => {
374        ## TODO: attributes =>        ## TODO: attributes =>
375          base_uri => undef,
376          manakai_base_uri => undef,
377        first_child => undef,        first_child => undef,
378        last_child => undef,        last_child => undef,
379        local_name => 'f',        local_name => 'f',
# Line 310  my $tests = { Line 392  my $tests = {
392      node => sub { return $doc->create_element_ns ('http://test/', 'e:f') },      node => sub { return $doc->create_element_ns ('http://test/', 'e:f') },
393      attr_get => {      attr_get => {
394        ## TODO: attributes =>        ## TODO: attributes =>
395          base_uri => undef,
396          manakai_base_uri => undef,
397        first_child => undef,        first_child => undef,
398        last_child => undef,        last_child => undef,
399        local_name => 'f',        local_name => 'f',
# Line 328  my $tests = { Line 412  my $tests = {
412      node => sub { return $doc->create_general_entity ('e') },      node => sub { return $doc->create_general_entity ('e') },
413      attr_get => {      attr_get => {
414        attributes => undef,        attributes => undef,
415          base_uri => undef,
416          manakai_declaration_base_uri => undef,
417          manakai_entity_base_uri => undef,
418          manakai_entity_uri => undef,
419        first_child => undef,        first_child => undef,
420        last_child => undef,        last_child => undef,
421        next_sibling => undef,        next_sibling => undef,
422        node_name => 'e',        node_name => 'e',
423        node_value => undef,        node_value => undef,
424          notation_name => undef,
425        owner_document => $doc,        owner_document => $doc,
426        parent_node => undef,        parent_node => undef,
427        previous_sibling => undef,        previous_sibling => undef,
428          public_id => undef,
429          system_id => undef,
430      },      },
431    },    },
432    entity_reference => {    entity_reference => {
433      node => sub { return $doc->create_entity_reference ('e') },      node => sub { return $doc->create_entity_reference ('e') },
434      attr_get => {      attr_get => {
435        attributes => undef,        attributes => undef,
436          base_uri => undef,
437          manakai_entity_base_uri => undef,
438        first_child => undef,        first_child => undef,
439        last_child => undef,        last_child => undef,
440        local_name => undef,        local_name => undef,
# Line 355  my $tests = { Line 448  my $tests = {
448        prefix => undef,        prefix => undef,
449        previous_sibling => undef,        previous_sibling => undef,
450      },      },
451        attr_get_bool => {
452          manakai_expanded => 0,
453          manakai_external => 0,
454        },
455    },    },
456    notation => {    notation => {
457      node => sub { return $doc->create_notation ('e') },      node => sub { return $doc->create_notation ('e') },
458      attr_get => {      attr_get => {
459        attributes => undef,        attributes => undef,
460          base_uri => undef,
461          manakai_declaration_base_uri => undef,
462        first_child => undef,        first_child => undef,
463        last_child => undef,        last_child => undef,
464        local_name => undef,        local_name => undef,
# Line 372  my $tests = { Line 471  my $tests = {
471        parent_node => undef,        parent_node => undef,
472        prefix => undef,        prefix => undef,
473        previous_sibling => undef,        previous_sibling => undef,
474          public_id => undef,
475          system_id => undef,
476      },      },
477    },    },
478    processing_instruction => {    processing_instruction => {
479      node => sub { return $doc->create_processing_instruction ('t', 'd') },      node => sub { return $doc->create_processing_instruction ('t', 'd') },
480      attr_get => {      attr_get => {
481        attributes => undef,        attributes => undef,
482          base_uri => undef,
483          manakai_base_uri => undef,
484        first_child => undef,        first_child => undef,
485        last_child => undef,        last_child => undef,
486        local_name => undef,        local_name => undef,
# Line 396  my $tests = { Line 499  my $tests = {
499      node => sub { return $doc->create_text_node ('textdata') },      node => sub { return $doc->create_text_node ('textdata') },
500      attr_get => {      attr_get => {
501        attributes => undef,        attributes => undef,
502          base_uri => undef,
503        first_child => undef,        first_child => undef,
504        last_child => undef,        last_child => undef,
505        local_name => undef,        local_name => undef,
# Line 414  my $tests = { Line 518  my $tests = {
518      node => sub { return $doc->create_element_type_definition ('e') },      node => sub { return $doc->create_element_type_definition ('e') },
519      attr_get => {      attr_get => {
520        attributes => undef,        attributes => undef,
521          base_uri => undef,
522        first_child => undef,        first_child => undef,
523        last_child => undef,        last_child => undef,
524        local_name => undef,        local_name => undef,
# Line 432  my $tests = { Line 537  my $tests = {
537      node => sub { return $doc->create_attribute_definition ('e') },      node => sub { return $doc->create_attribute_definition ('e') },
538      attr_get => {      attr_get => {
539        attributes => undef,        attributes => undef,
540          base_uri => undef,
541          declared_type => 0,
542          default_type => 0,
543        first_child => undef,        first_child => undef,
544        last_child => undef,        last_child => undef,
545        local_name => undef,        local_name => undef,
# Line 464  for my $test_id (sort {$a cmp $b} keys % Line 572  for my $test_id (sort {$a cmp $b} keys %
572      my $actual = $node->$attr_name;      my $actual = $node->$attr_name;
573      ok $actual, $expected, "$test_id.$attr_name.get";      ok $actual, $expected, "$test_id.$attr_name.get";
574    }    }
575    
576      for my $attr_name (sort {$a cmp $b} keys %{$test_def->{attr_get_bool} or {}}) {
577        my $expected = $test_def->{attr_get_bool}->{$attr_name} ? 1 : 0;
578        ok $node->can ($attr_name) ? 1 : 0, 1, "$test_id->can ($attr_name)";
579        my $actual = $node->$attr_name ? 1 : 0;
580        ok $actual, $expected, "$test_id.$attr_name.get";
581      }
582  }  }
583    
584  ## Child node accessors' tests  ## Child node accessors' tests
# Line 664  for my $node (create_nodes ()) { Line 779  for my $node (create_nodes ()) {
779    }    }
780  }  }
781    
782    ## |manakaiReadOnly| and |manakaiSetReadOnly|
783    {
784      for my $node (create_nodes ()) {
785        $node->manakai_set_read_only (1, 0);
786        ok $node->manakai_read_only ? 1 : 0, 1,
787            $node->node_name . '->manakai_set_read_only (1, 0) [1]';
788    
789        $node->manakai_set_read_only (0, 0);
790        ok $node->manakai_read_only ? 1 : 0, 0,
791            $node->node_name . '->manakai_set_read_only (0, 0)';
792    
793        $node->manakai_set_read_only (1, 0);
794        ok $node->manakai_read_only ? 1 : 0, 1,
795            $node->node_name . '->manakai_set_read_only (1, 0) [2]';
796      }
797    
798      {
799        my $el = $doc->create_element ('readOnlyElement1');
800        my $c1 = $doc->create_element ('c1');
801        $el->append_child ($c1);
802        my $c2 = $doc->create_text_node ('c2');
803        $el->append_child ($c2);
804        my $c3 = $doc->create_element ('c3');
805        $el->append_child ($c3);
806        my $c4 = $doc->create_attribute ('c4');
807        $el->set_attribute_node ($c4);
808        my $c5 = $doc->create_entity_reference ('c5');
809        $el->append_child ($c5);
810        
811        $el->manakai_set_read_only (1, 1);
812        for ($c1, $c2, $c3, $c4, $c5) {
813          ok $_->manakai_read_only ? 1 : 0, 1,
814              $el->node_name . '->read_only (1, 1) ' . $_->node_name . ' [1]';
815        }
816        
817        $el->manakai_set_read_only (0, 1);
818        for ($c1, $c2, $c3, $c4, $c5) {
819          ok $_->manakai_read_only ? 1 : 0, 0,
820              $el->node_name . '->read_only (1, 0) ' . $_->node_name;
821        }
822        
823        $el->manakai_set_read_only (1, 1);
824        for ($c1, $c2, $c3, $c4, $c5) {
825          ok $_->manakai_read_only ? 1 : 0, 1,
826              $el->node_name . '->read_only (1, 1) ' . $_->node_name . ' [2]';
827        }
828      }
829    
830      {
831        my $dtd = $doc->create_document_type_definition ('readOnlyDTDef1');
832        my $c1 = $doc->create_processing_instruction ('c1', '');
833        $dtd->append_child ($c1);
834        my $c2 = $doc->create_element_type_definition ('c2');
835        $dtd->set_element_type_definition_node ($c2);
836        my $c3 = $doc->create_general_entity ('c3');
837        $dtd->set_general_entity_node ($c3);
838        my $c4 = $doc->create_notation ('c4');
839        $dtd->set_notation_node ($c4);
840        my $c5 = $doc->create_text_node ('c5');
841        $c3->append_child ($c5);
842    
843        $dtd->manakai_set_read_only (1, 1);
844        for ($c1, $c2, $c3, $c4, $c5) {
845          ok $_->manakai_read_only ? 1 : 0, 1,
846              $dtd->node_name . '->read_only (1, 1) ' . $_->node_name . ' [1]';
847        }
848        
849        $dtd->manakai_set_read_only (0, 1);
850        for ($c1, $c2, $c3, $c4, $c5) {
851          ok $_->manakai_read_only ? 1 : 0, 0,
852              $dtd->node_name . '->read_only (1, 0) ' . $_->node_name;
853        }
854        
855        $dtd->manakai_set_read_only (1, 1);
856        for ($c1, $c2, $c3, $c4, $c5) {
857          ok $_->manakai_read_only ? 1 : 0, 1,
858              $dtd->node_name . '->read_only (1, 1) ' . $_->node_name . ' [2]';
859        }
860      }
861    
862      {
863        my $et = $doc->create_element_type_definition ('readOnlyETDef1');
864        my $c1 = $doc->create_element ('c1');
865        $et->set_attribute_definition_node ($c1);
866        my $c2 = $doc->create_text_node ('c2');
867        $c1->append_child ($c2);
868    
869        $et->manakai_set_read_only (1, 1);
870        for ($c1, $c2) {
871          ok $_->manakai_read_only ? 1 : 0, 1,
872              $et->node_name . '->read_only (1, 1) ' . $_->node_name . ' [1]';
873        }
874        
875        $et->manakai_set_read_only (0, 1);
876        for ($c1, $c2) {
877          ok $_->manakai_read_only ? 1 : 0, 0,
878              $et->node_name . '->read_only (1, 0) ' . $_->node_name;
879        }
880        
881        $et->manakai_set_read_only (1, 1);
882        for ($c1, $c2) {
883          ok $_->manakai_read_only ? 1 : 0, 1,
884              $et->node_name . '->read_only (1, 1) ' . $_->node_name . ' [2]';
885        }
886      }
887    }
888    
889    ## |manakaiAppendText|
890    {
891      my $doc2 = $doc->implementation->create_document;
892    
893      $doc2->dom_config->set_parameter
894          ('http://suika.fam.cx/www/2006/dom-config/strict-document-children' => 1);
895      for my $node (
896                    $doc2,
897                    $doc->create_notation ('Notation_manakaiAppendText'),
898                    $doc->create_document_type_definition ('DT_manakaiAppendText'),
899                    $doc->create_element_type_definition ('ET_manakaiAppendText'),
900                   ) {
901        ok $node->can ('manakai_append_text') ? 1 : 0, 1, $node->node_name . 'can';
902    
903        $node->manakai_append_text ('aaaa');
904        ok $node->text_content, undef, $node->node_name . ' [1]';
905        ok 0+@{$node->child_nodes}, 0, $node->node_name . ' childNodes @{} 0+ [1]';
906      }
907    
908      $doc2->dom_config->set_parameter
909          ('http://suika.fam.cx/www/2006/dom-config/strict-document-children' => 0);
910      for my $node (
911                    $doc->create_attribute ('Attr_manakaiAppendText'),
912                    $doc->create_element ('Element_manakaiAppendText'),
913                    $doc2,
914                    $doc->create_document_fragment,
915                    $doc->create_general_entity ('Entity_manakaiAppendText'),
916                    $doc->create_entity_reference ('ER_manakaiAppendText'),
917                    $doc->create_attribute_definition ('AT_manakaiAppendText'),
918                   ) {
919        $node->manakai_set_read_only (0, 1);
920        ok $node->can ('manakai_append_text') ? 1 : 0, 1, $node->node_name . 'can';
921    
922        $node->manakai_append_text ('string');
923        ok $node->text_content, 'string', $node->node_name . ' [1]';
924        ok 0+@{$node->child_nodes}, 1, $node->node_name . ' childNodes @{} 0+ [1]';
925    
926        $node->manakai_append_text ('STRING');
927        ok $node->text_content, 'stringSTRING', $node->node_name . ' [2]';
928        ok 0+@{$node->child_nodes}, 1, $node->node_name . ' childNodes @{} 0+ [2]';
929    
930        my $er = $doc->create_entity_reference ('er');
931        $node->append_child ($er);
932    
933        $node->manakai_append_text ('text');
934        ok $node->text_content, 'stringSTRINGtext', $node->node_name . ' [3]';
935        ok 0+@{$node->child_nodes}, 3, $node->node_name . ' childNodes @{} 0+ [3]';
936      }
937    
938      for my $node (
939                    $doc->create_text_node (''),
940                    $doc->create_cdata_section (''),
941                    $doc->create_comment (''),
942                    $doc->create_processing_instruction ('PI_manakaiAppendText'),
943                   ) {
944        ok $node->can ('manakai_append_text') ? 1 : 0, 1, $node->node_name . 'can';
945    
946        $node->manakai_append_text ('aaaa');
947        ok $node->text_content, 'aaaa', $node->node_name . ' [1]';
948        ok 0+@{$node->child_nodes}, 0, $node->node_name . ' childNodes @{} 0+ [1]';
949    
950        $node->manakai_append_text ('bbbb');
951        ok $node->text_content, 'aaaabbbb', $node->node_name . ' [1]';
952        ok 0+@{$node->child_nodes}, 0, $node->node_name . ' childNodes @{} 0+ [1]';
953      }
954    }
955    
956    ## |baseURI|
957    {
958      my $doc2 = $doc->implementation->create_document;
959    
960      $doc2->document_uri (q<ftp://suika.fam.cx/>);
961      ok $doc2->base_uri, q<ftp://suika.fam.cx/>, 'Document->base_uri [1]';
962    
963      $doc2->document_uri (undef);
964      ok $doc2->base_uri, undef, 'Document->base_uri [2]';
965      ok $doc2->manakai_entity_base_uri, undef, 'Document->base_uri ebu [2]';
966    
967      $doc2->manakai_entity_base_uri (q<https://suika.fam.cx/>);
968      ok $doc2->base_uri, q<https://suika.fam.cx/>, 'Document->base_uri [3]';
969      ok $doc2->manakai_entity_base_uri, q<https://suika.fam.cx/>,
970          'Document->base_uri ebu [3]';
971    
972      $doc2->manakai_entity_base_uri (undef);
973      ok $doc2->base_uri, undef, 'Document->base_uri [4]';
974      ok $doc2->manakai_entity_base_uri, undef, 'Document->base_uri ebu [4]';
975    
976      $doc2->document_uri (q<ftp://suika.fam.cx/>);
977      $doc2->manakai_entity_base_uri (q<https://suika.fam.cx/>);
978      ok $doc2->base_uri, q<https://suika.fam.cx/>, 'Document->base_uri [5]';
979      ok $doc2->manakai_entity_base_uri, q<https://suika.fam.cx/>,
980          'Document->base_uri ebu [5]';
981    }
982    
983    for my $method (qw/
984                    create_document_fragment
985                    create_element_type_definition
986                    create_attribute_definition
987                    /) {
988      my $doc2 = $doc->implementation->create_document;  
989    
990      my $node = $doc2->$method ('a');
991    
992      $doc2->document_uri (q<ftp://doc.test/>);
993      ok $node->base_uri, q<ftp://doc.test/>, $node->node_name . '->base_uri [1]';
994    
995      $doc2->manakai_entity_base_uri (q<ftp://suika.fam.cx/>);
996      ok $node->base_uri, q<ftp://suika.fam.cx/>,
997          $node->node_name . '->base_uri [2]';
998    }
999    
1000    {
1001      my $doc2 = $doc->implementation->create_document;
1002    
1003      my $attr = $doc2->create_attribute_ns (undef, 'attr');
1004      
1005      $doc2->document_uri (q<http://www.example.com/>);
1006      ok $attr->base_uri, q<http://www.example.com/>, 'Attr->base_uri [1]';
1007    
1008      my $el = $doc2->create_element_ns (undef, 'element');
1009      $el->set_attribute_ns ('http://www.w3.org/XML/1998/namespace',
1010                             'xml:base' => q<http://www.example.org/>);
1011      $el->set_attribute_node_ns ($attr);
1012      ok $attr->base_uri, q<http://www.example.org/>, 'Attr->base_uri [2]';
1013    }
1014    
1015    for my $i (0..1) {
1016      my $xb = [
1017                ['http://www.w3.org/XML/1998/namespace', 'xml:base'],
1018                [undef, [undef, 'xml:base']],
1019               ]->[$i];
1020    
1021      my $doc2 = $doc->implementation->create_document;
1022    
1023      my $attr = $doc2->create_attribute_ns (@$xb);
1024      $attr->value (q<http://attr.test/>);
1025    
1026      ok $attr->base_uri, undef, 'xml:base->base_uri [0]' . $i;
1027    
1028      $doc2->document_uri (q<http://doc.test/>);
1029      ok $attr->base_uri, q<http://doc.test/>, 'xml:base->base_uri [1]' . $i;
1030    
1031      my $el = $doc2->create_element_ns (undef, 'e');
1032      $el->set_attribute_node_ns ($attr);
1033      ok $attr->base_uri, q<http://doc.test/>, 'xml:base->base_uri [2]' . $i;
1034    
1035      my $pel = $doc2->create_element_ns (undef, 'e');
1036      $pel->set_attribute_ns (@$xb, q<http://pel.test/>);
1037      $pel->append_child ($el);
1038      ok $attr->base_uri, q<http://pel.test/>, 'xml:base->base_uri [3]' . $i;
1039    }
1040    
1041    for my $i (0..1) {
1042      my $xb = [
1043                ['http://www.w3.org/XML/1998/namespace', 'xml:base'],
1044                [undef, [undef, 'xml:base']],
1045               ]->[$i];
1046    
1047      my $doc2 = $doc->implementation->create_document;
1048      
1049      my $el = $doc2->create_element_ns (undef, 'el');
1050    
1051      ok $el->base_uri, undef, "Element->base_uri [0]";
1052      ok $el->manakai_base_uri, undef, "Element->manakai_base_uri [0]";
1053    
1054      $doc2->document_uri (q<http://foo.example/>);
1055      ok $el->base_uri, q<http://foo.example/>, "Element->base_uri [1]";
1056      ok $el->manakai_base_uri, undef, "Element->manakai_base_uri [1]";
1057    
1058      $el->set_attribute_ns (@$xb => q<http://www.example.com/>);
1059      ok $el->base_uri, q<http://www.example.com/>, "Element->base_uri [2]";
1060      ok $el->manakai_base_uri, undef, "Element->manakai_base_uri [2]";
1061    
1062      $el->set_attribute_ns (@$xb => q<bar>);
1063      ok $el->base_uri, q<http://foo.example/bar>, "Element->base_uri [3]";
1064      ok $el->manakai_base_uri, undef, "Element->manakai_base_uri [3]";
1065    
1066      $el->manakai_base_uri (q<http://baz.example/>);
1067      ok $el->base_uri, q<http://baz.example/>, "Element->base_uri [4]";
1068      ok $el->manakai_base_uri, q<http://baz.example/>,
1069          "Element->manakai_base_uri [4]";
1070    
1071      $el->manakai_base_uri (undef);
1072      ok $el->base_uri, q<http://foo.example/bar>, "Element->base_uri [5]";
1073      ok $el->manakai_base_uri, undef, "Element->manakai_base_uri [5]";
1074    }
1075    
1076    {
1077      my $doc2 = $doc->implementation->create_document;
1078      
1079      my $el = $doc2->create_element_ns (undef, 'el');
1080    
1081      ok $el->base_uri, undef, "Element->base_uri [6]";
1082    
1083      $doc2->document_uri (q<http://doc.test/>);
1084      ok $el->base_uri, q<http://doc.test/>, "Element->base_uri [7]";
1085    
1086      my $el0 = $doc2->create_element_ns (undef, 'e');
1087      $el0->set_attribute_ns ('http://www.w3.org/XML/1998/namespace', 'xml:base',
1088                              q<http://el.test/>);
1089      $el0->append_child ($el);
1090      ok $el->base_uri, q<http://el.test/>, "Element->base_uri [8]";
1091    
1092      my $ent = $doc2->create_entity_reference ('ent');
1093      $ent->manakai_set_read_only (0, 1);
1094      $ent->manakai_external (1);
1095      $ent->manakai_entity_base_uri (q<http://ent.test/>);
1096      $el0->append_child ($ent);
1097      $ent->append_child ($el);
1098      ok $el->base_uri, q<http://ent.test/>, "Element->base_uri [9]";
1099    }
1100    
1101    for (qw/create_text_node create_cdata_section create_comment/) {
1102      my $doc2 = $doc->implementation->create_document;
1103      my $node = $doc2->$_ ('');
1104    
1105      $doc2->document_uri (q<http://doc.test/>);
1106      ok $node->base_uri, q<http://doc.test/>, $node->node_name . "->base_uri [0]";
1107    
1108      my $el = $doc2->create_element_ns (undef, 'e');
1109      $el->set_attribute_ns ('http://www.w3.org/XML/1998/namespace', 'xml:base',
1110                             q<http://el.test/>);
1111      $el->append_child ($node);
1112      ok $node->base_uri, q<http://el.test/>, $node->node_name . "->base_uri [1]";
1113    
1114      my $ent = $doc2->create_entity_reference ('ent');
1115      $ent->manakai_set_read_only (0, 1);
1116      $ent->manakai_external (1);
1117      $ent->manakai_entity_base_uri (q<http://ent.test/>);
1118      $el->append_child ($ent);
1119      $ent->append_child ($node);
1120      ok $node->base_uri, q<http://ent.test/>, $node->node_name . "->base_uri [2]";
1121    }
1122    
1123    {
1124      my $doc2 = $doc->implementation->create_document;
1125      my $ent = $doc2->create_general_entity ('ent');
1126    
1127      $doc2->document_uri (q<http://base.example/>);
1128      ok $ent->base_uri, q<http://base.example/>, "Entity->base_uri [1]";
1129      
1130      $ent->manakai_entity_base_uri (q<http://www.example.com/>);
1131      ok $ent->base_uri, q<http://base.example/>, "Entity->base_uri [2]";
1132    
1133      $ent->manakai_declaration_base_uri (q<http://www.example/>);
1134      ok $ent->base_uri, q<http://base.example/>, "Entity->base_uri [3]";
1135    }
1136    
1137    {
1138      my $doc2 = $doc->implementation->create_document;
1139    
1140      my $ent = $doc2->create_entity_reference ('ent');
1141      $ent->manakai_set_read_only (0, 1);
1142    
1143      $doc2->document_uri (q<http://base.example/>);
1144      ok $ent->base_uri, q<http://base.example/>, "ER->base_uri [1]";
1145    
1146      $ent->manakai_entity_base_uri (q<http://www.example.com/>);
1147      ok $ent->base_uri, q<http://base.example/>;
1148    
1149      my $el = $doc2->create_element_ns (undef, 'el');
1150      $el->set_attribute_ns ('http://www.w3.org/XML/1998/namespace', 'xml:base',
1151                             q<http://el.test/>);
1152      $el->append_child ($ent);
1153      ok $ent->base_uri, q<http://el.test/>, "ER->base_uri [2]";
1154    
1155      my $xent = $doc2->create_entity_reference ('ext');
1156      $xent->manakai_set_read_only (0, 1);
1157      $xent->manakai_entity_base_uri (q<http://ent.test/>);
1158      $xent->manakai_external (1);
1159      $el->append_child ($xent);
1160      $xent->append_child ($ent);
1161      ok $ent->base_uri, q<http://ent.test/>, "ER->base_uri [3]";
1162    }
1163    
1164    {
1165      my $doc2 = $doc->implementation->create_document;
1166    
1167      my $pi = $doc2->create_processing_instruction ('i');
1168    
1169      ok $pi->base_uri, undef, "PI->base_uri [0]";
1170      ok $pi->manakai_base_uri, undef, "PI->manakai_base_uri [0]";
1171    
1172      $doc2->document_uri (q<http://doc.test/>);
1173      ok $pi->base_uri, q<http://doc.test/>, "PI->base_uri [1]";
1174      ok $pi->manakai_base_uri, undef, "PI->manakai_base_uri [1]";
1175    
1176      my $el = $doc2->create_element_ns (undef, 'e');
1177      $el->set_attribute_ns ('http://www.w3.org/XML/1998/namespace', 'xml:base',
1178                             q<http://el.test/>);
1179      $el->append_child ($pi);
1180      ok $pi->base_uri, q<http://el.test/>, "PI->base_uri [2]";
1181      ok $pi->manakai_base_uri, undef, "PI->manakai_base_uri [2]";
1182    
1183      my $ent = $doc2->create_entity_reference ('ent');
1184      $ent->manakai_set_read_only (0, 1);
1185      $ent->manakai_external (1);
1186      $ent->manakai_entity_base_uri (q<http://ent.test/>);
1187      $el->append_child ($ent);
1188      $ent->append_child ($pi);
1189      ok $pi->base_uri, q<http://ent.test/>, "PI->base_uri [3]";
1190      ok $pi->manakai_base_uri, undef, "PI->manakai_base_uri [3]";
1191      
1192      $pi->manakai_base_uri (q<http://pi.ent/>);
1193      ok $pi->base_uri, q<http://pi.ent/>, "PI->base_uri [4]";
1194      ok $pi->manakai_base_uri, q<http://pi.ent/>, "PI->manakai_base_uri [4]";
1195    
1196      $pi->manakai_base_uri (undef);
1197      ok $pi->base_uri, q<http://ent.test/>, "PI->base_uri [5]";
1198      ok $pi->manakai_base_uri, undef, "PI->manakai_base_uri [5]";
1199    }
1200    
1201    {
1202      my $doc2 = $doc->implementation->create_document;
1203    
1204      my $pi = $doc2->create_notation ('i');
1205    
1206      $doc2->document_uri (q<http://doc.test/>);
1207      ok $pi->base_uri, q<http://doc.test/>, "Notation->base_uri [1]";
1208      
1209      $pi->manakai_declaration_base_uri (q<http://www.example/>);
1210      ok $pi->base_uri, q<http://doc.test/>, "Notation->base_uri [2]";
1211    }
1212    
1213    {
1214      my $dt = $doc->implementation->create_document_type ('name');
1215      ok $dt->base_uri, undef, "DT->base_uri [0]";
1216    
1217      my $doc2 = $doc->implementation->create_document;
1218      $doc2->append_child ($dt);
1219      $doc2->document_uri (q<http://doc.test/>);
1220      ok $dt->owner_document, $doc2;
1221      ok $dt->base_uri, q<http://doc.test/>, "DT->base_uri [1]";
1222    }
1223    
1224    
1225  ## TODO: parent_node tests, as with append_child tests  ## TODO: parent_node tests, as with append_child tests
1226    
1227  ## TODO: text_content tests for CharacterData and PI  ## TODO: text_content tests for CharacterData and PI
1228    
1229  ## TODO: manakai_read_only tests  =head1 LICENSE
1230    
1231  sub create_nodes () {  Copyright 2007 Wakaba <w@suika.fam.cx>
   (  
    $doc->create_attribute ('attr1'),  
    $doc->create_attribute_definition ('at1'),  
    $doc->create_cdata_section ('cdata1'),  
    $doc->create_comment ('comment1'),  
    $doc->create_element ('element1'),  
    $doc->create_element_type_definition ('et1'),  
    $doc->create_general_entity ('entity1'),  
    $doc->create_entity_reference ('entity-reference1'),  
    $doc->implementation->create_document,  
    $doc->create_document_fragment,  
    $doc->create_document_type_definition ('dt1'),  
    $doc->create_notation ('notation1'),  
    $doc->create_processing_instruction ('pi1', 'pi1data'),  
    $doc->create_text_node ('text1'),  
   );  
 } # create_nodes  
1232    
1233  sub create_parent_nodes () {  This program is free software; you can redistribute it and/or
1234    (  modify it under the same terms as Perl itself.
1235     $doc->create_attribute ('attr1'),  
1236     $doc->create_attribute_definition ('at1'),  =cut
    $doc->create_element ('element1'),  
    $doc->create_general_entity ('entity1'),  
    $doc->create_entity_reference ('entity-reference1'),  
    $doc->implementation->create_document,  
    $doc->create_document_fragment,  
    $doc->create_document_type_definition ('dt1'),  
   );  
 } # create_parent_nodes  
1237    
 ## License: Public Domain.  
1238  ## $Date$  ## $Date$
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.5
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24  
Google Analytics is used in this page; Cookies are used. 忍者AdMax is used in this page; Cookies are used. Privacy policy.