File: 91unique_key.t

package info (click to toggle)
libxml-libxml-perl 2.0207%2Bdfsg%2Breally%2B2.0134-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 2,572 kB
  • sloc: perl: 6,310; ansic: 3,851; xml: 182; sh: 21; makefile: 16
file content (85 lines) | stat: -rw-r--r-- 2,708 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
# -*- cperl -*-
# $Id$

##
# This test checks that unique_key works correctly.
# it relies on the success of t/01basic.t, t/02parse.t,
# t/04node.t and namespace tests (not done yet)

use Test::More tests => 31;

use XML::LibXML;
use XML::LibXML::Common qw(:libxml);
use strict;
use warnings;
my $xmlstring = q{<foo>bar<foobar/><bar foo="foobar"/><!--foo--><![CDATA[&foo bar]]></foo>};

my $parser = XML::LibXML->new();
my $doc    = $parser->parse_string( $xmlstring );

my $foo = $doc->documentElement;

# TEST:$num_children=5;
my @children_1 = $foo->childNodes;
my @children_2 = $foo->childNodes;

ok($children_1[0]->can('unique_key'), 'unique_key method available')
    or exit -1;

# compare unique keys between all nodes in the above tiny document.
# Different nodes should have different keys; same nodes should have the same keys.
for my $c1(0..4){
    for my $c2(0..4){
        if($c1 == $c2){
            # TEST*$num_children
            ok($children_1[$c1]->unique_key == $children_2[$c2]->unique_key,
                'Key for ' . $children_1[$c1]->nodeName .
                ' matches key from same node');
        }else{
            # TEST*($num_children)*($num_children-1)
            ok($children_1[$c1]->unique_key != $children_2[$c2]->unique_key,
                'Key for ' . $children_1[$c1]->nodeName .
                ' does not match key for' . $children_2[$c2]->nodeName);
        }
    }
}

my $foo_default_ns = XML::LibXML::Namespace->new('foo.com');
my $foo_ns = XML::LibXML::Namespace->new('foo.com','foo');
my $bar_default_ns = XML::LibXML::Namespace->new('bar.com');
my $bar_ns = XML::LibXML::Namespace->new('bar.com','bar');

# TEST
is(
    XML::LibXML::Namespace->new('foo.com')->unique_key,
    XML::LibXML::Namespace->new('foo.com')->unique_key,
    'default foo ns key matches itself'
);

# TEST
isnt(
    XML::LibXML::Namespace->new('foo.com', 'foo')->unique_key,
    XML::LibXML::Namespace->new('foo.com', 'bar')->unique_key,
    q[keys for ns's with different prefixes don't match]
);

# TEST
isnt(
    XML::LibXML::Namespace->new('foo.com', 'foo')->unique_key,
    XML::LibXML::Namespace->new('foo.com')->unique_key,
    q[key for prefixed ns doesn't match key for default ns]
);

# TEST
isnt(
    XML::LibXML::Namespace->new('foo.com', 'foo')->unique_key,
    XML::LibXML::Namespace->new('bar.com', 'foo')->unique_key,
    q[keys for ns's with different URI's don't match]
);

# TEST
isnt(
    XML::LibXML::Namespace->new('foo.com', 'foo')->unique_key,
    XML::LibXML::Namespace->new('bar.com', 'bar')->unique_key,
    q[keys for ns's with different URI's and prefixes don't match]
);